;;; gnus-art.el --- article mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
"*All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `gnus-ignored-headers' will be ignored."
- :type '(repeat :value-to-internal (lambda (widget value)
- (custom-split-regexp-maybe value))
- :match (lambda (widget value)
- (or (stringp value)
- (widget-editable-list-match widget value)))
- regexp)
+ :type '(choice
+ (repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp)
+ (const :tag "Use gnus-ignored-headers" nil)
+ regexp)
:group 'gnus-article-hiding)
(defcustom gnus-sorted-header-list
:group 'gnus-article-saving
:type 'regexp)
+;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
"A function to save articles in your favourite format.
The function will be called by way of the `gnus-summary-save-article'
* gnus-summary-save-in-vm (use VM's folder format)
* gnus-summary-write-to-file (article format -- overwrite)
* gnus-summary-write-body-to-file (article body -- overwrite)
+* gnus-summary-save-in-pipe (article format)
The symbol of each function may have the following properties:
* :decode
The value non-nil means save decoded articles. This is meaningful
only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
-`gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'.
+`gnus-summary-write-to-file', `gnus-summary-write-body-to-file', and
+`gnus-summary-save-in-pipe'.
* :function
The value specifies an alternative function which appends, not
(function-item gnus-summary-save-in-vm)
(function-item gnus-summary-write-to-file)
(function-item gnus-summary-write-body-to-file)
+ (function-item gnus-summary-save-in-pipe)
(function)))
(defcustom gnus-article-save-coding-system
:type '(repeat regexp)
:group 'gnus-article-various)
-(make-obsolete-variable 'gnus-article-hide-pgp-hook
- "This variable is obsolete in Gnus 5.10.")
+(make-obsolete-variable 'gnus-article-hide-pgp-hook nil
+ "Gnus 5.10 (Emacs-22.1)")
(defface gnus-button
'((t (:weight bold)))
:group 'gnus-article-signature)
;; backward-compatibility alias
(put 'gnus-signature-face 'face-alias 'gnus-signature)
+(put 'gnus-signature-face 'obsolete-face "22.1")
(defface gnus-header-from
'((((class color)
:group 'gnus-article-highlight)
;; backward-compatibility alias
(put 'gnus-header-from-face 'face-alias 'gnus-header-from)
+(put 'gnus-header-from-face 'obsolete-face "22.1")
(defface gnus-header-subject
'((((class color)
:group 'gnus-article-highlight)
;; backward-compatibility alias
(put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
+(put 'gnus-header-subject-face 'obsolete-face "22.1")
(defface gnus-header-newsgroups
'((((class color)
:group 'gnus-article-highlight)
;; backward-compatibility alias
(put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
+(put 'gnus-header-newsgroups-face 'obsolete-face "22.1")
(defface gnus-header-name
'((((class color)
:group 'gnus-article-highlight)
;; backward-compatibility alias
(put 'gnus-header-name-face 'face-alias 'gnus-header-name)
+(put 'gnus-header-name-face 'obsolete-face "22.1")
(defface gnus-header-content
'((((class color)
:group 'gnus-article-highlight)
;; backward-compatibility alias
(put 'gnus-header-content-face 'face-alias 'gnus-header-content)
+(put 'gnus-header-content-face 'obsolete-face "22.1")
(defcustom gnus-header-face-alist
'(("From" nil gnus-header-from)
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
-(make-obsolete-variable 'gnus-treat-strip-pgp
- "This option is obsolete in Gnus 5.10.")
+(make-obsolete-variable 'gnus-treat-strip-pgp nil
+ "Gnus 5.10 (Emacs 22.1)")
(defcustom gnus-treat-strip-pem nil
"Strip PEM signatures.
:type gnus-article-treat-custom)
(make-obsolete-variable 'gnus-treat-display-xface
- 'gnus-treat-display-x-face)
+ 'gnus-treat-display-x-face "22.1")
(defcustom gnus-treat-display-x-face
(and (not noninteractive)
(gnus-image-type-available-p 'xbm)
(if (featurep 'xemacs)
(featurep 'xface)
- (and (string-match "^0x" (shell-command-to-string "uncompface"))
- (executable-find "icontopbm")))
+ (condition-case nil
+ (and (string-match "^0x" (shell-command-to-string "uncompface"))
+ (executable-find "icontopbm"))
+ ;; shell-command-to-string may signal an error, e.g. if
+ ;; shell-file-name is not found.
+ (error nil)))
'head)
"Display X-Face headers.
Valid values are nil and `head'.
"Display Face headers.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles' and Info
-node `(gnus)X-Face' for details."
+node `(gnus)Face' for details."
:group 'gnus-article-treat
:version "22.1"
:link '(custom-manual "(gnus)Customizing Articles")
(defvar gnus-save-article-buffer nil)
-(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s)
- (?m (gnus-article-mime-part-status) ?s))
- gnus-summary-mode-line-format-alist))
-
(defvar gnus-number-of-articles-to-be-saved nil)
(defvar gnus-inhibit-hiding nil)
"Toggle whether to fold or truncate long lines in article the buffer.
If ARG is non-nil and not a number, toggle
`gnus-article-truncate-lines' too. If ARG is a number, truncate
-long lines iff arg is positive."
+long lines if and only if arg is positive."
(interactive "P")
(cond
((and (numberp arg) (> arg 0))
(let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
w3m-force-redisplay)
(w3m-region (point-min) (point-max)))
+ ;; Put the mark meaning this part was rendered by emacs-w3m.
+ (put-text-property (point-min) (point-max) 'mm-inline-text-html-with-w3m t)
(when (and mm-inline-text-html-with-w3m-keymap
(boundp 'w3m-minor-mode-map)
w3m-minor-mode-map)
- (add-text-properties
- (point-min) (point-max)
- (list 'keymap w3m-minor-mode-map
- ;; Put the mark meaning this part was rendered by emacs-w3m.
- 'mm-inline-text-html-with-w3m t))))
+ (if (and (boundp 'w3m-link-map)
+ w3m-link-map)
+ (let* ((start (point-min))
+ (end (point-max))
+ (on (get-text-property start 'w3m-href-anchor))
+ (map (copy-keymap w3m-link-map))
+ next)
+ (set-keymap-parent map w3m-minor-mode-map)
+ (while (< start end)
+ (if on
+ (progn
+ (setq next (or (text-property-any start end
+ 'w3m-href-anchor nil)
+ end))
+ (put-text-property start next 'keymap map))
+ (setq next (or (text-property-not-all start end
+ 'w3m-href-anchor nil)
+ end))
+ (put-text-property start next 'keymap w3m-minor-mode-map))
+ (setq start next
+ on (not on))))
+ (put-text-property (point-min) (point-max) 'keymap w3m-minor-mode-map))))
(defvar charset) ;; Bound by `article-wash-html'.
(setq showed t)))))
showed))
-;; FIXME: Documentation in texi/gnus.texi missing.
(defun gnus-article-browse-html-article (&optional arg)
"View \"text/html\" parts of the current article with a WWW browser.
The message header is added to the beginning of every html part unless
Warning: Spammers use links to images in HTML articles to verify
whether you have read the message. As
-`gnus-article-browse-html-article' passes the unmodified HTML
-content to the browser without eliminating these \"web bugs\" you
-should only use it for mails from trusted senders.
+`gnus-article-browse-html-article' passes the HTML content to the
+browser without eliminating these \"web bugs\" you should only
+use it for mails from trusted senders.
-If you always want to display HTML part in the browser, set
+If you always want to display HTML parts in the browser, set
`mm-text-html-renderer' to nil."
;; Cf. `mm-w3m-safe-url-regexp'
(interactive "P")
(if arg
(gnus-summary-show-article)
(let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value)
- gnus-visible-headers)))
+ gnus-visible-headers))
+ ;; As we insert a <hr>, there's no need for the body boundary.
+ (gnus-treat-body-boundary nil))
(gnus-summary-show-article)))
(with-current-buffer gnus-article-buffer
(let ((header (unless arg
(point) 'original-date))
(setq date (get-text-property pos 'original-date))
t))
- (narrow-to-region pos (or (text-property-any pos (point-max)
- 'original-date nil)
- (point-max)))
+ (narrow-to-region
+ pos (if (setq pos (text-property-any pos (point-max)
+ 'original-date nil))
+ (progn
+ (goto-char pos)
+ (if (or (bolp) (eobp))
+ (point)
+ (1+ (point))))
+ (point-max)))
(goto-char (point-min))
(when (re-search-forward tdate-regexp nil t)
(setq bface (get-text-property (point-at-bol) 'face)
(let ((gnus-visible-headers
(or (symbol-value (get gnus-default-article-saver :headers))
gnus-saved-headers gnus-visible-headers))
- (gnus-article-buffer save-buffer))
+ ;; Ignore group parameter. See `article-hide-headers'.
+ (gnus-summary-buffer nil))
(with-current-buffer save-buffer
(article-hide-headers 1 t))))
(save-window-excursion
(save-excursion
(save-restriction
(widen)
+ ;; Note that unlike gnus-summary-save-in-mail, there is no
+ ;; check to see if filename is Babyl. Rmail in Emacs 23 does
+ ;; not use Babyl.
(gnus-output-to-rmail filename))))
filename)
(if (and (file-readable-p filename)
(file-regular-p filename)
(mail-file-babyl-p filename))
- (rmail-output-to-rmail-file filename t)
+ (gnus-output-to-rmail filename)
(gnus-output-to-mail filename)))))
filename)
gnus-current-headers nil 'gnus-newsgroup-last-directory))
(gnus-summary-save-body-in-file filename t))
-(defun gnus-summary-save-in-pipe (&optional command)
- "Pipe this article to subprocess."
- (setq command
- (cond ((and (eq command 'default)
- gnus-last-shell-command)
- gnus-last-shell-command)
- ((stringp command)
- command)
- (t (read-string
- (format
- "Shell command on %s: "
- (if (and gnus-number-of-articles-to-be-saved
- (> gnus-number-of-articles-to-be-saved 1))
- (format "these %d articles"
- gnus-number-of-articles-to-be-saved)
- "this article"))
- gnus-last-shell-command))))
- (when (string-equal command "")
- (if gnus-last-shell-command
- (setq command gnus-last-shell-command)
- (error "A command is required")))
- (gnus-eval-in-buffer-window gnus-article-buffer
- (save-restriction
- (widen)
- (shell-command-on-region (point-min) (point-max) command nil)))
- (setq gnus-last-shell-command command))
+(put 'gnus-summary-save-in-pipe :decode t)
+(put 'gnus-summary-save-in-pipe :headers 'gnus-saved-headers)
+(defun gnus-summary-save-in-pipe (&optional command raw)
+ "Pipe this article to subprocess COMMAND.
+Valid values for COMMAND include:
+ a string
+ The executable command name and possibly arguments.
+ nil
+ You will be prompted for the command in the minibuffer.
+ the symbol `default'
+ It will be replaced with the command which the variable
+ `gnus-summary-pipe-output-default-command' holds or the command
+ last used for saving.
+Non-nil value for RAW overrides `:decode' and `:headers' properties
+and the raw article including all headers will be piped."
+ (let ((article (gnus-summary-article-number))
+ (decode (unless raw
+ (get 'gnus-summary-save-in-pipe :decode)))
+ save-buffer default)
+ (if article
+ (if (vectorp (gnus-summary-article-header article))
+ (save-current-buffer
+ (gnus-summary-select-article decode decode nil article)
+ (insert-buffer-substring
+ (prog1
+ (if decode
+ gnus-article-buffer
+ gnus-original-article-buffer)
+ (setq save-buffer
+ (nnheader-set-temp-buffer " *Gnus Save*"))))
+ ;; Remove unwanted headers.
+ (when (and (not raw)
+ (or (get 'gnus-summary-save-in-pipe :headers)
+ (not gnus-save-all-headers)))
+ (let ((gnus-visible-headers
+ (or (symbol-value (get 'gnus-summary-save-in-pipe
+ :headers))
+ gnus-saved-headers gnus-visible-headers))
+ (gnus-summary-buffer nil))
+ (article-hide-headers 1 t))))
+ (error "%d is not a real article" article))
+ (error "No article to pipe"))
+ (setq default (or gnus-summary-pipe-output-default-command
+ gnus-last-shell-command))
+ (unless (stringp command)
+ (setq command
+ (if (and (eq command 'default) default)
+ default
+ (gnus-read-shell-command "Shell command on this article: "
+ default))))
+ (when (string-equal command "")
+ (if default
+ (setq command default)
+ (error "A command is required")))
+ (gnus-eval-in-buffer-window save-buffer
+ (save-restriction
+ (widen)
+ (shell-command-on-region (point-min) (point-max) command nil)))
+ (gnus-kill-buffer save-buffer))
+ (setq gnus-summary-pipe-output-default-command command))
(defun gnus-summary-pipe-to-muttprint (&optional command)
"Pipe this article to muttprint."
- (setq command (read-string
- "Print using command: " gnus-summary-muttprint-program
- nil gnus-summary-muttprint-program))
- (gnus-summary-save-in-pipe command))
+ (unless (stringp command)
+ (setq command (read-string
+ "Print using command: " gnus-summary-muttprint-program
+ nil gnus-summary-muttprint-program)))
+ (let ((gnus-summary-pipe-output-default-command
+ gnus-summary-pipe-output-default-command))
+ (gnus-summary-save-in-pipe command))
+ (setq gnus-summary-muttprint-program command))
;;; Article file names when saving.
"s" gnus-article-show-summary
"\C-c\C-m" gnus-article-mail
"?" gnus-article-describe-briefly
- "e" gnus-summary-edit-article
"<" beginning-of-buffer
">" end-of-buffer
"\C-c\C-i" gnus-info-find-node
"\C-hc" gnus-article-describe-key-briefly
"\C-hb" gnus-article-describe-bindings
+ "e" gnus-article-read-summary-keys
"\C-d" gnus-article-read-summary-keys
"\M-*" gnus-article-read-summary-keys
"\M-#" gnus-article-read-summary-keys
(vector (caddr c) (car c) :active t))
gnus-mime-button-commands)))
+(defmacro gnus-bind-safe-url-regexp (&rest body)
+ "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
+ `(let ((mm-w3m-safe-url-regexp
+ (let ((group (if (and (eq major-mode 'gnus-article-mode)
+ (gnus-buffer-live-p
+ gnus-article-current-summary))
+ (with-current-buffer gnus-article-current-summary
+ gnus-newsgroup-name)
+ gnus-newsgroup-name)))
+ (if (cond ((stringp gnus-safe-html-newsgroups)
+ (string-match gnus-safe-html-newsgroups group))
+ ((consp gnus-safe-html-newsgroups)
+ (member group gnus-safe-html-newsgroups)))
+ nil
+ mm-w3m-safe-url-regexp))))
+ ,@body))
+
(defun gnus-mime-button-menu (event prefix)
"Construct a context-sensitive menu of MIME commands."
(interactive "e\nP")
(or (search-forward "\n\n") (goto-char (point-max)))
(let ((inhibit-read-only t))
(delete-region (point) (point-max))
- (mm-display-parts handles))))))
+ (gnus-bind-safe-url-regexp (mm-display-parts handles)))))))
(defun gnus-article-jump-to-part (n)
"Jump to MIME part N."
,gnus-summary-buffer no-highlight))
t)
(gnus-article-edit-done)
- (gnus-summary-expand-window)
- (gnus-summary-show-article)
+ (gnus-configure-windows 'article)
(when (and current-id (integerp gnus-auto-select-part))
- (gnus-article-jump-to-part
- (if (text-property-any (point-min) (point-max)
- 'gnus-part (+ current-id gnus-auto-select-part))
- (+ current-id gnus-auto-select-part)
- (with-current-buffer gnus-article-buffer
- (length gnus-article-mime-handle-alist)))))))
+ (gnus-article-jump-to-part (+ current-id gnus-auto-select-part)))))
(defun gnus-mime-replace-part (file)
"Replace MIME part under point with an external body."
;; Useful if file has already been saved to disk
(interactive
(list
- (mm-with-multibyte
- (read-file-name "Replace MIME part with file: "
- (or mm-default-directory default-directory)
- nil nil))))
+ (read-file-name "Replace MIME part with file: "
+ (or mm-default-directory default-directory)
+ nil nil)))
(gnus-mime-save-part-and-strip file))
(defun gnus-mime-save-part-and-strip (&optional file)
"`----\n"))
(setcdr data
(cdr (mm-make-handle
- nil `("text/plain") nil nil
+ nil `("text/plain" (charset . gnus-decoded)) nil nil
(list "attachment")
(format "Deleted attachment (%s bytes)" bsize))))))
;; (set-buffer gnus-summary-buffer)
(mm-string-to-multibyte contents)))
(goto-char b)))))
-(defun gnus-mime-strip-charset-parameters (handle)
- "Strip charset parameters from HANDLE."
+(defun gnus-mime-set-charset-parameters (handle charset)
+ "Set CHARSET to parameters in HANDLE.
+CHARSET may either be a string or a symbol."
+ (unless (stringp charset)
+ (setq charset (symbol-name charset)))
(if (stringp (car handle))
- (mapc #'gnus-mime-strip-charset-parameters (cdr handle))
+ (dolist (h (cdr handle))
+ (gnus-mime-set-charset-parameters h charset))
(let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle)
"message/external-body")
(progn
(mm-extern-cache-contents handle))
(mm-handle-cache handle))
handle)))
- (charset (assq 'charset (cdr type))))
- (when charset
- (delq charset type)))))
+ (param (assq 'charset (cdr type))))
+ (if param
+ (setcdr param charset)
+ (setcdr type (cons (cons 'charset charset) (cdr type)))))))
(defun gnus-mime-view-part-as-charset (&optional handle arg)
"Insert the MIME part under point into the current buffer using the
(let ((handle (or handle (get-text-property (point) 'gnus-data)))
(fun (get-text-property (point) 'gnus-callback))
(gnus-newsgroup-ignored-charsets 'gnus-all)
- gnus-newsgroup-charset form preferred parts)
+ charset form preferred parts)
(when handle
(when (prog1
(and fun
- (setq gnus-newsgroup-charset
+ (setq charset
(or (cdr (assq
arg
gnus-summary-show-article-charset-alist))
(mm-read-coding-system "Charset: "))))
(if (mm-handle-undisplayer handle)
(mm-remove-part handle)))
- (gnus-mime-strip-charset-parameters handle)
+ (gnus-mime-set-charset-parameters handle charset)
(when (and (consp (setq form (cdr-safe fun)))
(setq form (ignore-errors
(assq 'gnus-mime-display-alternative form)))
(when handle
(if (mm-handle-undisplayer handle)
(mm-remove-part handle)
- (mm-display-part handle))))))
+ (gnus-bind-safe-url-regexp (mm-display-part handle)))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
(save-restriction
(narrow-to-region (point)
(if (eobp) (point) (1+ (point))))
- (mm-display-part handle)
+ (gnus-bind-safe-url-regexp (mm-display-part handle))
;; We narrow to the part itself and
;; then call the treatment functions.
(goto-char (point-min))
(set-buffer gnus-summary-buffer)
(error))
gnus-newsgroup-ignored-charsets)))
- (mm-display-part handle t))
+ (gnus-bind-safe-url-regexp (mm-display-part handle t)))
(goto-char (point-max)))
((and text not-attachment)
(when move
(mail-parse-ignored-charsets
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-ignored-charsets)))
- (mm-display-part preferred)
+ (gnus-bind-safe-url-regexp (mm-display-part preferred))
;; Do highlighting.
(save-excursion
(save-restriction
If end of article, return non-nil. Otherwise return nil.
Argument LINES specifies lines to be scrolled up."
(interactive "p")
- (move-to-window-line -1)
+ (move-to-window-line (if (featurep 'xemacs) -1 (- -1 scroll-margin)))
(if (and (not (and gnus-article-over-scroll
(> (count-lines (window-start) (point-max))
- (+ (or lines (1- (window-height)))
- (or (and (boundp 'scroll-margin)
- (symbol-value 'scroll-margin))
- 0)))))
+ (if (featurep 'xemacs)
+ (or lines (1- (window-height)))
+ (+ (or lines (1- (window-height))) scroll-margin)))))
(save-excursion
(end-of-line)
(and (pos-visible-in-window-p) ;Not continuation line.
(min (max 0 scroll-margin)
(max 1 (- (window-height)
(if mode-line-format 1 0)
- (if header-line-format 1 0)))))))
+ (if header-line-format 1 0)
+ 2))))))
(defun gnus-article-next-page-1 (lines)
- (when (and (not (featurep 'xemacs))
- (numberp lines)
- (> lines 0)
- (numberp (symbol-value 'scroll-margin))
- (> (symbol-value 'scroll-margin) 0))
+ (unless (featurep 'xemacs)
;; Protect against the bug that Emacs 21.x hangs up when scrolling up for
;; too many number of lines if `scroll-margin' is set as two or greater.
- (setq lines (min lines
- (max 0 (- (count-lines (window-start) (point-max))
- (symbol-value 'scroll-margin))))))
+ (when (and (numberp lines)
+ (> lines 0)
+ (> scroll-margin 0))
+ (setq lines (min lines
+ (max 0 (- (count-lines (window-start) (point-max))
+ scroll-margin))))))
(condition-case ()
(let ((scroll-in-place nil))
(scroll-up lines))
(goto-char (point-max))
(recenter (if gnus-article-over-scroll
(if lines
- (max (+ lines (or (and (boundp 'scroll-margin)
- (symbol-value 'scroll-margin))
- 0))
+ (max (if (featurep 'xemacs)
+ lines
+ (+ lines scroll-margin))
3)
(- (window-height) 2))
-1)))
(interactive)
(gnus-message 6 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
-(defun gnus-article-summary-command ()
- "Execute the last keystroke in the summary buffer."
- (interactive)
- (let ((obuf (current-buffer))
- (owin (current-window-configuration))
- func)
- (switch-to-buffer gnus-article-current-summary 'norecord)
- (setq func (lookup-key (current-local-map) (this-command-keys)))
- (call-interactively func)
- (set-buffer obuf)
- (set-window-configuration owin)
- (set-window-point (get-buffer-window (current-buffer)) (point))))
-
-(defun gnus-article-summary-command-nosave ()
- "Execute the last keystroke in the summary buffer."
- (interactive)
- (let (func)
- (pop-to-buffer gnus-article-current-summary)
- (setq func (lookup-key (current-local-map) (this-command-keys)))
- (call-interactively func)))
-
(defun gnus-article-check-buffer ()
"Beep if not in an article buffer."
(unless (equal major-mode 'gnus-article-mode)
(pop-to-buffer gnus-article-current-summary)
;; We disable the pick minor mode commands.
(let (gnus-pick-mode)
- (setq func (lookup-key (current-local-map) keys))))
+ (setq func (key-binding keys t))))
(if (or (not func)
(numberp func))
(ding)
(gnus-configure-windows 'article)
(unless (setq win (get-buffer-window summary-buffer 'visible))
(let ((gnus-buffer-configuration
- '(article ((vertical 1.0
- (summary 0.25 point)
- (article 1.0))))))
+ '((article ((vertical 1.0
+ (summary 0.25 point)
+ (article 1.0)))))))
(gnus-configure-windows 'article))
(setq win (get-buffer-window summary-buffer 'visible)))
(gnus-select-frame-set-input-focus (window-frame win))
(setq in-buffer (current-buffer))
;; We disable the pick minor mode commands.
(if (and (setq func (let (gnus-pick-mode)
- (lookup-key (current-local-map) keys)))
+ (key-binding keys t)))
(functionp func)
(condition-case code
(progn
(point))))
(when (and (not not-restore-window)
new-sum-point
+ (window-live-p win)
(with-current-buffer (window-buffer win)
(eq major-mode 'gnus-summary-mode)))
(set-window-point win new-sum-point)
;;`gnus-agent-mode' in gnus-agent.el will define it.
(defvar gnus-agent-summary-mode)
(defvar gnus-draft-mode)
+;; Calling help-buffer will autoload help-mode.
+(defvar help-xref-stack-item)
(defun gnus-article-describe-bindings (&optional prefix)
"Show a list of all defined keys, and their definitions.
(let ((keymap (copy-keymap gnus-article-mode-map))
(map (copy-keymap gnus-article-send-map))
(sumkeys (where-is-internal 'gnus-article-read-summary-keys))
- agent draft)
+ parent agent draft)
(define-key keymap "S" map)
(define-key map [t] nil)
(with-current-buffer gnus-article-current-summary
+ (set-keymap-parent
+ keymap
+ (if (setq parent (keymap-parent gnus-article-mode-map))
+ (prog1
+ (setq parent (copy-keymap parent))
+ (set-keymap-parent parent (current-local-map)))
+ (current-local-map)))
(set-keymap-parent map (key-binding "S"))
(let (key def gnus-pick-mode)
(while sumkeys
(with-current-buffer gnus-original-article-buffer
(and (equal (car gnus-original-article) group)
(eq (cdr gnus-original-article) article))))
- (insert-buffer-substring gnus-original-article-buffer)
+ ;; `insert-buffer-substring' would incorrectly use the
+ ;; equivalent of string-make-multibyte which amount to decoding
+ ;; with locale-coding-system, causing failure of
+ ;; subsequent decoding.
+ (insert (mm-string-to-multibyte
+ (with-current-buffer gnus-original-article-buffer
+ (buffer-substring (point-min) (point-max)))))
'article)
;; Check the backlog.
((and gnus-keep-backlog
gnus-button-ctan-directory-regexp
"/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
- ;; This is info (home-grown style) <info://foo/bar+baz>
+ ;; Info Konqueror style <info:/foo/bar baz>.
+ ;; Must come before " Gnus home-grown style".
+ ("\\binfo://?\\([^'\">\n\t]+\\)"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
+ ;; Info, Gnus home-grown style (deprecated) <info://foo/bar+baz>
("\\binfo://\\([^'\">\n\t ]+\\)"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
;; Info GNOME style <info:foo#bar_baz>
1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2)
("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0
(>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
- ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
- ;; Info links like `C-h i d m CC Mode RET'
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\([ \t\n,]*\\)\\)?"
+ ;; Info links like `C-h i d m Gnus RET' or `C-h i d m Gnus RET i partial RET'
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 0)
;; This is custom
("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
(>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2)
(unless file
(error "Couldn't find library %s" library))
(find-file file)
- (goto-line (string-to-number line))))
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line)))))
(defun gnus-button-handle-man (url)
"Fetch a man page."
;; (info) will autoload info.el
(declare-function Info-menu "info" (menu-item &optional fork))
+(declare-function Info-index-next "info" (num))
(defun gnus-button-handle-info-keystrokes (url)
"Call `info' when pushing the corresponding URL button."
- ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
- (info)
- (Info-directory)
- (Info-menu url))
+ ;; For links like `C-h i d m gnus RET part RET , ,', `C-h i d m CC Mode RET'.
+ (let (node indx comma)
+ (if (string-match
+ (concat "\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+"
+ "\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
+ "\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET"
+ "\\(?:[ \t\n,]*\\)\\)?")
+ url)
+ (setq node (match-string 2 url)
+ indx (match-string 3 url))
+ (error "Can't parse %s" url))
+ (info)
+ (Info-directory)
+ (Info-menu node)
+ (when (> (length indx) 0)
+ (string-match (concat "[ \t\n]+i[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
+ "\\([ \t\n,]*\\)")
+ indx)
+ (setq comma (match-string 2 indx))
+ (setq indx (match-string 1 indx))
+ (Info-index indx)
+ (when comma
+ (dotimes (i (with-temp-buffer
+ (insert comma)
+ ;; Note: the XEmacs version of `how-many' takes
+ ;; no optional argument.
+ (goto-char (point-min))
+ (how-many ",")))
+ (Info-index-next 1)))
+ nil)))
;; Called after pgg-snarf-keys-region, which autoloads pgg.el.
(declare-function pgg-display-output-buffer "pgg" (start end status))
(when (and gnus-article-encrypt-protocol
gnus-novice-user)
(unless (gnus-y-or-n-p "Really encrypt article(s)? ")
- (error "Encrypt aborted.")))
+ (error "Encrypt aborted")))
(let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
(unless func
(error "Can't find the encrypt protocol %s" protocol))
projects / gnus / blobdiff