;; 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
* 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
(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))
(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 alwasy 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
(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
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 ((save-buffer gnus-save-article-buffer)
+ (default (or gnus-summary-pipe-output-default-command
+ gnus-last-shell-command)))
+ ;; `gnus-save-article-buffer' should be a buffer containing the article
+ ;; contents if this function is called by way of the command
+ ;; `gnus-summary-pipe-output'. OTOH, that the buffer does not exist
+ ;; means this function is called independently.
+ (unless (gnus-buffer-live-p save-buffer)
+ (let ((article (gnus-summary-article-number))
+ (decode (unless raw
+ (get 'gnus-summary-save-in-pipe :decode))))
+ (if article
+ (if (vectorp (gnus-summary-article-header article))
+ (save-window-excursion
+ (let ((gnus-display-mime-function
+ (when decode
+ gnus-display-mime-function))
+ (gnus-article-prepare-hook
+ (when decode
+ gnus-article-prepare-hook)))
+ (gnus-summary-select-article t t nil article)
+ (gnus-summary-goto-subject 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"))))
+ (unless (stringp command)
+ (setq command
+ (if (and (eq command 'default) default)
+ default
+ (gnus-read-shell-command
+ (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"))
+ 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.
;; 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)
(interactive "P")
(setq arg (if arg (prefix-numeric-value arg) 0))
(with-current-buffer gnus-article-buffer
- (goto-char (point-min))
(widen)
;; Remove any old next/prev buttons.
(when (gnus-visual-p 'page-marker)
(let ((inhibit-read-only t))
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next)))
- (if
- (cond ((< arg 0)
- (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
- ((> arg 0)
- (re-search-forward page-delimiter nil 'move arg)))
- (goto-char (match-end 0))
- (save-excursion
- (goto-char (point-min))
- (setq gnus-page-broken
- (and (re-search-forward page-delimiter nil t) t))))
- (when gnus-page-broken
- (narrow-to-region
- (point)
- (if (re-search-forward page-delimiter nil 'move)
- (match-beginning 0)
- (point)))
- (when (and (gnus-visual-p 'page-marker)
- (> (point-min) (save-restriction (widen) (point-min))))
- (save-excursion
- (goto-char (point-min))
- (gnus-insert-prev-page-button)))
- (when (and (gnus-visual-p 'page-marker)
- (< (point-max) (save-restriction (widen) (point-max))))
- (save-excursion
- (goto-char (point-max))
- (gnus-insert-next-page-button))))))
+ (let (st nd pt)
+ (when (save-excursion
+ (cond ((< arg 0)
+ (if (re-search-backward page-delimiter nil 'move (abs arg))
+ (prog1
+ (setq nd (match-beginning 0)
+ pt nd)
+ (when (re-search-backward page-delimiter nil t)
+ (setq st (match-end 0))))
+ (when (re-search-forward page-delimiter nil t)
+ (setq nd (match-beginning 0)
+ pt (point-min)))))
+ ((> arg 0)
+ (if (re-search-forward page-delimiter nil 'move arg)
+ (prog1
+ (setq st (match-end 0)
+ pt st)
+ (when (re-search-forward page-delimiter nil t)
+ (setq nd (match-beginning 0))))
+ (when (re-search-backward page-delimiter nil t)
+ (setq st (match-end 0)
+ pt (point-max)))))
+ (t
+ (when (re-search-backward page-delimiter nil t)
+ (goto-char (setq st (match-end 0))))
+ (when (re-search-forward page-delimiter nil t)
+ (setq nd (match-beginning 0)))
+ (or st nd))))
+ (setq gnus-page-broken t)
+ (when pt (goto-char pt))
+ (narrow-to-region (or st (point-min)) (or nd (point-max)))
+ (when (gnus-visual-p 'page-marker)
+ (save-excursion
+ (when nd
+ (goto-char nd)
+ (gnus-insert-next-page-button))
+ (when st
+ (goto-char st)
+ (gnus-insert-prev-page-button))))))))
;; Article mode commands
(defun gnus-article-goto-prev-page ()
"Show the previous page of the article."
(interactive)
- (if (bobp)
+ (if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer?
(gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
(gnus-article-prev-page nil)))
(define-key map [t] nil)
(with-current-buffer gnus-article-current-summary
(set-keymap-parent map (key-binding "S"))
- (let (def gnus-pick-mode)
- (dolist (key sumkeys)
- (when (setq def (key-binding key))
- (define-key keymap key def))))
+ (let (key def gnus-pick-mode)
+ (while sumkeys
+ (setq key (pop sumkeys))
+ (cond ((and (vectorp key) (= (length key) 1)
+ (consp (setq def (aref key 0)))
+ (numberp (car def)) (numberp (cdr def)))
+ (when (< (max (car def) (cdr def)) 128)
+ (setq sumkeys
+ (append (mapcar
+ #'vector
+ (nreverse (gnus-uncompress-range def)))
+ sumkeys))))
+ ((setq def (key-binding key))
+ (unless (eq def 'undefined)
+ (define-key keymap key def))))))
(when (boundp 'gnus-agent-summary-mode)
(setq agent gnus-agent-summary-mode))
(when (boundp 'gnus-draft-mode)
(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
(concat
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
+ ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
+ "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]*"
"\\|"
"[" chars punct "]+" "[" chars "]"
"\\)"))
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)
;; (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))
projects / gnus / blobdiff