Mercurial > emacs
changeset 110763:0fe64d68a522
Merge changes made in Gnus trunk.
shr.el: Implement table rendering.
shr.el (shr-make-table): Tweak table generation.
shr.el (shr-make-table): Fix typo.
nnimap.el (nnimap-open-connection): Allow tls as a synonym for ssl.
gnus-util.el (gnus-emacs-completing-read): Mapcar collection to list, for XEmacs.
nnimap.el (nnimap-close-server): Implement.
gnus-salt.el: Remove all gnus-carpal stuff -- it's not useful.
nnir.el (nnir-run-imap): Remove spurious space in search string.
message.el (message-idna-to-ascii-rhs-1): Don't bug out on addresses without @ signs.
gnus-sum.el (gnus-widen-article-window): New variable.
shr.el (browse-url): Required.
shr.el (shr-ensure-paragraph): Don't insert a new newline after empty-ish lines.
shr.el (shr-show-alt-text, shr-browse-image): New commands.
gravatar.el (gravatar-retrieved): kill buffer when retrieved.
shr.el (shr-browse-url, shr-copy-url): New commands.
shr.el (shr-render-td): Protect against too-wide text.
spam-report.el (spam-report-url-ping-plain): Don't query about killing the process.
nnimap.el (nnimap-finish-retrieve-group-infos): Message while waiting for data.
shr.el (shr-tag-blockquote): Ensure paragraph after quote, too.
mml-smime.el: Fix gnus-completing-read usage.
shr.el (shr-get-image-data): Ensure against the cache file missing.
nnimap.el (nnimap-open-connection): Give an error if nnimap-stream is unknown.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Mon, 04 Oct 2010 22:26:51 +0000 |
| parents | d6e88106c5b8 |
| children | e015fb08f891 |
| files | doc/misc/ChangeLog doc/misc/gnus-news.texi doc/misc/gnus.texi lisp/gnus/ChangeLog lisp/gnus/gnus-group.el lisp/gnus/gnus-salt.el lisp/gnus/gnus-srvr.el lisp/gnus/gnus-sum.el lisp/gnus/gnus-util.el lisp/gnus/gnus-win.el lisp/gnus/gnus.el lisp/gnus/gravatar.el lisp/gnus/message.el lisp/gnus/mml-smime.el lisp/gnus/nnimap.el lisp/gnus/nnir.el lisp/gnus/shr.el lisp/gnus/spam-report.el |
| diffstat | 18 files changed, 333 insertions(+), 300 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Mon Oct 04 21:44:08 2010 +0200 +++ b/doc/misc/ChangeLog Mon Oct 04 22:26:51 2010 +0000 @@ -1,3 +1,7 @@ +2010-10-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Misc Article): Document gnus-widen-article-window. + 2010-10-03 Julien Danjou <julien@danjou.info> * emacs-mime.texi (Display Customization): Update
--- a/doc/misc/gnus-news.texi Mon Oct 04 21:44:08 2010 +0200 +++ b/doc/misc/gnus-news.texi Mon Oct 04 22:26:51 2010 +0000 @@ -356,6 +356,8 @@ @item NoCeM support has been removed. +@item Carpal mode has been removed. + @end itemize @end itemize
--- a/doc/misc/gnus.texi Mon Oct 04 21:44:08 2010 +0200 +++ b/doc/misc/gnus.texi Mon Oct 04 22:26:51 2010 +0000 @@ -797,7 +797,6 @@ * Compilation:: How to speed Gnus up. * Mode Lines:: Displaying information in the mode lines. * Highlighting and Menus:: Making buffers look all nice and cozy. -* Buttons:: Get tendinitis in ten easy steps! * Daemons:: Gnus can do things behind your back. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. @@ -12847,6 +12846,11 @@ (This is the default.) If @code{nil}, each group will have its own article buffer. +@item gnus-widen-article-window +@cindex gnus-widen-article-window +If non-@code{nil}, selecting the article buffer with the @kbd{h} +command will ``widen'' the article window to take the entire frame. + @vindex gnus-article-decode-hook @item gnus-article-decode-hook @cindex @acronym{MIME} @@ -21717,7 +21721,6 @@ * Compilation:: How to speed Gnus up. * Mode Lines:: Displaying information in the mode lines. * Highlighting and Menus:: Making buffers look all nice and cozy. -* Buttons:: Get tendinitis in ten easy steps! * Daemons:: Gnus can do things behind your back. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. @@ -22178,8 +22181,7 @@ buffer should be given. Here's an excerpt of this variable: @lisp -((group (vertical 1.0 (group 1.0 point) - (if gnus-carpal (group-carpal 4)))) +((group (vertical 1.0 (group 1.0 point))) (article (vertical 1.0 (summary 0.25 point) (article 1.0)))) @end lisp @@ -22217,7 +22219,6 @@ @lisp (article (vertical 1.0 (group 4) (summary 0.25 point) - (if gnus-carpal (summary-carpal 4)) (article 1.0))) @end lisp @@ -22228,20 +22229,16 @@ If the @dfn{split} looks like something that can be @code{eval}ed (to be precise---if the @code{car} of the split is a function or a subr), this split will be @code{eval}ed. If the result is non-@code{nil}, it will -be used as a split. This means that there will be three buffers if -@code{gnus-carpal} is @code{nil}, and four buffers if @code{gnus-carpal} -is non-@code{nil}. +be used as a split. Not complicated enough for you? Well, try this on for size: @lisp (article (horizontal 1.0 (vertical 0.5 - (group 1.0) - (gnus-carpal 4)) + (group 1.0)) (vertical 1.0 (summary 0.25 point) - (summary-carpal 4) (article 1.0)))) @end lisp @@ -22618,62 +22615,6 @@ @end table -@node Buttons -@section Buttons -@cindex buttons -@cindex mouse -@cindex click - -Those new-fangled @dfn{mouse} contraptions is very popular with the -young, hep kids who don't want to learn the proper way to do things -these days. Why, I remember way back in the summer of '89, when I was -using Emacs on a Tops 20 system. Three hundred users on one single -machine, and every user was running Simula compilers. Bah! - -Right. - -@vindex gnus-carpal -Well, you can make Gnus display bufferfuls of buttons you can click to -do anything by setting @code{gnus-carpal} to @code{t}. Pretty simple, -really. Tell the chiropractor I sent you. - - -@table @code - -@item gnus-carpal-mode-hook -@vindex gnus-carpal-mode-hook -Hook run in all carpal mode buffers. - -@item gnus-carpal-button-face -@vindex gnus-carpal-button-face -Face used on buttons. - -@item gnus-carpal-header-face -@vindex gnus-carpal-header-face -Face used on carpal buffer headers. - -@item gnus-carpal-group-buffer-buttons -@vindex gnus-carpal-group-buffer-buttons -Buttons in the group buffer. - -@item gnus-carpal-summary-buffer-buttons -@vindex gnus-carpal-summary-buffer-buttons -Buttons in the summary buffer. - -@item gnus-carpal-server-buffer-buttons -@vindex gnus-carpal-server-buffer-buttons -Buttons in the server buffer. - -@item gnus-carpal-browse-buffer-buttons -@vindex gnus-carpal-browse-buffer-buttons -Buttons in the browse buffer. -@end table - -All the @code{buttons} variables are lists. The elements in these list -are either cons cells where the @code{car} contains a text to be displayed and -the @code{cdr} contains a function symbol, or a simple string. - - @node Daemons @section Daemons @cindex demons @@ -26651,10 +26592,6 @@ You can do lots of strange stuff with the Gnus window & frame configuration (@pxref{Window Layout}). -@item -You can click on buttons instead of using the keyboard -(@pxref{Buttons}). - @end itemize
--- a/lisp/gnus/ChangeLog Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/ChangeLog Mon Oct 04 22:26:51 2010 +0000 @@ -1,11 +1,64 @@ 2010-10-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + * shr.el (shr-tag-blockquote): Ensure paragraph after quote, too. + (shr-get-image-data): Ensure against the cache file missing. + + * nnimap.el (nnimap-finish-retrieve-group-infos): Message while waiting + for data. + + * spam-report.el (spam-report-url-ping-plain): Don't query about + killing the process. + + * shr.el (shr-render-td): Protect against too-wide text. + +2010-10-04 Julien Danjou <julien@danjou.info> + + * mml-smime.el (mml-smime-openssl-encrypt-query): Fix choices. + (mml-smime-openssl-sign-query): Fix gnus-completing-read call. + + * gravatar.el (gravatar-retrieved): Kill buffer when gravatar has been + retrieved. + +2010-10-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (browse-url): Required. + (shr-ensure-paragraph): Don't insert a new newline after empty-ish + lines. + (shr-show-alt-text, shr-browse-image): New commands. + (shr-browse-url, shr-copy-url): New commands. + + * gnus-sum.el (gnus-widen-article-window): New variable. + (gnus-summary-select-article-buffer): Use it. + + * message.el (message-idna-to-ascii-rhs-1): Don't bug out on addresses + without @ signs. + +2010-10-04 Michael Welsh Duggan <md5i@md5i.com> (tiny change) + + * nnir.el (nnir-run-imap): Remove spurious space in search string. + +2010-10-04 Julien Danjou <julien@danjou.info> + + * gnus-util.el (gnus-emacs-completing-read): Mapcar collection to list, + for XEmacs. + +2010-10-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-salt.el: Remove all gnus-carpal stuff -- it's not useful. + + * nnimap.el (nnimap-open-connection): Allow tls as a synonym for ssl. + (nnimap-close-server): Implement. + * shr.el (shr-ensure-paragraph): Fix the non-empty line case. (shr-insert): Tweak line breaking. (shr-insert): Handle <pre> better. (shr-tag-li): Get <li> indentation right. (shr-tag-li): Get <li> indentation even righter. (shr-tag-blockquote): Ensure paragraph start. + (shr-make-table): Tweak table generation. + (shr-make-table): Fix typo. + + * shr.el: Implement table rendering. 2010-10-04 Julien Danjou <julien@danjou.info> @@ -1458,8 +1511,6 @@ * nnimap.el (nnimap-open-connection): If the user doesn't have a /etc/services, supply some sensible port defaults. - * dgnushack.el: Define netrc-credentials. - 2010-09-17 Julien Danjou <julien@danjou.info> * mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
--- a/lisp/gnus/gnus-group.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gnus-group.el Mon Oct 04 22:26:51 2010 +0000 @@ -1186,9 +1186,7 @@ (defun gnus-group-setup-buffer () (set-buffer (gnus-get-buffer-create gnus-group-buffer)) (unless (eq major-mode 'gnus-group-mode) - (gnus-group-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'group)))) + (gnus-group-mode))) (defun gnus-group-name-charset (method group) (if (null method)
--- a/lisp/gnus/gnus-salt.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gnus-salt.el Mon Oct 04 22:26:51 2010 +0000 @@ -869,177 +869,6 @@ (set-window-point (gnus-get-buffer-window (current-buffer) t) (cdr region)))))) -;;; -;;; gnus-carpal -;;; - -(defvar gnus-carpal-group-buffer-buttons - '(("next" . gnus-group-next-unread-group) - ("prev" . gnus-group-prev-unread-group) - ("read" . gnus-group-read-group) - ("select" . gnus-group-select-group) - ("catch-up" . gnus-group-catchup-current) - ("new-news" . gnus-group-get-new-news-this-group) - ("toggle-sub" . gnus-group-unsubscribe-current-group) - ("subscribe" . gnus-group-unsubscribe-group) - ("kill" . gnus-group-kill-group) - ("yank" . gnus-group-yank-group) - ("describe" . gnus-group-describe-group) - "list" - ("subscribed" . gnus-group-list-groups) - ("all" . gnus-group-list-all-groups) - ("killed" . gnus-group-list-killed) - ("zombies" . gnus-group-list-zombies) - ("matching" . gnus-group-list-matching) - ("post" . gnus-group-post-news) - ("mail" . gnus-group-mail) - ("local" . (lambda () (interactive) (gnus-group-news 0))) - ("rescan" . gnus-group-get-new-news) - ("browse-foreign" . gnus-group-browse-foreign) - ("exit" . gnus-group-exit))) - -(defvar gnus-carpal-summary-buffer-buttons - '("mark" - ("read" . gnus-summary-mark-as-read-forward) - ("tick" . gnus-summary-tick-article-forward) - ("clear" . gnus-summary-clear-mark-forward) - ("expirable" . gnus-summary-mark-as-expirable) - "move" - ("scroll" . gnus-summary-next-page) - ("next-unread" . gnus-summary-next-unread-article) - ("prev-unread" . gnus-summary-prev-unread-article) - ("first" . gnus-summary-first-unread-article) - ("best" . gnus-summary-best-unread-article) - "article" - ("headers" . gnus-summary-toggle-header) - ("uudecode" . gnus-uu-decode-uu) - ("enter-digest" . gnus-summary-enter-digest-group) - ("fetch-parent" . gnus-summary-refer-parent-article) - "mail" - ("move" . gnus-summary-move-article) - ("copy" . gnus-summary-copy-article) - ("respool" . gnus-summary-respool-article) - "threads" - ("lower" . gnus-summary-lower-thread) - ("kill" . gnus-summary-kill-thread) - "post" - ("post" . gnus-summary-post-news) - ("local" . gnus-summary-news-other-window) - ("mail" . gnus-summary-mail-other-window) - ("followup" . gnus-summary-followup-with-original) - ("reply" . gnus-summary-reply-with-original) - ("cancel" . gnus-summary-cancel-article) - "misc" - ("exit" . gnus-summary-exit) - ("fed-up" . gnus-summary-catchup-and-goto-next-group))) - -(defvar gnus-carpal-server-buffer-buttons - '(("add" . gnus-server-add-server) - ("browse" . gnus-server-browse-server) - ("list" . gnus-server-list-servers) - ("kill" . gnus-server-kill-server) - ("yank" . gnus-server-yank-server) - ("copy" . gnus-server-copy-server) - ("exit" . gnus-server-exit))) - -(defvar gnus-carpal-browse-buffer-buttons - '(("subscribe" . gnus-browse-unsubscribe-current-group) - ("exit" . gnus-browse-exit))) - -(defvar gnus-carpal-group-buffer "*Carpal Group*") -(defvar gnus-carpal-summary-buffer "*Carpal Summary*") -(defvar gnus-carpal-server-buffer "*Carpal Server*") -(defvar gnus-carpal-browse-buffer "*Carpal Browse*") - -(defvar gnus-carpal-attached-buffer nil) - -(defvar gnus-carpal-mode-hook nil - "*Hook run in carpal mode buffers.") - -(defvar gnus-carpal-button-face 'bold - "*Face used on carpal buttons.") - -(defvar gnus-carpal-header-face 'bold-italic - "*Face used on carpal buffer headers.") - -(defvar gnus-carpal-mode-map nil) -(put 'gnus-carpal-mode 'mode-class 'special) - -(if gnus-carpal-mode-map - nil - (setq gnus-carpal-mode-map (make-keymap)) - (suppress-keymap gnus-carpal-mode-map) - (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) - (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) - (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select)) - -(defun gnus-carpal-mode () - "Major mode for clicking buttons. - -All normal editing commands are switched off. -\\<gnus-carpal-mode-map> -The following commands are available: - -\\{gnus-carpal-mode-map}" - (interactive) - (kill-all-local-variables) - (setq mode-line-modified (cdr gnus-mode-line-modified)) - (setq major-mode 'gnus-carpal-mode) - (setq mode-name "Gnus Carpal") - (setq mode-line-process nil) - (use-local-map gnus-carpal-mode-map) - (buffer-disable-undo) - (setq buffer-read-only t) - (make-local-variable 'gnus-carpal-attached-buffer) - (gnus-run-mode-hooks 'gnus-carpal-mode-hook)) - -(defun gnus-carpal-setup-buffer (type) - (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) - (if (get-buffer buffer) - () - (with-current-buffer (gnus-get-buffer-create buffer) - (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer - (intern (format "gnus-%s-buffer" type))) - (let ((buttons (symbol-value - (intern (format "gnus-carpal-%s-buffer-buttons" - type)))) - (buffer-read-only nil) - button) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (if (stringp button) - (set-text-properties - (point) - (prog2 (insert button) (point) (insert " ")) - (list 'face gnus-carpal-header-face)) - (set-text-properties - (point) - (prog2 (insert (car button)) (point) (insert " ")) - (list 'gnus-callback (cdr button) - 'face gnus-carpal-button-face - gnus-mouse-face-prop 'highlight)))) - (let ((fill-column (- (window-width) 2))) - (fill-region (point-min) (point-max))) - (set-window-point (get-buffer-window (current-buffer)) - (point-min))))))) - -(defun gnus-carpal-select () - "Select the button under point." - (interactive) - (let ((func (get-text-property (point) 'gnus-callback))) - (if (null func) - () - (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) - (call-interactively func)))) - -(defun gnus-carpal-mouse-select (event) - "Select the button under the mouse pointer." - (interactive "e") - (mouse-set-point event) - (gnus-carpal-select)) - ;;; Allow redefinition of functions. (gnus-ems-redefine)
--- a/lisp/gnus/gnus-srvr.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gnus-srvr.el Mon Oct 04 22:26:51 2010 +0000 @@ -301,9 +301,7 @@ "Initialize the server buffer." (unless (get-buffer gnus-server-buffer) (with-current-buffer (gnus-get-buffer-create gnus-server-buffer) - (gnus-server-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'server))))) + (gnus-server-mode)))) (defun gnus-server-prepare () (gnus-set-format 'server-mode) @@ -806,8 +804,6 @@ (funcall gnus-group-prepare-function gnus-level-killed 'ignore 1 'ignore)) (gnus-get-buffer-create gnus-browse-buffer) - (when gnus-carpal - (gnus-carpal-setup-buffer 'browse)) (gnus-configure-windows 'browse) (buffer-disable-undo) (let ((buffer-read-only nil))
--- a/lisp/gnus/gnus-sum.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gnus-sum.el Mon Oct 04 22:26:51 2010 +0000 @@ -474,6 +474,12 @@ :group 'gnus-article-various :type 'boolean) +(defcustom gnus-widen-article-window nil + "If non-nil, selecting the article buffer will display only the article buffer." + :version "24.1" + :group 'gnus-article-various + :type 'boolean) + (defcustom gnus-break-pages t "*If non-nil, do page breaking on articles. The page delimiter is specified by the `gnus-page-delimiter' @@ -3493,8 +3499,6 @@ ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) (gnus-summary-mode group) - (when gnus-carpal - (gnus-carpal-setup-buffer 'summary)) (when (gnus-group-quit-config group) (set (make-local-variable 'gnus-single-article-buffer) nil)) (make-local-variable 'gnus-article-buffer) @@ -6935,7 +6939,11 @@ (error "There is no article buffer for this summary buffer") (unless (get-buffer-window gnus-article-buffer) (gnus-summary-show-article)) - (gnus-configure-windows 'article t) + (gnus-configure-windows + (if gnus-widen-article-window + 'only-article + 'article) + t) (select-window (get-buffer-window gnus-article-buffer)))) (defun gnus-summary-universal-argument (arg)
--- a/lisp/gnus/gnus-util.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gnus-util.el Mon Oct 04 22:26:51 2010 +0000 @@ -1602,7 +1602,11 @@ initial-input history def) "Call standard `completing-read-function'." (let ((completion-styles gnus-completion-styles)) - (completing-read prompt collection nil require-match initial-input history def))) + (completing-read prompt + ;; Old XEmacs (at least 21.4) expect an alist for + ;; collection. + (mapcar 'list collection) + nil require-match initial-input history def))) (defun gnus-ido-completing-read (prompt collection &optional require-match initial-input history def)
--- a/lisp/gnus/gnus-win.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gnus-win.el Mon Oct 04 22:26:51 2010 +0000 @@ -68,12 +68,10 @@ (defvar gnus-buffer-configuration '((group (vertical 1.0 - (group 1.0 point) - (if gnus-carpal '(group-carpal 4)))) + (group 1.0 point))) (summary (vertical 1.0 - (summary 1.0 point) - (if gnus-carpal '(summary-carpal 4)))) + (summary 1.0 point))) (article (cond (gnus-use-trees @@ -84,16 +82,13 @@ (t '(vertical 1.0 (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) (article 1.0))))) (server (vertical 1.0 - (server 1.0 point) - (if gnus-carpal '(server-carpal 2)))) + (server 1.0 point))) (browse (vertical 1.0 - (browse 1.0 point) - (if gnus-carpal '(browse-carpal 2)))) + (browse 1.0 point))) (message (vertical 1.0 (message 1.0 point))) @@ -145,7 +140,6 @@ (pipe (vertical 1.0 (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) ("*Shell Command Output*" 1.0))) (bug (vertical 1.0 @@ -189,10 +183,6 @@ (edit-group . gnus-group-edit-buffer) (edit-form . gnus-edit-form-buffer) (edit-server . gnus-server-edit-buffer) - (group-carpal . gnus-carpal-group-buffer) - (summary-carpal . gnus-carpal-summary-buffer) - (server-carpal . gnus-carpal-server-buffer) - (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) (message . gnus-message-buffer) (mail . gnus-message-buffer)
--- a/lisp/gnus/gnus.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gnus.el Mon Oct 04 22:26:51 2010 +0000 @@ -1626,11 +1626,6 @@ (function-item mail-extract-address-components) (function :tag "Other"))) -(defcustom gnus-carpal nil - "*If non-nil, display clickable icons." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-shell-command-separator ";" "String used to separate shell commands." :group 'gnus-files @@ -2803,7 +2798,7 @@ gnus-convert-image-to-gray-x-face gnus-convert-face-to-png gnus-face-from-file) ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree - gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) + gnus-tree-open gnus-tree-close) ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server)
--- a/lisp/gnus/gravatar.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/gravatar.el Mon Oct 04 22:26:51 2010 +0000 @@ -125,7 +125,8 @@ (if (plist-get status :error) ;; Error happened. (apply cb 'error cbargs) - (apply cb (gravatar-data->image) cbargs))) + (apply cb (gravatar-data->image) cbargs)) + (kill-buffer (current-buffer))) (provide 'gravatar)
--- a/lisp/gnus/message.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/message.el Mon Oct 04 22:26:51 2010 +0000 @@ -5736,7 +5736,9 @@ (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) (mapcar 'downcase (mapcar - 'cadr + (lambda (elem) + (or (cadr elem) + "")) (mail-extract-address-components field t)))))) ;; Note that `rhs' will be "" if the address does not have ;; the domain part, i.e., if it is a local user's address.
--- a/lisp/gnus/mml-smime.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/mml-smime.el Mon Oct 04 22:26:51 2010 +0000 @@ -162,7 +162,7 @@ (and from (smime-get-key-by-email from))) (smime-get-key-by-email (gnus-completing-read "Sign this part with what signature" - smime-keys nil nil + (mapcar 'car smime-keys) nil nil nil (and (listp (car-safe smime-keys)) (caar smime-keys)))))))) @@ -221,7 +221,7 @@ (while (not done) (ecase (read (gnus-completing-read "Fetch certificate from" - '(("dns") ("ldap") ("file")) t nil nil + '("dns" "ldap" "file") t nil nil "ldap")) (dns (setq certs (append certs (mml-smime-get-dns-cert))))
--- a/lisp/gnus/nnimap.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/nnimap.el Mon Oct 04 22:26:51 2010 +0000 @@ -316,7 +316,7 @@ (setq port (or nnimap-server-port "imap")) 'starttls)) '("imap")) - ((eq nnimap-stream 'ssl) + ((memq nnimap-stream '(ssl tls)) (open-tls-stream "*nnimap*" (current-buffer) nnimap-address (setq port @@ -324,7 +324,9 @@ (if (netrc-find-service-number "imaps") "imaps" "993")))) - '("143" "993" "imap" "imaps")))) + '("143" "993" "imap" "imaps")) + (t + (error "Unknown stream type: %s" nnimap-stream)))) connection-result login-result credentials) (setf (nnimap-process nnimap-object) (get-buffer-process (current-buffer))) @@ -424,7 +426,10 @@ result)) (deffoo nnimap-close-server (&optional server) - t) + (when (nnoo-change-server 'nnimap server nil) + (ignore-errors + (delete-process (get-buffer-process (nnimap-buffer)))) + t)) (deffoo nnimap-request-close () t) @@ -974,7 +979,7 @@ (nnimap-possibly-change-group nil server)) (with-current-buffer (nnimap-buffer) ;; Wait for the final data to trickle in. - (when (nnimap-wait-for-response (cadar sequences)) + (when (nnimap-wait-for-response (cadar sequences) t) ;; Now we should have all the data we need, no matter whether ;; we're QRESYNCING, fetching all the flags from scratch, or ;; just fetching the last 100 flags per group. @@ -1251,7 +1256,7 @@ (point-min)) t))) (when messagep - (message "Read %dKB" (/ (buffer-size) 1000))) + (message "nnimap read %dk" (/ (buffer-size) 1000))) (nnheader-accept-process-output process) (goto-char (point-max))) openp))
--- a/lisp/gnus/nnir.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/nnir.el Mon Oct 04 22:26:51 2010 +0000 @@ -985,7 +985,7 @@ (message "Searching %s..." group) (let ((arts 0) (result - (nnimap-command "UID SEARCH %s" + (nnimap-command "UID SEARCH %s" (if (string= criteria "") qstring (nnir-imap-make-query criteria qstring)
--- a/lisp/gnus/shr.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/shr.el Mon Oct 04 22:26:51 2010 +0000 @@ -30,6 +30,8 @@ ;;; Code: +(require 'browse-url) + (defgroup shr nil "Simple HTML Renderer" :group 'mail) @@ -57,6 +59,16 @@ (defvar shr-width 70) +(defvar shr-map + (let ((map (make-sparse-keymap))) + (define-key map "a" 'shr-show-alt-text) + (define-key map "i" 'shr-browse-image) + (define-key map "I" 'shr-insert-image) + (define-key map "u" 'shr-copy-url) + (define-key map "v" 'shr-browse-url) + (define-key map "\r" 'shr-browse-url) + map)) + (defun shr-transform-dom (dom) (let ((result (list (pop dom)))) (dolist (arg (pop dom)) @@ -97,7 +109,9 @@ (defun shr-ensure-paragraph () (unless (bobp) (if (bolp) - (unless (eql (char-after (- (point) 2)) ?\n) + (unless (save-excursion + (forward-line -1) + (looking-at " *$")) (insert "\n")) (if (save-excursion (beginning-of-line) @@ -129,17 +143,53 @@ (defun shr-tag-a (cont) (let ((url (cdr (assq :href cont))) + (start (point)) shr-start) (shr-generic cont) (widget-convert-button - 'link shr-start (point) - :action 'shr-browse-url - :url url - :keymap widget-keymap - :help-echo url))) + 'link (or shr-start start) (point) + :help-echo url) + (put-text-property (or shr-start start) (point) 'keymap shr-map) + (put-text-property (or shr-start start) (point) 'shr-url url))) + +(defun shr-browse-url () + "Browse the URL under point." + (interactive) + (let ((url (get-text-property (point) 'shr-url))) + (if (not url) + (message "No link under point") + (browse-url url)))) -(defun shr-browse-url (widget &rest stuff) - (browse-url (widget-get widget :url))) +(defun shr-copy-url () + "Copy the URL under point to the kill ring. +If called twice, then try to fetch the URL and see whether it +redirects somewhere else." + (interactive) + (let ((url (get-text-property (point) 'shr-url))) + (cond + ((not url) + (message "No URL under point")) + ;; Resolve redirected URLs. + ((equal url (car kill-ring)) + (url-retrieve + url + (lambda (a) + (when (and (consp a) + (eq (car a) :redirect)) + (with-temp-buffer + (insert (cadr a)) + (goto-char (point-min)) + ;; Remove common tracking junk from the URL. + (when (re-search-forward ".utm_.*" nil t) + (replace-match "" t t)) + (message "Copied %s" (buffer-string)) + (copy-region-as-kill (point-min) (point-max))))))) + ;; Copy the URL to the kill ring. + (t + (with-temp-buffer + (insert url) + (copy-region-as-kill (point-min) (point-max)) + (message "Copied %s" url)))))) (defun shr-tag-img (cont) (when (and (> (current-column) 0) @@ -162,8 +212,28 @@ (list (current-buffer) start (point-marker)) t))) (insert " ") + (put-text-property start (point) 'keymap shr-map) + (put-text-property start (point) 'shr-alt alt) + (put-text-property start (point) 'shr-image url) (setq shr-state 'image)))) +(defun shr-show-alt-text () + "Show the ALT text of the image under point." + (interactive) + (let ((text (get-text-property (point) 'shr-alt))) + (if (not text) + (message "No image under point") + (message "%s" text)))) + +(defun shr-browse-image () + "Browse the image under point." + (interactive) + (let ((url (get-text-property (point) 'shr-image))) + (if (not url) + (message "No image under point") + (message "Browsing %s..." url) + (browse-url url)))) + (defun shr-image-fetched (status buffer start end) (when (and (buffer-name buffer) (not (plist-get status :error))) @@ -222,7 +292,8 @@ (defun shr-tag-blockquote (cont) (shr-ensure-paragraph) (let ((shr-indentation (+ shr-indentation 4))) - (shr-generic cont))) + (shr-generic cont)) + (shr-ensure-paragraph)) (defun shr-ensure-newline () (unless (zerop (current-column)) @@ -254,7 +325,7 @@ (setq first nil) (when (and (bolp) (> shr-indentation 0)) - (insert (make-string shr-indentation ? ))) + (shr-indent)) ;; The shr-start is a special variable that is used to pass ;; upwards the first point in the buffer where the text really ;; starts. @@ -267,15 +338,20 @@ (insert " ") (setq shr-state 'space)))))) +(defun shr-indent () + (insert (make-string shr-indentation ? ))) + (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))))) + (when (ignore-errors + (url-cache-extract (url-cache-create-filename url)) + t) + (when (or (search-forward "\n\n" nil t) + (search-forward "\r\n\r\n" nil t)) + (buffer-substring (point) (point-max)))))) (defvar shr-list-mode nil) @@ -328,6 +404,140 @@ (apply #'shr-fontize-cont cont types) (shr-ensure-paragraph)) +(defun shr-tag-table (cont) + (shr-ensure-paragraph) + (setq cont (or (cdr (assq 'tbody cont)) + cont)) + (let* ((columns (shr-column-specs cont)) + (suggested-widths (shr-pro-rate-columns columns)) + (sketch (shr-make-table cont suggested-widths)) + (sketch-widths (shr-table-widths sketch (length suggested-widths)))) + (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))) + +(defun shr-insert-table (table widths) + (shr-insert-table-ruler widths) + (dolist (row table) + (let ((start (point)) + (height (let ((max 0)) + (dolist (column row) + (setq max (max max (cadr column)))) + max))) + (dotimes (i height) + (shr-indent) + (insert "|\n")) + (dolist (column row) + (goto-char start) + (let ((lines (split-string (nth 2 column) "\n"))) + (dolist (line lines) + (when (> (length line) 0) + (end-of-line) + (insert line "|") + (forward-line 1))) + ;; Add blank lines at padding at the bottom of the TD, + ;; possibly. + (dotimes (i (- height (length lines))) + (end-of-line) + (insert (make-string (length (car lines)) ? ) "|") + (forward-line 1))))) + (shr-insert-table-ruler widths))) + +(defun shr-insert-table-ruler (widths) + (shr-indent) + (insert "+") + (dotimes (i (length widths)) + (insert (make-string (aref widths i) ?-) ?+)) + (insert "\n")) + +(defun shr-table-widths (table length) + (let ((widths (make-vector length 0))) + (dolist (row table) + (let ((i 0)) + (dolist (column row) + (aset widths i (max (aref widths i) + (car column))) + (incf i)))) + widths)) + +(defun shr-make-table (cont widths &optional fill) + (let ((trs nil)) + (dolist (row cont) + (when (eq (car row) 'tr) + (let ((i 0) + (tds nil)) + (dolist (column (cdr row)) + (when (memq (car column) '(td th)) + (push (shr-render-td (cdr column) (aref widths i) fill) + tds) + (setq i (1+ i)))) + (push (nreverse tds) trs)))) + (nreverse trs))) + +(defun shr-render-td (cont width fill) + (with-temp-buffer + (let ((shr-width width) + (shr-indentation 0)) + (shr-generic cont)) + (while (re-search-backward "\n *$" nil t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + (let ((max 0)) + (while (not (eobp)) + (end-of-line) + (setq max (max max (current-column))) + (forward-line 1)) + (when fill + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (when (> (- width (current-column)) 0) + (insert (make-string (- width (current-column)) ? ))) + (forward-line 1))) + (list max (count-lines (point-min) (point-max)) (buffer-string))))) + +(defun shr-pro-rate-columns (columns) + (let ((total-percentage 0) + (widths (make-vector (length columns) 0))) + (dotimes (i (length columns)) + (incf total-percentage (aref columns i))) + (setq total-percentage (/ 1.0 total-percentage)) + (dotimes (i (length columns)) + (aset widths i (max (truncate (* (aref columns i) + total-percentage + shr-width)) + 10))) + widths)) + +;; Return a summary of the number and shape of the TDs in the table. +(defun shr-column-specs (cont) + (let ((columns (make-vector (shr-max-columns cont) 1))) + (dolist (row cont) + (when (eq (car row) 'tr) + (let ((i 0)) + (dolist (column (cdr row)) + (when (memq (car column) '(td th)) + (let ((width (cdr (assq :width (cdr column))))) + (when (and width + (string-match "\\([0-9]+\\)%" width)) + (aset columns i + (/ (string-to-number (match-string 1 width)) + 100.0))))) + (setq i (1+ i)))))) + columns)) + +(defun shr-count (cont elem) + (let ((i 0)) + (dolist (sub cont) + (when (eq (car sub) elem) + (setq i (1+ i)))) + i)) + +(defun shr-max-columns (cont) + (let ((max 0)) + (dolist (row cont) + (when (eq (car row) 'tr) + (setq max (max max (shr-count (cdr row) 'td))))) + max)) + (provide 'shr) ;;; shr.el ends here
--- a/lisp/gnus/spam-report.el Mon Oct 04 21:44:08 2010 +0200 +++ b/lisp/gnus/spam-report.el Mon Oct 04 22:26:51 2010 +0000 @@ -256,6 +256,7 @@ 80)) (error "Could not open connection to %s" host)) (set-marker (process-mark tcp-connection) (point-min)) + (gnus-set-process-query-on-exit-flag tcp-connection nil) (process-send-string tcp-connection (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"