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.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
4a93e698f3
commit
71e691a59f
18 changed files with 333 additions and 300 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -356,6 +356,8 @@ moving articles to a group that has not turned auto-expire on.
|
|||
|
||||
@item NoCeM support has been removed.
|
||||
|
||||
@item Carpal mode has been removed.
|
||||
|
||||
@end itemize
|
||||
|
||||
@end itemize
|
||||
|
|
|
|||
|
|
@ -797,7 +797,6 @@ Various
|
|||
* 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 @@ If non-@code{nil}, use the same article buffer for all the groups.
|
|||
(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 @@ four days, Gnus will decay the scores four times, for instance.
|
|||
* 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 @@ glitches. Use at your own peril.
|
|||
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 @@ Here's a more complicated example:
|
|||
@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 @@ occupy, not a percentage.
|
|||
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 @@ Hook called after creating the score mode menu.
|
|||
@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 @@ Buttons}).
|
|||
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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -1186,9 +1186,7 @@ The following commands are available:
|
|||
(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)
|
||||
|
|
|
|||
|
|
@ -869,177 +869,6 @@ Two predefined functions are available:
|
|||
(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)
|
||||
|
||||
|
|
|
|||
|
|
@ -301,9 +301,7 @@ The following commands are available:
|
|||
"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 @@ claim them."
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -474,6 +474,12 @@ If nil, each group will get its own article buffer."
|
|||
: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 @@ display only a single character."
|
|||
;; 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 @@ displayed, no centering will be performed."
|
|||
(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)
|
||||
|
|
|
|||
|
|
@ -1602,7 +1602,11 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -68,12 +68,10 @@ used to display Gnus windows."
|
|||
(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 @@ used to display Gnus windows."
|
|||
(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 @@ used to display Gnus windows."
|
|||
(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 @@ See the Gnus manual for an explanation of the syntax used.")
|
|||
(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)
|
||||
|
|
|
|||
|
|
@ -1626,11 +1626,6 @@ slower."
|
|||
(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-registry.el will populate this if it's loaded.")
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -125,7 +125,8 @@ You can provide a list of argument to pass to CB in CBARGS."
|
|||
(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)
|
||||
|
||||
|
|
|
|||
|
|
@ -5736,7 +5736,9 @@ subscribed address (and not the additional To and Cc header contents)."
|
|||
(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.
|
||||
|
|
|
|||
|
|
@ -162,7 +162,7 @@ Whether the passphrase is cached at all is controlled by
|
|||
(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 @@ Whether the passphrase is cached at all is controlled by
|
|||
(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))))
|
||||
|
|
|
|||
|
|
@ -316,7 +316,7 @@ textual parts.")
|
|||
(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 @@ textual parts.")
|
|||
(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 @@ textual parts.")
|
|||
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 @@ textual parts.")
|
|||
(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 @@ textual parts.")
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -985,7 +985,7 @@ details on the language and supported extensions"
|
|||
(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)
|
||||
|
|
|
|||
238
lisp/gnus/shr.el
238
lisp/gnus/shr.el
|
|
@ -30,6 +30,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'browse-url)
|
||||
|
||||
(defgroup shr nil
|
||||
"Simple HTML Renderer"
|
||||
:group 'mail)
|
||||
|
|
@ -57,6 +59,16 @@ fit these criteria."
|
|||
|
||||
(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 @@ fit these criteria."
|
|||
(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 @@ fit these criteria."
|
|||
|
||||
(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 (widget &rest stuff)
|
||||
(browse-url (widget-get widget :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-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 @@ fit these criteria."
|
|||
(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 @@ fit these criteria."
|
|||
(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 @@ fit these criteria."
|
|||
(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 @@ fit these criteria."
|
|||
(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 @@ Return a string with image data."
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -256,6 +256,7 @@ This is initialized based on `user-mail-address'."
|
|||
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"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue