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.
+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
@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):
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)
(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."
(= (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)
(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
(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."
(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
: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
(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)
(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")
: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.
;;;
(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
(defvar shr-folding-mode nil)
(defvar shr-state nil)
(defvar shr-start nil)
+(defvar shr-indentation 0)
(defvar shr-width 70)
(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)))))
(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)
(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))))
(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
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))
((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.
(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
projects / emacs.git / commitdiff