;; 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
(defcustom gnus-copy-article-ignored-headers nil
"List of headers to be removed when copying an article.
Each element is a regular expression."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:type '(repeat regexp)
:group 'gnus-article-various)
Currently, `pbm' is used for X-Face images and `png' is used for Face
images in Emacs. Only the `:face' property is effective on the `xface'
image type in XEmacs if it is built with the libcompface library."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'gnus-article-headers
:type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
When 0, point will be placed on the same part as before. When
positive (negative), move point forward (backwards) this many
parts. When nil, redisplay article."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'gnus-article-mime
:type '(choice (const nil :tag "Redisplay article.")
(const 1 :tag "Next part.")
If it is t, all long headers are unfolded.
This variable has no effect if `gnus-treat-unfold-headers' is nil."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'gnus-article-treat
:type '(choice (const nil)
(const :tag "all" t)
(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)
;;; Macros for dealing with the article buffer.
(defmacro gnus-with-article-headers (&rest forms)
- `(save-excursion
- (set-buffer gnus-article-buffer)
+ `(with-current-buffer gnus-article-buffer
(save-restriction
(let ((inhibit-read-only t)
(inhibit-point-motion-hooks t)
(put 'gnus-with-article-headers 'edebug-form-spec '(body))
(defmacro gnus-with-article-buffer (&rest forms)
- `(save-excursion
- (set-buffer gnus-article-buffer)
+ `(with-current-buffer gnus-article-buffer
(let ((inhibit-read-only t))
,@forms)))
"Value of `truncate-lines' in Gnus Article buffer.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'gnus-article
;; :link '(custom-manual "(gnus)Customizing Articles")
:type 'boolean)
"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))
on each file, if it is `ask' ask once when exiting from the
summary buffer."
:group 'gnus-article
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:type '(choice (const :tag "Don't delete" nil)
(const :tag "Don't ask" t)
(const :tag "Ask" ask)
(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
(or (symbol-value (get gnus-default-article-saver :headers))
gnus-saved-headers gnus-visible-headers))
(gnus-article-buffer save-buffer))
- (save-excursion
- (set-buffer save-buffer)
+ (with-current-buffer save-buffer
(article-hide-headers 1 t))))
(save-window-excursion
(if (not gnus-default-article-saver)
`(lambda (&optional interactive &rest args)
,(documentation afunc t)
(interactive (list t))
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(if interactive
(call-interactively ',afunc)
(apply ',afunc args))))))))
(gnus-set-global-variables)))
(gnus-article-setup-highlight-words)
;; Init original article buffer.
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+ (with-current-buffer (gnus-get-buffer-create gnus-original-article-buffer)
(mm-enable-multibyte)
(setq major-mode 'gnus-original-article-mode)
(make-local-variable 'gnus-original-article))
nil)
(error "Action aborted"))
t)))
- (save-excursion
- (set-buffer name)
+ (with-current-buffer name
(set (make-local-variable 'gnus-article-edit-mode) nil)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(current-buffer))
- (save-excursion
- (set-buffer (gnus-get-buffer-create name))
+ (with-current-buffer (gnus-get-buffer-create name)
(gnus-article-mode)
(make-local-variable 'gnus-summary-buffer)
(setq gnus-summary-buffer
(when article-window
(set-window-start
article-window
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(goto-char (point-min))
(if (not line)
(point-min)
(if (or (eq result 'pseudo)
(eq result 'nneething))
(progn
- (save-excursion
- (set-buffer summary-buffer)
+ (with-current-buffer summary-buffer
(push article gnus-newsgroup-history)
(setq gnus-last-article gnus-current-article
gnus-current-article 0
(not (eq article gnus-current-article)))
;; Seems like a new article has been selected.
;; `gnus-current-article' must be an article number.
- (save-excursion
- (set-buffer summary-buffer)
+ (with-current-buffer summary-buffer
(push article gnus-newsgroup-history)
(setq gnus-last-article gnus-current-article
gnus-current-article article
;; 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)
If given a numerical ARG, move forward ARG pages."
(interactive "P")
(setq arg (if arg (prefix-numeric-value arg) 0))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (goto-char (point-min))
+ (with-current-buffer gnus-article-buffer
(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)))
(up-to-top
'("n" "Gn" "p" "Gp"))
keys new-sum-point)
- (save-excursion
- (set-buffer gnus-article-current-summary)
+ (with-current-buffer gnus-article-current-summary
(let (gnus-pick-mode)
(setq unread-command-events (nconc unread-command-events
(list (or key last-command-event)))
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
- (save-excursion
- (set-buffer gnus-article-current-summary)
+ (with-current-buffer gnus-article-current-summary
(setq unread-command-events
(if (featurep 'xemacs)
(append key nil)
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
- (save-excursion
- (set-buffer gnus-article-current-summary)
+ (with-current-buffer gnus-article-current-summary
(setq unread-command-events
(if (featurep 'xemacs)
(append key 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)
(set (make-local-variable 'gnus-draft-mode) draft)
(describe-bindings prefix))
(let ((item `((lambda (prefix)
- (save-excursion
- (set-buffer ,(current-buffer))
+ (with-current-buffer ,(current-buffer)
(gnus-article-describe-bindings prefix)))
,prefix)))
(with-current-buffer (if (fboundp 'help-buffer)
gnus-summary-buffer
(get-buffer gnus-summary-buffer)
(gnus-buffer-exists-p gnus-summary-buffer))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(let ((header (gnus-summary-article-header article)))
(when (< article 0)
(cond
(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-backlog-remove-article
(car gnus-article-current) (cdr gnus-article-current)))
;; Flush original article as well.
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
+ (when (get-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(setq gnus-original-article nil)))
(when gnus-use-cache
(gnus-cache-update-article
(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)
(gnus-parse-news-url url)
(cond
(message-id
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(if server
(let ((gnus-refer-article-method
(nconc (list (list 'nntp server))
;; (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))
(defun gnus-button-openpgp (url)
"Retrieve and add an OpenPGP key given URL from an OpenPGP header."
(error "Can't encrypt the article in group %s"
gnus-newsgroup-name))
(gnus-summary-iterate n
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(summary-buffer gnus-summary-buffer)
(when gnus-keep-backlog
(gnus-backlog-remove-article
(car gnus-article-current) (cdr gnus-article-current)))
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
+ (when (get-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(setq gnus-original-article nil)))
(when gnus-use-cache
(gnus-cache-update-article
(run-hooks 'gnus-art-load-hook)
-;;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
+;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
;;; gnus-art.el ends here
projects / gnus / blobdiff