Commit a41c2e6d authored by Gnus developers's avatar Gnus developers Committed by Katsumi Yamaoka

Merge changes made in Gnus trunk.

shr.el: Rename the tag functions a bit, and add some new ones.
gnus-sum.el (gnus-summary-select-article-buffer): If the article buffer isn't shown, then select the current article first instead of bugging out.
gnus-sum.el (gnus-summary-select-article-buffer): Show both the article and summary buffers again.
shr.el (shr-tag-blockquote): Convert name.
shr.el (shr-rescale-image): Use the right image-size variant.
shr.el (shr-tag-p): Don't insert newlines at the start of the buffer.
shr.el: Implement indentation in blockquotes.
gnus-sum.el (gnus-summary-select-article-buffer): Really select the article buffer again.
shr.el (shr-ensure-paragraph): Don't insert newlines on empty tags at the beginning of the buffer.
gnus-ems.el, gnus-util.el, mm-decode.el, mm-view.el: Add resize for large images in mm.
gnus-html.el (gnus-html-put-image): Use gnus-rescale-image.
shr.el (shr-tag-p): Don't insert newlines on empty tags at the beginning of the buffer.
gnus-ems.el, gnus-html.el, gnus-util.el, mm-decode.el, mm-view.el: Support image resizing.
shr.el: Add headings.
shr.el (shr-ensure-paragraph): Actually work.
shr.el (shr-tag-li): Make <ul> prettier.
shr.el (shr-insert): Get white space at the beginning/end of elements right.
shr.el (shr-tag-li): Tweak <li> rendering.
shr.el (shr-tag-p): Collapse subsequent <p>s.
shr.el (shr-ensure-paragraph): Don't insert double line feeds after blank lines.
shr.el (shr-tag-h6): Add.
shr.el (shr-insert): \t is also space.
parent 728a982d
2010-10-03 Julien Danjou <julien@danjou.info>
* emacs-mime.texi (Display Customization): Update
mm-inline-large-images documentation and add documentation for
mm-inline-large-images-proportion.
2010-10-03 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi (Frequently Asked Questions): Mention
......
......@@ -374,12 +374,18 @@ message as follows:
@vindex mm-inline-large-images
When displaying inline images that are larger than the window, Emacs
does not enable scrolling, which means that you cannot see the whole
image. To prevent this, the library tries to determine the image size
image. To prevent this, the library tries to determine the image size
before displaying it inline, and if it doesn't fit the window, the
library will display it externally (e.g. with @samp{ImageMagick} or
@samp{xv}). Setting this variable to @code{t} disables this check and
@samp{xv}). Setting this variable to @code{t} disables this check and
makes the library display all inline images as inline, regardless of
their size.
their size. If you set this variable to @code{resize}, the image will
be displayed resized to fit in the window, if Emacs has the ability to
resize images.
@item mm-inline-large-images-proportion
@vindex mm-inline-images-max-proportion
The proportion used when resizing large images.
@item mm-inline-override-types
@vindex mm-inline-override-types
......
2010-10-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el: Add headings.
(shr-ensure-paragraph): Actually work.
(shr-tag-li): Make <ul> prettier.
(shr-insert): Get white space at the beginning/end of elements right.
(shr-tag-p): Collapse subsequent <p>s.
(shr-ensure-paragraph): Don't insert double line feeds after blank
lines.
(shr-insert): \t is also space.
(shr-tag-s): Fix "s" tag name function.
(shr-tag-s): Fix face prop name.
2010-10-03 Julien Danjou <julien@danjou.info>
* gnus-html.el (gnus-html-put-image): Use gnus-rescale-image.
* mm-view.el (gnus-window-inside-pixel-edges): Add autoload for
gnus-window-inside-pixel-edges.
* gnus-ems.el (gnus-window-inside-pixel-edges): Move from gnus-html to
gnus-ems.
* mm-view.el (mm-inline-image-emacs): Support image resizing.
* gnus-util.el (gnus-rescale-image): Add generic gnus-rescale-image
function.
* mm-decode.el (mm-inline-large-images): Enhance defcustom and add
resize choice.
2010-10-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-tag-p): Don't insert newlines on empty tags at the
beginning of the buffer.
* gnus-sum.el (gnus-summary-select-article-buffer): Really select the
article buffer again.
* shr.el (shr-tag-p): Don't insert newlines at the start of the
buffer.
* mm-decode.el (mm-shr): Narrow before inserting, so that shr can know
when it's at the start of the buffer.
* shr.el (shr-tag-blockquote): Convert name.
(shr-rescale-image): Use the right image-size variant.
* gnus-sum.el (gnus-summary-select-article-buffer): If the article
buffer isn't shown, then select the current article first instead of
bugging out.
(gnus-summary-select-article-buffer): Show both the article and summary
buffers again.
* shr.el (shr-fontize-cont): Protect against regions with no text.
Rename tag functions to shr-tag-* for enhanced security.
(shr-tag-ul, shr-tag-ol, shr-tag-li, shr-tag-br): New functions.
2010-10-03 Chong Yidong <cyd@stupidchicken.com>
* shr.el (shr-insert):
......
......@@ -307,6 +307,12 @@
end nil))))))
(eval-and-compile
;; XEmacs does not have window-inside-pixel-edges
(defalias 'gnus-window-inside-pixel-edges
(if (fboundp 'window-inside-pixel-edges)
'window-inside-pixel-edges
'window-pixel-edges))
(if (fboundp 'set-process-plist)
(progn
(defalias 'gnus-set-process-plist 'set-process-plist)
......
......@@ -105,12 +105,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
(match-string 0 encoded-text)))
t t encoded-text)
s (1+ s)))
encoded-text))))
;; XEmacs does not have window-inside-pixel-edges
(defalias 'gnus-window-inside-pixel-edges
(if (fboundp 'window-inside-pixel-edges)
'window-inside-pixel-edges
'window-pixel-edges)))
encoded-text)))))
(defun gnus-html-encode-url (url)
"Encode URL."
......@@ -436,7 +431,17 @@ Return a string with image data."
(= (car size) 30)
(= (cdr size) 30))))
;; Good image, add it!
(let ((image (gnus-html-rescale-image image data size)))
(let ((image (gnus-html-rescale-image
image
;; (width . height)
(cons
;; Aimed width
(truncate
(* gnus-max-image-proportion
(- (nth 2 edges) (nth 0 edges))))
;; Aimed height
(truncate (* gnus-max-image-proportion
(- (nth 3 edges) (nth 1 edges))))))))
(delete-region start end)
(gnus-put-image image alt-text 'external)
(gnus-put-text-property start (point) 'help-echo alt-text)
......@@ -459,31 +464,6 @@ Return a string with image data."
(gnus-add-image 'internal image))
nil))))))))
(defun gnus-html-rescale-image (image data size)
(if (or (not (fboundp 'imagemagick-types))
(not (get-buffer-window (current-buffer))))
image
(let* ((width (car size))
(height (cdr size))
(edges (gnus-window-inside-pixel-edges
(get-buffer-window (current-buffer))))
(window-width (truncate (* gnus-max-image-proportion
(- (nth 2 edges) (nth 0 edges)))))
(window-height (truncate (* gnus-max-image-proportion
(- (nth 3 edges) (nth 1 edges)))))
scaled-image)
(when (> height window-height)
(setq image (or (create-image data 'imagemagick t
:height window-height)
image))
(setq size (image-size image t)))
(when (> (car size) window-width)
(setq image (or
(create-image data 'imagemagick t
:width window-width)
image)))
image)))
(defun gnus-html-image-url-blocked-p (url blocked-images)
"Find out if URL is blocked by BLOCKED-IMAGES."
(let ((ret (and blocked-images
......
......@@ -6933,8 +6933,10 @@ displayed, no centering will be performed."
(interactive)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(error "There is no article buffer for this summary buffer")
(select-window (get-buffer-window gnus-article-buffer))
(gnus-configure-windows 'only-article t)))
(unless (get-buffer-window gnus-article-buffer)
(gnus-summary-show-article))
(gnus-configure-windows 'article t)
(select-window (get-buffer-window gnus-article-buffer))))
(defun gnus-summary-universal-argument (arg)
"Perform any operation on all articles that are process/prefixed."
......
......@@ -1932,6 +1932,26 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
(get-char-table ,character ,display-table)))
`(aref ,display-table ,character)))
(defun gnus-rescale-image (image size)
"Rescale IMAGE to SIZE if possible.
SIZE is in format (WIDTH . HEIGHT). Return a new image.
Sizes are in pixels."
(if (or (not (fboundp 'imagemagick-types))
(not (get-buffer-window (current-buffer))))
image
(let ((new-width (car size))
(new-height (cdr size)))
(when (> (cdr (image-size image t)) new-height)
(setq image (or (create-image (plist-get (cdr image) :data) 'imagemagick t
:height new-height)
image)))
(when (> (car (image-size image t)) new-width)
(setq image (or
(create-image (plist-get (cdr image) :data) 'imagemagick t
:width new-width)
image)))
image)))
(provide 'gnus-util)
;;; gnus-util.el ends here
......@@ -369,8 +369,12 @@ enables you to choose manually one of two types those mails include."
:group 'mime-display)
(defcustom mm-inline-large-images nil
"If non-nil, then all images fit in the buffer."
:type 'boolean
"If t, then all images fit in the buffer.
If 'resize, try to resize the images so they fit."
:type '(radio
(const :tag "Inline large images as they are." t)
(const :tag "Resize large images." resize)
(const :tag "Do not inline large images." nil))
:group 'mime-display)
(defcustom mm-file-name-rewrite-functions
......@@ -1679,9 +1683,11 @@ If RECURSIVE, search recursively."
(let ((article-buffer (current-buffer)))
(unless handle
(setq handle (mm-dissect-buffer t)))
(shr-insert-document
(mm-with-part handle
(libxml-parse-html-region (point-min) (point-max))))))
(save-restriction
(narrow-to-region (point) (point))
(shr-insert-document
(mm-with-part handle
(libxml-parse-html-region (point-min) (point-max)))))))
(provide 'mm-decode)
......
......@@ -32,6 +32,7 @@
(require 'smime)
(autoload 'gnus-completing-read "gnus-util")
(autoload 'gnus-window-inside-pixel-edges "gnus-ems")
(autoload 'gnus-article-prepare-display "gnus-art")
(autoload 'vcard-parse-string "vcard")
(autoload 'vcard-format-string "vcard")
......@@ -76,6 +77,13 @@
:version "22.1"
:group 'mime-display)
(defcustom mm-inline-large-images-proportion 0.9
"Maximum proportion of large image resized when
`mm-inline-large-images' is set to resize."
:type 'float
:version "24.1"
:group 'mime-display)
;;; Internal variables.
;;;
......@@ -85,7 +93,18 @@
(defun mm-inline-image-emacs (handle)
(let ((b (point-marker))
(inhibit-read-only t))
(put-image (mm-get-image handle) b)
(put-image
(let ((image (mm-get-image handle)))
(if (eq mm-inline-large-images 'resize)
(gnus-rescale-image image
(let ((edges (gnus-window-inside-pixel-edges
(get-buffer-window (current-buffer)))))
(cons (truncate (* mm-inline-large-images-proportion
(- (nth 2 edges) (nth 0 edges))))
(truncate (* mm-inline-large-images-proportion
(- (nth 3 edges) (nth 1 edges)))))))
image))
b)
(insert "\n\n")
(mm-handle-set-undisplayer
handle
......
......@@ -53,6 +53,7 @@ fit these criteria."
(defvar shr-folding-mode nil)
(defvar shr-state nil)
(defvar shr-start nil)
(defvar shr-indentation 0)
(defvar shr-width 70)
......@@ -75,7 +76,7 @@ fit these criteria."
(shr-descend (shr-transform-dom dom))))
(defun shr-descend (dom)
(let ((function (intern (concat "shr-" (symbol-name (car dom))) obarray)))
(let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)))
(if (fboundp function)
(funcall function (cdr dom))
(shr-generic (cdr dom)))))
......@@ -85,37 +86,48 @@ fit these criteria."
(cond
((eq (car sub) :text)
(shr-insert (cdr sub)))
((consp (cdr sub))
((listp (cdr sub))
(shr-descend sub)))))
(defun shr-p (cont)
(shr-ensure-newline)
(insert "\n")
(defun shr-tag-p (cont)
(shr-ensure-paragraph)
(shr-generic cont)
(insert "\n"))
(defun shr-b (cont)
(shr-ensure-paragraph))
(defun shr-ensure-paragraph ()
(unless (bobp)
(if (bolp)
(unless (eql (char-after (- (point) 2)) ?\n)
(insert "\n"))
(if (save-excursion
(beginning-of-line)
(looking-at " *"))
(insert "\n")
(insert "\n\n")))))
(defun shr-tag-b (cont)
(shr-fontize-cont cont 'bold))
(defun shr-i (cont)
(defun shr-tag-i (cont)
(shr-fontize-cont cont 'italic))
(defun shr-u (cont)
(defun shr-tag-u (cont)
(shr-fontize-cont cont 'underline))
(defun shr-s (cont)
(shr-fontize-cont cont 'strikethru))
(defun shr-tag-s (cont)
(shr-fontize-cont cont 'strike-through))
(defun shr-fontize-cont (cont type)
(defun shr-fontize-cont (cont &rest types)
(let (shr-start)
(shr-generic cont)
(shr-add-font shr-start (point) type)))
(dolist (type types)
(shr-add-font (or shr-start (point)) (point) type))))
(defun shr-add-font (start end type)
(let ((overlay (make-overlay start end)))
(overlay-put overlay 'face type)))
(defun shr-a (cont)
(defun shr-tag-a (cont)
(let ((url (cdr (assq :href cont)))
shr-start)
(shr-generic cont)
......@@ -129,7 +141,10 @@ fit these criteria."
(defun shr-browse-url (widget &rest stuff)
(browse-url (widget-get widget :url)))
(defun shr-img (cont)
(defun shr-tag-img (cont)
(when (and (> (current-column) 0)
(not (eq shr-state 'image)))
(insert "\n"))
(let ((start (point-marker)))
(let ((alt (cdr (assq :alt cont)))
(url (cdr (assq :src cont))))
......@@ -166,15 +181,17 @@ fit these criteria."
(defun shr-put-image (data point alt)
(if (not (display-graphic-p))
(insert alt)
(let ((image (shr-rescale-image data)))
(put-image image point alt))))
(let ((image (ignore-errors
(shr-rescale-image data))))
(when image
(put-image image point alt)))))
(defun shr-rescale-image (data)
(if (or (not (fboundp 'imagemagick-types))
(not (get-buffer-window (current-buffer))))
(create-image data nil t)
(let* ((image (create-image data nil t))
(size (image-size image))
(size (image-size image t))
(width (car size))
(height (cdr size))
(edges (window-inside-pixel-edges
......@@ -196,14 +213,15 @@ fit these criteria."
image)))
image)))
(defun shr-pre (cont)
(defun shr-tag-pre (cont)
(let ((shr-folding-mode nil))
(shr-ensure-newline)
(shr-generic cont)
(shr-ensure-newline)))
(defun shr-blockquote (cont)
(shr-pre cont))
(defun shr-tag-blockquote (cont)
(let ((shr-indentation (+ shr-indentation 4)))
(shr-tag-pre cont)))
(defun shr-ensure-newline ()
(unless (zerop (current-column))
......@@ -217,19 +235,32 @@ fit these criteria."
((eq shr-folding-mode 'none)
(insert t))
(t
(let (column)
(let ((first t)
column)
(when (and (string-match "^[ \t\n]" text)
(not (bolp)))
(insert " "))
(dolist (elem (split-string text))
(setq column (current-column))
(when (> column 0)
(if (> (+ column (length elem) 1) shr-width)
(insert "\n")
(insert " ")))
(cond
((> (+ column (length elem) 1) shr-width)
(insert "\n"))
((not first)
(insert " "))))
(setq first nil)
(when (and (bolp)
(> shr-indentation 0))
(insert (make-string shr-indentation ? )))
;; The shr-start is a special variable that is used to pass
;; upwards the first point in the buffer where the text really
;; starts.
(unless shr-start
(setq shr-start (point)))
(insert elem))))))
(insert elem))
(when (and (string-match "[ \t\n]$" text)
(not (bolp)))
(insert " "))))))
(defun shr-get-image-data (url)
"Get image data for URL.
......@@ -241,6 +272,53 @@ Return a string with image data."
(search-forward "\r\n\r\n" nil t))
(buffer-substring (point) (point-max)))))
(defvar shr-list-mode nil)
(defun shr-tag-ul (cont)
(shr-ensure-paragraph)
(let ((shr-list-mode 'ul))
(shr-generic cont)))
(defun shr-tag-ol (cont)
(let ((shr-list-mode 1))
(shr-generic cont)))
(defun shr-tag-li (cont)
(shr-ensure-newline)
(if (numberp shr-list-mode)
(progn
(insert (format "%d " shr-list-mode))
(setq shr-list-mode (1+ shr-list-mode)))
(insert "* "))
(shr-generic cont))
(defun shr-tag-br (cont)
(shr-ensure-newline)
(shr-generic cont))
(defun shr-tag-h1 (cont)
(shr-heading cont 'bold 'underline))
(defun shr-tag-h2 (cont)
(shr-heading cont 'bold))
(defun shr-tag-h3 (cont)
(shr-heading cont 'italic))
(defun shr-tag-h4 (cont)
(shr-heading cont))
(defun shr-tag-h5 (cont)
(shr-heading cont))
(defun shr-tag-h6 (cont)
(shr-heading cont))
(defun shr-heading (cont &rest types)
(shr-ensure-paragraph)
(apply #'shr-fontize-cont cont types)
(shr-ensure-paragraph))
(provide 'shr)
;;; shr.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment