mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Merge changes made in Gnus trunk.

Browse Source 
shr.el: Start implementation.
shr.el: Continue implementation.
gnus-gravatar.el (gnus-gravatar-insert): Adjust character where we should go backward.
shr.el: Minimally useful state achieved.
mm-decode.el (mm-text-html-renderer): Switch to using shr.el for HTML rendering.
shr.el: (shr-insert): Add a newline after every picture before text.
gnus.texi (Splitting Mail): Really fix the @ref syntax.
shr.el (shr-add-font): Use overlays for combining faces.
shr.el (shr-add-font): Use overlays for combining faces.
shr.el (shr-insert): Pass upwards the text start point.
gnus-util.el: Reintroduce multiple completion functions.
This commit is contained in:
Gnus developers 2010-10-03 00:33:27 +00:00 committed by Katsumi Yamaoka
parent 2a847524ab
commit 870409d4fb
8 changed files with 317 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
doc/misc/ChangeLog
View File

@ -1,6 +1,7 @@
2010-10-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Splitting Mail): Fix @xref syntax.
(Splitting Mail): Really fix the @ref syntax.
2010-10-01 Lars Magne Ingebrigtsen <larsi@gnus.org>

2
doc/misc/gnus.texi
View File

@ -15111,7 +15111,7 @@ message. The function should return a list of group names that it
thinks should carry this mail message.
This variable can also be a fancy split method. For the syntax,
@pxref{Fancy Mail Splitting}.
see @ref{Fancy Mail Splitting}.
Note that the mail back ends are free to maul the poor, innocent,
incoming headers all they want to. They all add @code{Lines} headers;

25
lisp/gnus/ChangeLog
View File

@ -1,3 +1,28 @@
2010-10-02 Julien Danjou <julien@danjou.info>
* gnus-util.el (gnus-iswitchb-completing-read): New function.
(gnus-ido-completing-read): New function.
(gnus-emacs-completing-read): New function.
(gnus-completing-read): Use gnus-completing-read-function.
Add gnus-completing-read-function.
2010-10-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-insert-document): Autoload.
(shr-img): Be silent.
(shr-insert): Add a newline after every picture before text.
(shr-add-font): Use overlays for combining faces.
(shr-insert): Pass upwards the text start point.
* mm-decode.el (mm-text-html-renderer): Default to shr.el rendering, if
possible.
(mm-shr): New function.
2010-10-02 Julien Danjou <julien@danjou.info>
* gnus-gravatar.el (gnus-gravatar-insert): Adjust character where we
should go backward.
2010-10-02 Juanma Barranquero <lekktu@gmail.com>
* shr.el (shr): Fix typo in provide call.

2
lisp/gnus/gnus-gravatar.el
View File

@ -76,7 +76,7 @@ Set image category to CATEGORY."
(search-backward mail-address nil t)))
(goto-char (1- (point)))
;; If we're on the " quoting the name, go backward
(when (looking-at "\"")
(when (looking-at "[\"<]")
(goto-char (1- (point))))
;; Do not do anything if there's already a gravatar. This can
;; happens if the buffer has been regenerated in the mean time, for

28
lisp/gnus/gnus-html.el
View File

@ -402,7 +402,8 @@ Return a string with image data."
(defun gnus-html-put-image (data url &optional alt-text)
(when (gnus-graphic-display-p)
(let* ((start (text-property-any (point-min) (point-max) 'gnus-image-url url))
(let* ((start (text-property-any (point-min) (point-max)
'gnus-image-url url))
(end (when start
(next-single-property-change start 'gnus-image-url))))
;; Image found?
@ -416,7 +417,8 @@ Return a string with image data."
(image-size image t)))))
(save-excursion
(goto-char start)
(let ((alt-text (or alt-text (buffer-substring-no-properties start end))))
(let ((alt-text (or alt-text
(buffer-substring-no-properties start end))))
(if (and image
;; Kludge to avoid displaying 30x30 gif images, which
;; seems to be a signal of a broken image.
@ -424,8 +426,9 @@ Return a string with image data."
(glyphp image)
(listp image))
(eq (if (featurep 'xemacs)
(let ((d (cdadar (specifier-spec-list
(glyph-image image)))))
(let ((d (cdadar
(specifier-spec-list
(glyph-image image)))))
(and (vectorp d)
(aref d 0)))
(plist-get (cdr image) :type))
@ -437,17 +440,21 @@ Return a string with image data."
(delete-region start end)
(gnus-put-image image alt-text 'external)
(gnus-put-text-property start (point) 'help-echo alt-text)
(gnus-overlay-put (gnus-make-overlay start (point)) 'local-map
gnus-html-displayed-image-map)
(gnus-put-text-property start (point) 'gnus-alt-text alt-text)
(gnus-overlay-put
(gnus-make-overlay start (point)) 'local-map
gnus-html-displayed-image-map)
(gnus-put-text-property start (point)
'gnus-alt-text alt-text)
(when url
(gnus-put-text-property start (point) 'gnus-image-url url))
(gnus-put-text-property start (point)
'gnus-image-url url))
(gnus-add-image 'external image)
t)
;; Bad image, try to show something else
(when (fboundp 'find-image)
(delete-region start end)
(setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
(setq image (find-image
'((:type xpm :file "lock-broken.xpm"))))
(gnus-put-image image alt-text 'internal)
(gnus-add-image 'internal image))
nil))))))))
@ -458,7 +465,8 @@ Return a string with image data."
image
(let* ((width (car size))
(height (cdr size))
(edges (gnus-window-inside-pixel-edges (get-buffer-window (current-buffer))))
(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

63
lisp/gnus/gnus-util.el
View File

@ -44,11 +44,19 @@
(defmacro with-no-warnings (&rest body)
`(progn ,@body))))
(defcustom gnus-use-ido nil
"Whether to use `ido' for `completing-read'."
(defcustom gnus-completing-read-function 'gnus-emacs-completing-read
"Function use to do completing read."
:version "24.1"
:group 'gnus-meta
:type 'boolean)
:type '(radio (function-item
:doc "Use Emacs standard `completing-read' function."
gnus-emacs-completing-read)
(function-item
:doc "Use `ido-completing-read' function."
gnus-ido-completing-read)
(function-item
:doc "Use iswitchb based completing-read function."
gnus-iswitchb-completing-read)))
(defcustom gnus-completion-styles
(if (and (boundp 'completion-styles-alist)
@ -1585,17 +1593,46 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
(defun gnus-completing-read (prompt collection &optional require-match
initial-input history def)
"Call `completing-read' or `ido-completing-read'.
Depends on `gnus-use-ido'."
"Call `gnus-completing-read-function'."
(funcall gnus-completing-read-function
(concat prompt (when def
(concat " (default " def ")"))
": ")
collection require-match initial-input history def))
(defun gnus-emacs-completing-read (prompt collection &optional require-match
initial-input history def)
"Call standard `completing-read-function'."
(let ((completion-styles gnus-completion-styles))
(funcall
(if gnus-use-ido
'ido-completing-read
'completing-read)
(concat prompt (when def
(concat " (default " def ")"))
": ")
collection nil require-match initial-input history def)))
(completing-read prompt collection nil require-match initial-input history def)))
(defun gnus-ido-completing-read (prompt collection &optional require-match
initial-input history def)
"Call `ido-completing-read-function'."
(require 'ido)
(ido-completing-read prompt collection nil require-match initial-input history def))
(defun gnus-iswitchb-completing-read (prompt collection &optional require-match
initial-input history def)
"`iswitchb' based completing-read function."
(require 'iswitchb)
(let ((iswitchb-make-buflist-hook
(lambda ()
(setq iswitchb-temp-buflist
(let ((choices (append
(when initial-input (list initial-input))
(symbol-value history) collection))
filtered-choices)
(dolist (x choices)
(setq filtered-choices (adjoin x filtered-choices)))
(nreverse filtered-choices))))))
(unwind-protect
(progn
(when (not iswitchb-mode)
(add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
(iswitchb-read-buffer prompt def require-match))
(when (not iswitchb-mode)
(remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
(defun gnus-graphic-display-p ()
(if (featurep 'xemacs)

11
lisp/gnus/mm-decode.el
View File

@ -105,7 +105,8 @@
,disposition ,description ,cache ,id))
(defcustom mm-text-html-renderer
(cond ((executable-find "w3m") 'gnus-article-html)
(cond ((fboundp 'libxml-parse-html-region) 'mm-shr)
((executable-find "w3m") 'gnus-article-html)
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
((locate-library "w3") 'w3)
@ -1674,6 +1675,14 @@ If RECURSIVE, search recursively."
(and (eq (mm-body-7-or-8) '7bit)
(not (mm-long-lines-p 76))))))
(defun mm-shr (handle)
(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))))))
(provide 'mm-decode)
;;; mm-decode.el ends here

211
lisp/gnus/shr.el
View File

@ -30,6 +30,217 @@
;;; Code:
(defgroup shr nil
"Simple HTML Renderer"
:group 'mail)
(defcustom shr-max-image-proportion 0.9
"How big pictures displayed are in relation to the window they're in.
A value of 0.7 means that they are allowed to take up 70% of the
width and height of the window. If they are larger than this,
and Emacs supports it, then the images will be rescaled down to
fit these criteria."
:version "24.1"
:group 'shr
:type 'float)
(defcustom shr-blocked-images nil
"Images that have URLs matching this regexp will be blocked."
:version "24.1"
:group 'shr
:type 'regexp)
(defvar shr-folding-mode nil)
(defvar shr-state nil)
(defvar shr-start nil)
(defvar shr-width 70)
(defun shr-transform-dom (dom)
(let ((result (list (pop dom))))
(dolist (arg (pop dom))
(push (cons (intern (concat ":" (symbol-name (car arg))) obarray)
(cdr arg))
result))
(dolist (sub dom)
(if (stringp sub)
(push (cons :text sub) result)
(push (shr-transform-dom sub) result)))
(nreverse result)))
;;;###autoload
(defun shr-insert-document (dom)
(let ((shr-state nil)
(shr-start nil))
(shr-descend (shr-transform-dom dom))))
(defun shr-descend (dom)
(let ((function (intern (concat "shr-" (symbol-name (car dom))) obarray)))
(if (fboundp function)
(funcall function (cdr dom))
(shr-generic (cdr dom)))))
(defun shr-generic (cont)
(dolist (sub cont)
(cond
((eq (car sub) :text)
(shr-insert (cdr sub)))
((consp (cdr sub))
(shr-descend sub)))))
(defun shr-p (cont)
(shr-ensure-newline)
(insert "\n")
(shr-generic cont)
(insert "\n"))
(defun shr-b (cont)
(shr-fontize-cont cont 'bold))
(defun shr-i (cont)
(shr-fontize-cont cont 'italic))
(defun shr-u (cont)
(shr-fontize-cont cont 'underline))
(defun shr-s (cont)
(shr-fontize-cont cont 'strikethru))
(defun shr-fontize-cont (cont type)
(let (shr-start)
(shr-generic cont)
(shr-add-font shr-start (point) type)))
(defun shr-add-font (start end type)
(let ((overlay (make-overlay start end)))
(overlay-put overlay 'face type)))
(defun shr-a (cont)
(let ((url (cdr (assq :href cont)))
shr-start)
(shr-generic cont)
(widget-convert-button
'link shr-start (point)
:action 'shr-browse-url
:url url
:keymap widget-keymap
:help-echo url)))
(defun shr-browse-url (widget &rest stuff)
(browse-url (widget-get widget :url)))
(defun shr-img (cont)
(let ((start (point-marker)))
(let ((alt (cdr (assq :alt cont)))
(url (cdr (assq :src cont))))
(when (zerop (length alt))
(setq alt "[img]"))
(cond
((and shr-blocked-images
(string-match shr-blocked-images url))
(insert alt))
((url-is-cached (browse-url-url-encode-chars url "[&)$ ]"))
(shr-put-image (shr-get-image-data url) (point) alt))
(t
(insert alt)
(url-retrieve url 'shr-image-fetched
(list (current-buffer) start (point-marker))
t)))
(insert " ")
(setq shr-state 'image))))
(defun shr-image-fetched (status buffer start end)
(when (and (buffer-name buffer)
(not (plist-get status :error)))
(url-store-in-cache (current-buffer))
(when (or (search-forward "\n\n" nil t)
(search-forward "\r\n\r\n" nil t))
(let ((data (buffer-substring (point) (point-max))))
(with-current-buffer buffer
(let ((alt (buffer-substring start end))
(inhibit-read-only t))
(delete-region start end)
(shr-put-image data start alt))))))
(kill-buffer (current-buffer)))
(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))))
(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))
(width (car size))
(height (cdr size))
(edges (window-inside-pixel-edges
(get-buffer-window (current-buffer))))
(window-width (truncate (* shr-max-image-proportion
(- (nth 2 edges) (nth 0 edges)))))
(window-height (truncate (* shr-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 shr-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-ensure-newline ()
(unless (zerop (current-column))
(insert "\n")))
(defun shr-insert (text)
(when (eq shr-state 'image)
(insert "\n")
(setq shr-state nil))
(cond
((eq shr-folding-mode 'none)
(insert t))
(t
(let (column)
(dolist (elem (split-string text))
(setq column (current-column))
(when (plusp column)
(if (> (+ column (length elem) 1) shr-width)
(insert "\n")
(insert " ")))
;; 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))))))
(defun shr-get-image-data (url)
"Get image data for URL.
Return a string with image data."
(with-temp-buffer
(mm-disable-multibyte)
(url-cache-extract (url-cache-create-filename url))
(when (or (search-forward "\n\n" nil t)
(search-forward "\r\n\r\n" nil t))
(buffer-substring (point) (point-max)))))
(provide 'shr)
;;; shr.el ends here