;;; gnus-sum.el --- summary mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 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:
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (require 'easy-mmode))) ; for `define-minor-mode'
(defvar tool-bar-mode)
(defvar gnus-tmp-header)
See `gnus-group-goto-unread'."
:link '(custom-manual "(gnus)Group Maneuvering")
:group 'gnus-summary-exit
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
+ :type 'boolean)
+
+(defcustom gnus-summary-stop-at-end-of-message nil
+ "If non-nil, don't select the next message when using `SPC'."
+ :link '(custom-manual "(gnus)Group Maneuvering")
+ :group 'gnus-summary-maneuvering
+ :version "24.1"
:type 'boolean)
(defcustom gnus-fetch-old-headers nil
The server has to support NOV for any of this to work.
This feature can seriously impact performance it ignores all
-locally cached header entries."
+locally cached header entries. Setting it to t for groups for a
+server that doesn't expire articles (such as news.gmane.org),
+leads to very slow summary generation."
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
:group 'gnus-summary-format
:type 'string)
-(defcustom gnus-summary-goto-unread t
+(defcustom gnus-summary-goto-unread nil
"*If t, many commands will go to the next unread article.
This applies to marking commands as well as other commands that
\"naturally\" select the next article, like, for instance, `SPC' at
\(they go to the next article instead). If `never', commands that
usually go to the next unread article, will go to the next article,
whether it is read or not."
+ :version "24.1"
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
:type '(choice (const :tag "none" nil)
(sexp :menu-tag "first" t)))
-(defcustom gnus-auto-select-subject 'unread
+(defcustom gnus-auto-select-subject 'unseen-or-unread
"*Says what subject to place under point when entering a group.
This variable can either be the symbols `first' (place point on the
line of the first unseen article or, if all article have been seen, on the
subject line of the first unread article), or a function to be called to
place point on some subject line."
- :version "22.1"
+ :version "24.1"
:group 'gnus-group-select
:type '(choice (const best)
(const unread)
If it has any other value or there is no next (unread) article, the
article selected before entering to the ephemeral group will appear."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'gnus-summary-maneuvering
:type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
(const next) (const next-unread)
:group 'gnus-summary
:type 'boolean)
-(defcustom gnus-single-article-buffer t
+(defcustom gnus-single-article-buffer nil
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
+ :version "24.1"
:group 'gnus-article-various
:type 'boolean)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-souped-mark ?F
- "*Mark used for souped articles."
- :group 'gnus-summary-marks
- :type 'character)
-
(defcustom gnus-kill-file-mark ?X
"*Mark used for articles killed by kill files."
:group 'gnus-summary-marks
(defcustom gnus-auto-expirable-marks
(list gnus-killed-mark gnus-del-mark gnus-catchup-mark
gnus-low-score-mark gnus-ancient-mark gnus-read-mark
- gnus-souped-mark gnus-duplicate-mark)
+ gnus-duplicate-mark)
"*The list of marks converted into expiration if a group is auto-expirable."
- :version "21.1"
+ :version "24.1"
:group 'gnus-summary
:type '(repeat character))
:group 'gnus-summary
:type 'boolean)
+(defcustom gnus-mark-copied-or-moved-articles-as-expirable nil
+ "If non-nil, mark articles copied or moved to auto-expire group as expirable.
+If nil, the expirable marks will be unchanged except that the marks
+will be removed when copying or moving articles to a group that has
+not turned auto-expire on. If non-nil, articles that have been read
+will be marked as expirable when being copied or moved to a group in
+which auto-expire is turned on."
+ :version "23.2"
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
(defcustom gnus-view-pseudos nil
"*If `automatic', pseudo-articles will be viewed automatically.
If `not-confirm', pseudos will be viewed automatically, and the user
:group 'gnus-various
:type 'hook)
-(defcustom gnus-summary-update-hook
- (list 'gnus-summary-highlight-line)
+(defcustom gnus-summary-update-hook nil
"*A hook called when a summary line is changed.
The hook will not be called if `gnus-visual' is nil.
:type 'boolean
:group 'gnus-summary-marks)
+(defcustom gnus-propagate-marks t
+ "If non-nil, do not propagate marks to the backends."
+ :version "23.1" ;; No Gnus
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
(defcustom gnus-alter-articles-to-read-function nil
"Function to be called to alter the list of articles to be selected."
:type '(choice (const nil) function)
"Whether Gnus should parse all headers made available to it.
This is mostly relevant for slow back ends where the user may
wish to widen the summary buffer to include all headers
-that were fetched. Say, for nnultimate groups."
+that were fetched."
:version "22.1"
:group 'gnus-summary
:type '(choice boolean regexp))
+(defcustom gnus-summary-pipe-output-default-command nil
+ "Command (and optional arguments) used to pipe article to subprocess.
+This will be used as the default command if it is non-nil. The value
+will be updated if you modify it when executing the command
+`gnus-summary-pipe-output' or the function `gnus-summary-save-in-pipe'."
+ :version "23.1" ;; No Gnus
+ :group 'gnus-summary
+ :type '(radio (const :tag "None" nil) (string :tag "Command")))
+
(defcustom gnus-summary-muttprint-program "muttprint"
- "Command (and optional arguments) used to run Muttprint."
+ "Command (and optional arguments) used to run Muttprint.
+The value will be updated if you modify it when executing the command
+`gnus-summary-muttprint'."
:version "22.1"
:group 'gnus-summary
:type 'string)
(?E gnus-newsgroup-expunged-tally ?d)
(?s (gnus-current-score-file-nondirectory) ?s)))
+;; This is here rather than in gnus-art for compilation reasons.
+(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-last-search-regexp nil
"Default regexp for article search command.")
\"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
")
-;; Byte-compiler warning.
(eval-when-compile
;; Bind features so that require will believe that gnus-sum has
;; already been loaded (avoids infinite recursion)
(let ((features (cons 'gnus-sum features)))
- ;; Several of the declarations in gnus-sum are needed to load the
- ;; following files. Right now, these definitions have been
- ;; compiled but not defined (evaluated). We could either do a
- ;; eval-and-compile about all of the declarations or evaluate the
- ;; source file.
- (if (boundp 'gnus-newsgroup-variables)
- nil
- (load "gnus-sum.el" t t t))
- (require 'gnus)
(require 'gnus-art)))
;; MIME stuff.
"?" gnus-summary-mark-as-dormant
"\C-c\M-\C-s" gnus-summary-limit-include-expunged
"\C-c\C-s\C-n" gnus-summary-sort-by-number
+ "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number
"\C-c\C-s\C-l" gnus-summary-sort-by-lines
"\C-c\C-s\C-c" gnus-summary-sort-by-chars
"\C-c\C-s\C-a" gnus-summary-sort-by-author
"\C-c\C-s\C-t" gnus-summary-sort-by-recipient
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
"\C-c\C-s\C-d" gnus-summary-sort-by-date
+ "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date
"\C-c\C-s\C-i" gnus-summary-sort-by-score
"\C-c\C-s\C-o" gnus-summary-sort-by-original
"\C-c\C-s\C-r" gnus-summary-sort-by-random
"=" gnus-summary-expand-window
"\C-x\C-s" gnus-summary-reselect-current-group
"\M-g" gnus-summary-rescan-group
- "w" gnus-summary-stop-page-breaking
"\C-c\C-r" gnus-summary-caesar-message
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
[follow-link] mouse-face
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
- "i" gnus-summary-news-other-window
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
"t" gnus-summary-toggle-header
"d" gnus-article-display-face
"s" gnus-treat-smiley
"D" gnus-article-remove-images
+ "W" gnus-html-show-images
"f" gnus-treat-from-picon
"m" gnus-treat-mail-picon
"n" gnus-treat-newsgroups-picon)
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "P" gnus-summary-muttprint
- "s" gnus-soup-add-article)
+ "P" gnus-summary-muttprint)
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
"b" gnus-summary-display-buttonized
["Set mark below..." gnus-score-set-mark-below t]
["Set expunge below..." gnus-score-set-expunge-below t]
["Edit current score file" gnus-score-edit-current-scores t]
- ["Edit score file" gnus-score-edit-file t]
+ ["Edit score file..." gnus-score-edit-file t]
["Trace score" gnus-score-find-trace t]
["Find words" gnus-score-find-favourite-words t]
["Rescore buffer" gnus-summary-rescore t]
["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
["Save body in file..." gnus-summary-save-article-body-file t]
["Pipe through a filter..." gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t]
["Print with Muttprint..." gnus-summary-muttprint t]
["Print" gnus-summary-print-article
,@(if (featurep 'xemacs) '(t)
["Followup via news" gnus-summary-followup-to-mail t]
["Followup via news and yank"
gnus-summary-followup-to-mail-with-original t]
+ ["Strip signature on reply"
+ (lambda ()
+ (interactive)
+ (if (not (memq message-cite-function
+ '(message-cite-original-without-signature
+ message-cite-original)))
+ ;; Stupid workaround for XEmacs not honoring :visible.
+ (message "Can't toggle this value of `message-cite-function'")
+ (setq message-cite-function
+ (if (eq message-cite-function
+ 'message-cite-original-without-signature)
+ 'message-cite-original
+ 'message-cite-original-without-signature))))
+ ;; XEmacs barfs on :visible.
+ ,@(if (featurep 'xemacs) nil
+ '(:visible (memq message-cite-function
+ '(message-cite-original-without-signature
+ message-cite-original))))
+ :style toggle
+ :selected (eq message-cite-function
+ 'message-cite-original-without-signature)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Strip signature from cited article when replying."))]
;;("Draft"
;;["Send" gnus-summary-send-draft t]
;;["Send bounced" gnus-resend-bounced-mail t])
gnus-newsgroup-process-stack]
["Save" gnus-summary-save-process-mark t]
["Run command on marked..." gnus-summary-universal-argument t]))
+ ("Registry Marks")
("Scroll article"
["Page forward" gnus-summary-next-page
,@(if (featurep 'xemacs) '(t)
["Pop article off history" gnus-summary-pop-article t])
("Sort"
["Sort by number" gnus-summary-sort-by-number t]
+ ["Sort by most recent number" gnus-summary-sort-by-most-recent-number t]
["Sort by author" gnus-summary-sort-by-author t]
["Sort by recipient" gnus-summary-sort-by-recipient t]
["Sort by subject" gnus-summary-sort-by-subject t]
["Sort by date" gnus-summary-sort-by-date t]
+ ["Sort by most recent date" gnus-summary-sort-by-most-recent-date t]
["Sort by score" gnus-summary-sort-by-score t]
["Sort by lines" gnus-summary-sort-by-lines t]
["Sort by characters" gnus-summary-sort-by-chars t]
(const :tag "Retro look" gnus-summary-tool-bar-retro)
(repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
See `gmm-tool-bar-from-list' for the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
See `gmm-tool-bar-from-list' for the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
See `gmm-tool-bar-from-list' for the format of the list."
:type 'gmm-tool-bar-zap-list
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
(defvar image-load-path)
+(defvar tool-bar-map)
(defun gnus-summary-make-tool-bar (&optional force)
"Make a summary mode tool bar from `gnus-summary-tool-bar'.
(setq headers (cdr headers)))
(list (nreverse outh))))))))
+
+(declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
+(defvar bookmark-make-record-function)
\f
(defun gnus-summary-mode (&optional group)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(setq mode-name "Summary")
- (make-local-variable 'minor-mode-alist)
(use-local-map gnus-summary-mode-map)
(buffer-disable-undo)
(setq buffer-read-only t ;Disable modification
show-trailing-whitespace nil)
(setq truncate-lines t)
- (setq selective-display t)
- (setq selective-display-ellipses t) ;Display `...'
+ (add-to-invisibility-spec '(gnus-sum . t))
(gnus-summary-set-display-table)
(gnus-set-default-directory)
(make-local-variable 'gnus-summary-line-format)
(gnus-run-mode-hooks 'gnus-summary-mode-hook)
(turn-on-gnus-mailing-list-mode)
(mm-enable-multibyte)
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'gnus-summary-bookmark-make-record)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(save-excursion
(let (config)
(goto-char (point-min))
- (while (search-forward "\r" nil t)
- (push (1- (point)) config))
+ (while (not (eobp))
+ (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum)
+ (push (save-excursion (forward-line 0) (point)) config))
+ (forward-line 1))
config)))
(defun gnus-restore-hidden-threads-configuration (config)
"Restore hidden threads configuration from CONFIG."
(save-excursion
- (let (point buffer-read-only)
+ (let (point (inhibit-read-only t))
(while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (eq (char-after) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r))))))
+ (goto-char point)
+ (gnus-summary-hide-thread)))))
;; Various summary mode internalish functions.
(i 32))
;; Nix out all the control chars...
(while (>= (setq i (1- i)) 0)
- (aset table i [??]))
+ (gnus-put-display-table i [??] table))
;; ... but not newline and cr, of course. (cr is necessary for the
;; selective display).
- (aset table ?\n nil)
- (aset table ?\r nil)
+ (gnus-put-display-table ?\n nil table)
+ (gnus-put-display-table ?\r nil table)
;; We keep TAB as well.
- (aset table ?\t nil)
+ (gnus-put-display-table ?\t nil table)
;; We nix out any glyphs 127 through 255, or 127 through 159 in
;; Emacs 23 (unicode), that are not set already.
(let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
256)))
(while (>= (setq i (1- i)) 127)
;; Only modify if the entry is nil.
- (unless (aref table i)
- (aset table i [??]))))
+ (unless (gnus-get-display-table i table)
+ (gnus-put-display-table i [??] table))))
(setq buffer-display-table table)))
(defun gnus-summary-set-article-display-arrow (pos)
"Update the overlay arrow to point to line at position POS."
- (when (and gnus-summary-display-arrow
- (boundp 'overlay-arrow-position)
- (boundp 'overlay-arrow-string))
+ (when gnus-summary-display-arrow
+ (make-local-variable 'overlay-arrow-position)
+ (make-local-variable 'overlay-arrow-string)
(save-excursion
(goto-char pos)
(beginning-of-line)
(gnus-tmp-subject (mail-header-subject gnus-tmp-header))
(gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
(gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(if (= gnus-tmp-lines -1)
(setq gnus-tmp-lines "?")
(setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
- (point)
- (progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number gnus-tmp-number)
+ (condition-case ()
+ (gnus-put-text-property
+ (point)
+ (progn (eval gnus-summary-line-format-spec) (point))
+ 'gnus-number gnus-tmp-number)
+ (error (gnus-message 5 "Error updating the summary line")))
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))))
'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
(not (memq (car elem) vars))
- (ignore-errors ; So we set it.
+ (ignore-errors
(push (car elem) vars)
- (make-local-variable (car elem))
- (set (car elem) (eval (nth 1 elem))))))))
+ ;; Variables like `gnus-show-threads' that are globally
+ ;; bound, if used as group parameters, need to get to be
+ ;; buffer-local, whereas just parameters like `gcc-self',
+ ;; `timestamp', etc. should not be bound as variables.
+ (if (boundp (car elem))
+ (set (make-local-variable (car elem)) (eval (nth 1 elem)))
+ (eval (nth 1 elem))))))))
(defun gnus-summary-read-group (group &optional show-all no-article
kill-buffer no-display backward
(progn
(set-buffer gnus-group-buffer)
(gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
;; Finally signal the quit.
(defun gnus-summary-prepare ()
"Generate the summary buffer."
(interactive)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(erase-buffer)
(setq gnus-newsgroup-data nil
gnus-newsgroup-data-reverse nil)
"Query where the respool algorithm would put this article."
(interactive)
(gnus-summary-select-article)
- (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
+ (message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject))))
(defun gnus-gather-threads-by-subject (threads)
"Gather threads by looking at Subject headers."
(let ((deps gnus-newsgroup-dependencies)
found header)
(prog1
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let ((case-fold-search nil))
(goto-char (point-min))
(while (and (not found)
(mail-parse-charset gnus-newsgroup-charset)
(dependencies gnus-newsgroup-dependencies)
header article)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let ((case-fold-search nil))
(goto-char (point-min))
(while (not (eobp))
(gnus-summary-goto-subject article)
(let* ((datal (gnus-data-find-list article))
(data (car datal))
- (buffer-read-only nil)
+ (inhibit-read-only t)
(level (gnus-summary-thread-level)))
(gnus-delete-line)
(let ((inserted (- (point)
(not (equal "" references)))
references))
"none")))
- (buffer-read-only nil)
+ (inhibit-read-only t)
(old (car thread)))
(when thread
(unless iheader
(defun gnus-rebuild-thread (id &optional line)
"Rebuild the thread containing ID.
If LINE, insert the rebuilt thread starting on line LINE."
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
old-pos current thread data)
(if (not gnus-show-threads)
(setq thread (list (car (gnus-id-to-thread id))))
;; Even after binding max-lisp-eval-depth, the recursive
;; sorter might fail for very long threads. In that case,
;; try using a (less well-tested) non-recursive sorter.
- (error (gnus-sort-threads-loop
+ (error (gnus-message 9 "Sorting threads with loop...")
+ (gnus-sort-threads-loop
threads (gnus-make-sort-function
gnus-thread-sort-functions))))
(gnus-message 8 "Sorting threads...done"))))
(gnus-thread-header h1) (gnus-thread-header h2)))
(defsubst gnus-article-sort-by-random (h1 h2)
- "Sort articles by article number."
+ "Sort articles randomly."
(zerop (random 2)))
(defun gnus-thread-sort-by-random (h1 h2)
- "Sort threads by root article number."
+ "Sort threads randomly."
(gnus-article-sort-by-random
(gnus-thread-header h1) (gnus-thread-header h2)))
"Sort threads such that the thread with the most recently dated article comes first."
(> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
+; Since this is called not only to sort the top-level threads, but
+; also in recursive sorts to order the articles within a thread, each
+; article will be processed many times. Thus it speeds things up
+; quite a bit to use gnus-date-get-time, which caches the time value.
(defun gnus-thread-latest-date (thread)
"Return the highest article date in THREAD."
- (let ((previous-time 0))
- (apply 'max
- (mapcar
- (lambda (header)
- (setq previous-time
- (condition-case ()
- (time-to-seconds (mail-header-parse-date
- (mail-header-date header)))
- (error previous-time))))
- (sort
- (message-flatten-list thread)
- (lambda (h1 h2)
- (< (mail-header-number h1)
- (mail-header-number h2))))))))
+ (apply 'max
+ (mapcar (lambda (header) (gnus-float-time
+ (gnus-date-get-time
+ (mail-header-date header))))
+ (message-flatten-list thread))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
:type 'string
:group 'gnus-thread)
+(defcustom gnus-summary-display-while-building nil
+ "If non-nil, show and update the summary buffer as it's being built.
+If the value is t, update the buffer after every line is inserted. If
+the value is an integer (N), update the display every N lines."
+ :version "22.1"
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ number
+ (const :tag "frequently" t)))
+
(defun gnus-summary-prepare-threads (threads)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
(setq gnus-tmp-lines "?")
(setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
(gnus-put-text-property
- (point)
- (progn (eval gnus-summary-line-format-spec) (point))
+ (point)
+ (progn (eval gnus-summary-line-format-spec) (point))
'gnus-number number)
- (when gnus-visual-p
- (forward-line -1)
- (gnus-run-hooks 'gnus-summary-update-hook)
- (forward-line 1))
+ (when gnus-visual-p
+ (forward-line -1)
+ (gnus-summary-highlight-line)
+ (when gnus-summary-update-hook
+ (gnus-run-hooks 'gnus-summary-update-hook))
+ (forward-line 1))
- (setq gnus-tmp-prev-subject simp-subject)))
+ (setq gnus-tmp-prev-subject simp-subject)))
(when (nth 1 thread)
(push (list (max 0 gnus-tmp-level)
(mm-decode-coding-string (gnus-status-message group) charset))))
(unless (gnus-request-group group t)
- (when (equal major-mode 'gnus-summary-mode)
- (gnus-kill-buffer (current-buffer)))
- (error "Couldn't request group %s: %s"
- (mm-decode-coding-string group charset)
- (mm-decode-coding-string (gnus-status-message group) charset)))
+ (when (equal major-mode 'gnus-summary-mode)
+ (gnus-kill-buffer (current-buffer)))
+ (error "Couldn't request group %s: %s"
+ (mm-decode-coding-string group charset)
+ (mm-decode-coding-string (gnus-status-message group) charset)))
(when gnus-agent
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(gnus-inverse-list-range-intersection
gnus-newsgroup-articles gnus-newsgroup-seen))))
+(declare-function gnus-get-predicate "gnus-agent" (predicate))
+
(defun gnus-summary-display-make-predicate (display)
(require 'gnus-agent)
(when (= (length display) 1)
(symbol-value
(intern (format "gnus-%s-mode-line-format-spec" where))))
(let (mode-string)
- (save-excursion
- ;; We evaluate this in the summary buffer since these
- ;; variables are buffer-local to that buffer.
- (set-buffer gnus-summary-buffer)
- ;; We bind all these variables that are used in the `eval' form
+ ;; We evaluate this in the summary buffer since these
+ ;; variables are buffer-local to that buffer.
+ (with-current-buffer gnus-summary-buffer
+ ;; We bind all these variables that are used in the `eval' form
;; below.
(let* ((mformat (symbol-value
(intern
(when (> (length mode-string) max-len)
(setq mode-string
(concat (truncate-string-to-width mode-string (- max-len 3))
- "...")))
- ;; Pad the mode string a bit.
- (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
+ "...")))))
;; Update the mode line.
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification (list mode-string)))
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (gnus-virtual-group-p from-newsgroup))
name info xref-hashtb idlist method nth4)
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(when (setq xref-hashtb
(gnus-create-xref-hashtb from-newsgroup headers unreads))
(mapatoms
headers id end ref number
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (save-excursion (condition-case nil
- (set-buffer gnus-summary-buffer)
- (error))
- gnus-newsgroup-ignored-charsets)))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (save-current-buffer (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets)))
+ (with-current-buffer nntp-server-buffer
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
(subst-char-in-region (point-min) (point-max) ?\r ? t)
(t
nil)))
number headers header)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(subst-char-in-region (point-min) (point-max) ?\r ? t)
;; Allow the user to mangle the headers before parsing them.
(gnus-run-hooks 'gnus-parse-headers-hook)
"Return a list of articles to be worked upon.
The prefix argument, the list of process marked articles, and the
current article will be taken into consideration."
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(cond
(n
;; A numerical prefix has been given.
(defun gnus-summary-search-group (&optional backward use-level)
"Search for next unread newsgroup.
If optional argument BACKWARD is non-nil, search backward instead."
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(when (gnus-group-search-forward
backward nil (if use-level (gnus-group-group-level) nil))
(gnus-group-group-name))))
(when (and gnus-auto-center-summary
(not (eq gnus-auto-center-summary 'vertical)))
(gnus-horizontal-recenter))
- (recenter n))
+ (if (fboundp 'recenter-top-bottom)
+ (recenter-top-bottom n)
+ (recenter n)))
+
+(put 'gnus-recenter 'isearch-scroll t)
+
+(defun gnus-forward-line-ignore-invisible (n)
+ "Move N lines forward (backward if N is negative).
+Like forward-line, but skip over (and don't count) invisible lines."
+ (let (done)
+ (while (and (> n 0) (not done))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value.
+ (while (gnus-invisible-p (point))
+ (goto-char (gnus-next-char-property-change (point))))
+ (forward-line 1)
+ (if (eobp)
+ (setq done t)
+ (setq n (1- n))))
+ (while (and (< n 0) (not done))
+ (forward-line -1)
+ (if (bobp) (setq done t)
+ (setq n (1+ n))
+ (while (and (not (bobp)) (gnus-invisible-p (1- (point))))
+ (goto-char (gnus-previous-char-property-change (point))))))))
(defun gnus-summary-recenter ()
"Center point in the summary window.
gnus-auto-center-summary
(/ (1- (window-height)) 2)))))
(height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
+ (bottom (save-excursion
+ (goto-char (point-max))
+ (gnus-forward-line-ignore-invisible (- height))
+ (point)))
(window (get-buffer-window (current-buffer))))
(when (get-buffer-window gnus-article-buffer)
;; Only do recentering when the article buffer is displayed,
;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
- (let ((top-pos (save-excursion (forward-line (- top)) (point))))
+ (let ((top-pos (save-excursion
+ (gnus-forward-line-ignore-invisible (- top))
+ (point))))
(if (> bottom top-pos)
;; Keep the second line from the top visible
(set-window-start window top-pos)
;; visible, or revert to using TOP-POS.
(save-excursion
(goto-char (point-max))
- (forward-line -1)
+ (gnus-forward-line-ignore-invisible -1)
(let ((last-line-start (point)))
(goto-char bottom)
(set-window-start window (point) t)
(when (not (pos-visible-in-window-p last-line-start window))
- (forward-line 1)
+ (gnus-forward-line-ignore-invisible 1)
(set-window-start window (min (point) top-pos) t)))))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(gnus-group-jump-to-group newsgroup))
(save-excursion
;; Take care of tree window mode.
- (if (get-buffer-window gnus-group-buffer)
+ (if (get-buffer-window gnus-group-buffer 0)
(pop-to-buffer gnus-group-buffer)
(set-buffer gnus-group-buffer))
(gnus-group-jump-to-group newsgroup))))
(gnus-save-newsrc-file)
(gnus-dribble-save)))
+(declare-function gnus-cache-write-active "gnus-cache" (&optional force))
+
(defun gnus-summary-exit (&optional temporary leave-hidden)
"Exit reading current newsgroup, and then return to group selection mode.
`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
(interactive)
(gnus-set-global-variables)
(when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(gnus-async-halt-prefetch)
(run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(cond ((eq major-mode 'gnus-summary-mode)
(gnus-set-global-variables))
((eq major-mode 'gnus-article-mode)
- (save-excursion
+ (save-current-buffer
;; The `gnus-summary-buffer' variable may point
;; to the old summary buffer when using a single
;; article buffer.
;;; Dead summaries.
-(defvar gnus-dead-summary-mode-map nil)
-
-(unless gnus-dead-summary-mode-map
- (setq gnus-dead-summary-mode-map (make-keymap))
- (suppress-keymap gnus-dead-summary-mode-map)
- (substitute-key-definition
- 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (dolist (key '("\C-d" "\r" "\177" [delete]))
- (define-key gnus-dead-summary-mode-map
- key 'gnus-summary-wake-up-the-dead))
- (dolist (key '("q" "Q"))
- (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
-
-(defvar gnus-dead-summary-mode nil
- "Minor mode for Gnus summary buffers.")
-
-(defun gnus-dead-summary-mode (&optional arg)
+(defvar gnus-dead-summary-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (substitute-key-definition 'undefined 'gnus-summary-wake-up-the-dead map)
+ (dolist (key '("\C-d" "\r" "\177" [delete]))
+ (define-key map key 'gnus-summary-wake-up-the-dead))
+ (dolist (key '("q" "Q"))
+ (define-key map key 'bury-buffer))
+ map))
+
+(define-minor-mode gnus-dead-summary-mode
"Minor mode for Gnus summary buffers."
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (make-local-variable 'gnus-dead-summary-mode)
- (setq gnus-dead-summary-mode
- (if (null arg) (not gnus-dead-summary-mode)
- (> (prefix-numeric-value arg) 0)))
- (when gnus-dead-summary-mode
- (add-minor-mode
- 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
+ :lighter " Dead" :keymap gnus-dead-summary-mode-map
+ (unless (derived-mode-p 'gnus-summary-mode)
+ (setq gnus-dead-summary-mode nil)))
(defun gnus-deaden-summary ()
"Make the current summary buffer into a dead summary buffer."
(gnus-kill-summary-on-exit
(when (and gnus-use-trees
(gnus-buffer-exists-p buffer))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(gnus-tree-close gnus-newsgroup-name)))
(gnus-kill-buffer buffer))
;; Deaden the buffer.
((gnus-buffer-exists-p buffer)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(gnus-deaden-summary))))))
(defun gnus-summary-wake-up-the-dead (&rest args)
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
(interactive)
- (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
"Go to the first subject satisfying any non-nil constraint.
If UNREAD is non-nil, the article should be unread.
If UNDOWNLOADED is non-nil, the article should be undownloaded.
-If UNSEEN is non-nil, the article should be unseen.
+If UNSEEN is non-nil, the article should be unseen as well as unread.
Returns the article selected or nil if there are no matching articles."
(interactive "P")
(cond
(and undownloaded
(memq num gnus-newsgroup-undownloaded))
(and unseen
- (memq num gnus-newsgroup-unseen)))))))
+ (memq num gnus-newsgroup-unseen)
+ (memq num gnus-newsgroup-unreads)))))))
(setq data (cdr data)))
(prog1
(if data
(gnus-summary-position-point))
(defun gnus-summary-goto-subject (article &optional force silent)
- "Go the subject line of ARTICLE.
+ "Go to the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
(interactive "nArticle number: ")
(unless (numberp article)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
(error "This is a pseudo-article"))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(if (or (and gnus-single-article-buffer
(or (null gnus-current-article)
(null gnus-article-current)
(t
(unless (gnus-ephemeral-group-p gnus-newsgroup-name)
(gnus-summary-jump-to-group gnus-newsgroup-name))
- (let ((cmd last-command-char)
+ (let ((cmd (if (featurep 'xemacs)
+ last-command-char
+ last-command-event))
(point
(with-current-buffer gnus-group-buffer
(point)))
(?\C-p (gnus-group-prev-unread-group 1))))
(cursor-in-echo-area t)
keve key group ended prompt)
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(goto-char start)
(setq group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-article-subject))))
(defun gnus-summary-prev-article (&optional unread subject)
- "Select the article after the current one.
+ "Select the article before the current one.
If UNREAD is non-nil, only unread articles are selected."
(interactive "P")
(gnus-summary-next-article unread subject t))
(setq endp (or (gnus-article-next-page lines)
(gnus-article-only-boring-p))))
(when endp
- (cond (stop
+ (cond ((or stop gnus-summary-stop-at-end-of-message)
(gnus-message 3 "End of message"))
(circular
(gnus-summary-beginning-of-article))
(gnus-summary-position-point)))
(defun gnus-summary-first-unseen-or-unread-subject ()
- "Place the point on the subject line of the first unseen article or,
-if all article have been seen, on the subject line of the first unread
+ "Place the point on the subject line of the first unseen and unread article.
+If all article have been seen, on the subject line of the first unread
article."
(interactive)
(prog1
(gnus-summary-position-point))))
(defun gnus-summary-limit-strange-charsets-predicate (header)
- (let ((string (concat (mail-header-subject header)
- (mail-header-from header)))
- charset found)
- (dotimes (i (1- (length string)))
- (setq charset (format "%s" (char-charset (aref string (1+ i)))))
- (when (string-match "unicode\\|big\\|japanese" charset)
- (setq found t)))
- found))
+ (when (fboundp 'char-charset)
+ (let ((string (concat (mail-header-subject header)
+ (mail-header-from header)))
+ charset found)
+ (dotimes (i (1- (length string)))
+ (setq charset (format "%s" (char-charset (aref string (1+ i)))))
+ (when (string-match "unicode\\|big\\|japanese" charset)
+ (setq found t)))
+ found)))
(defun gnus-summary-limit-to-predicate (predicate)
"Limit to articles where PREDICATE returns non-nil.
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
(setq is-younger (time-less-p
- (time-since (condition-case ()
- (date-to-time date)
- (error '(0 0))))
+ (time-since (gnus-date-get-time date))
cutoff))
(when (if younger-p
is-younger
(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(make-obsolete
- 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
+ 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4")
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark gnus-souped-mark)
+ gnus-duplicate-mark)
'reverse)))
(defun gnus-summary-limit-to-headers (match &optional reverse)
(dolist (data gnus-newsgroup-data)
(let (gnus-mark-article-hook)
(gnus-summary-select-article t t nil (gnus-data-number data)))
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(article-goto-body)
(let* ((case-fold-search t)
(found (if headersp
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
(make-obsolete 'gnus-summary-delete-marked-with
- 'gnus-summary-limit-exclude-marks)
+ 'gnus-summary-limit-exclude-marks "Emacs 20.4")
(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
"Exclude articles that are marked with MARKS (e.g. \"DK\").
This entails weeding out unwanted dormants, low-scored articles,
fetch-old-headers verbiage, and so on."
;; Most groups have nothing to remove.
- (if (or gnus-inhibit-limiting
- (and (null gnus-newsgroup-dormant)
- (eq gnus-newsgroup-display 'gnus-not-ignore)
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers))
- (not (eq gnus-fetch-old-headers 'invisible))
- (null gnus-summary-expunge-below)
- (not (eq gnus-build-sparse-threads 'some))
- (not (eq gnus-build-sparse-threads 'more))
- (null gnus-thread-expunge-below)
- (not gnus-use-nocem)))
- () ; Do nothing.
+ (unless (or gnus-inhibit-limiting
+ (and (null gnus-newsgroup-dormant)
+ (eq gnus-newsgroup-display 'gnus-not-ignore)
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers))
+ (not (eq gnus-fetch-old-headers 'invisible))
+ (null gnus-summary-expunge-below)
+ (not (eq gnus-build-sparse-threads 'some))
+ (not (eq gnus-build-sparse-threads 'more))
+ (null gnus-thread-expunge-below)
+ (not gnus-use-nocem)))
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit nil)
(mapatoms
;; References header, since this is slightly more
;; reliable than the References field we got from the
;; server.
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(nnheader-narrow-to-headers)
(unless (setq ref (message-fetch-field "references"))
(when (setq ref (message-fetch-field "in-reply-to"))
(case-fold-search t)
(buf (current-buffer))
dig to-address)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
;; Have the digest group inherit the main mail address of
;; the parent article.
(when (setq to-address (or (gnus-fetch-field "reply-to")
(setq group (format "%s-%d" gnus-newsgroup-name article))
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
- (save-excursion
+ (save-excursion ;;What for?
(with-temp-buffer
(insert-buffer-substring gnus-original-article-buffer)
;; Remove some headers that may lead nndoc to make
(nndoc-article-type guess))
t nil t))
(progn
- ;; Make all postings to this group go to the parent group.
+ ;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info egroup))
params)
(push egroup groups))
This search includes all articles in the current group that Gnus has
fetched headers for, whether they are displayed or not."
(let ((articles nil)
+ ;; Can't eta-reduce because it's a macro.
(func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search t))
(dolist (header gnus-newsgroup-headers)
(goto-char (point-max))
(recenter -3)
(when gnus-break-pages
- (when (re-search-backward page-delimiter nil t)
- (narrow-to-region (match-end 0) (point-max)))
(gnus-narrow-to-page))))
(defun gnus-summary-print-truncate-and-quote (string &optional len)
(mail-header-date gnus-current-headers) ")"))))
(gnus-run-hooks 'gnus-ps-print-hook)
(save-excursion
- (if window-system
+ (if ps-print-color-p
(ps-spool-buffer-with-faces)
(ps-spool-buffer)))))
(kill-buffer buffer))))
(gnus-summary-select-article nil 'force)
(let ((deps gnus-newsgroup-dependencies)
head header lines)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(save-restriction
(message-narrow-to-head)
(setq head (buffer-string))
gnus-break-pages)
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(with-current-buffer gnus-article-buffer
(widen)
(article-narrow-to-head)
- (let* ((buffer-read-only nil)
+ (let* ((inhibit-read-only t)
(inhibit-point-motion-hooks t)
(hidden (if (numberp arg)
(>= arg 0)
(if gnus-break-pages
(gnus-narrow-to-page)
(when (gnus-visual-p 'page-marker)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next))))
(gnus-set-mode-line 'article)))))
(save-restriction
(widen)
(let ((start (window-start))
- buffer-read-only)
+ (inhibit-read-only t))
(if (equal arg '(4))
(message-caesar-buffer-body nil t)
(message-caesar-buffer-body arg))
;; Create buttons and stuff...
(gnus-treat-article nil))
+(declare-function idna-to-unicode "ext:idna" (str))
+
(defun gnus-summary-idna-message (&optional arg)
"Decode IDNA encoded domain names in the current articles.
IDNA encoded domain names looks like `xn--bar'. If a string
remain unencoded after running this function, it is likely an
invalid IDNA string (`xn--bar' is invalid).
-You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
+You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
installed for this command to work."
(interactive "P")
(if (not (and (condition-case nil (require 'idna)
(save-restriction
(widen)
(let ((pos (window-start))
- buffer-read-only)
+ (inhibit-read-only t))
(goto-char (point-min))
(when (message-goto-body)
(gnus-narrow-to-body))
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(when (gnus-visual-p 'page-marker)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next))
(setq gnus-page-broken nil))))
to-newsgroup (list 'quote select-method)
(not articles) t) ; Accept form
(not articles) ; Only save nov last time
- move-is-internal))) ; is this move internal?
+ (and move-is-internal
+ (gnus-group-real-name to-newsgroup))))) ; is this move internal?
;; Copy the article.
((eq action 'copy)
- (save-excursion
- (set-buffer copy-buf)
+ (with-current-buffer copy-buf
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
(save-restriction
(nnheader-narrow-to-headers)
(delete "Xref:" (delete new-xref xref))
" ")
" " new-xref))
- (save-excursion
- (set-buffer copy-buf)
+ (with-current-buffer copy-buf
;; First put the article in the destination group.
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(when (consp (setq art-group
(list (cdr art-group)))))
;; See whether the article is to be put in the cache.
- (let ((marks (if (gnus-group-auto-expirable-p to-group)
- gnus-article-mark-lists
- (delete '(expirable . expire)
- (copy-sequence gnus-article-mark-lists))))
- (to-article (cdr art-group)))
+ (let* ((expirable (gnus-group-auto-expirable-p to-group))
+ (marks (if expirable
+ gnus-article-mark-lists
+ (delete '(expirable . expire)
+ (copy-sequence gnus-article-mark-lists))))
+ (to-article (cdr art-group)))
;; Enter the article into the cache in the new group,
;; if that is required.
to-group (cdar marks) (list to-article) info)))
(setq marks (cdr marks)))
- (gnus-request-set-mark
- to-group (list (list (list to-article) 'add to-marks))))
+ (when (and expirable
+ gnus-mark-copied-or-moved-articles-as-expirable
+ (not (memq 'expire to-marks)))
+ ;; Mark this article as expirable.
+ (push 'expire to-marks)
+ (when (equal to-group gnus-newsgroup-name)
+ (push to-article gnus-newsgroup-expirable))
+ ;; Copy the expirable mark to other group.
+ (gnus-add-marked-articles
+ to-group 'expire (list to-article) info))
+
+ (when to-marks
+ (gnus-request-set-mark
+ to-group (list (list (list to-article) 'add to-marks)))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
(when (eq action 'crosspost)
- (save-excursion
- (set-buffer copy-buf)
+ (with-current-buffer copy-buf
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
- (gnus-summary-goto-subject article)
(when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark))))
+ (save-excursion
+ (gnus-summary-goto-subject article)
+ (gnus-summary-mark-article article gnus-canceled-mark)))))
(push article articles-to-update-marks))
- (apply 'gnus-summary-remove-process-mark articles-to-update-marks)
- ;; Re-activate all groups that have been moved to.
(save-excursion
- (set-buffer gnus-group-buffer)
+ (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
+ ;; Re-activate all groups that have been moved to.
+ (with-current-buffer gnus-group-buffer
(let ((gnus-group-marked to-groups))
(gnus-group-get-new-news-this-group nil t)))
:type 'symbol
:group 'gnus-summary-mail)
-(defcustom gnus-summary-display-while-building nil
- "If non-nil, show and update the summary buffer as it's being built.
-If the value is t, update the buffer after every line is inserted. If
-the value is an integer (N), update the display every N lines."
- :version "22.1"
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- number
- (const :tag "frequently" t)))
-
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
(or (file-readable-p file)
(not (file-regular-p file))
(error "Can't read %s" file))
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *import file*"))
+ (with-current-buffer (gnus-get-buffer-create " *import file*")
(erase-buffer)
(nnheader-insert-file-contents file)
(goto-char (point-min))
group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
(error "%s does not support article importing" group))
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *import file*"))
+ (with-current-buffer (gnus-get-buffer-create " *import file*")
(erase-buffer)
(goto-char (point-min))
;; This doesn't look like an article, so we fudge some headers.
;; Delete the articles.
(setq not-deleted (gnus-request-expire-articles
articles gnus-newsgroup-name 'force))
- (while articles
- (gnus-summary-remove-process-mark (car articles))
- ;; The backend might not have been able to delete the article
- ;; after all.
- (unless (memq (car articles) not-deleted)
- (gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (let* ((article (car articles))
- (ghead (gnus-data-header
- (assoc article (gnus-data-list nil)))))
- (run-hook-with-args 'gnus-summary-article-delete-hook
- 'delete ghead gnus-newsgroup-name nil
- nil))
- (setq articles (cdr articles)))
+ (save-excursion
+ (while articles
+ (gnus-summary-remove-process-mark (car articles))
+ ;; The backend might not have been able to delete the article
+ ;; after all.
+ (unless (memq (car articles) not-deleted)
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (let* ((article (car articles))
+ (ghead (gnus-data-header
+ (assoc article (gnus-data-list nil)))))
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ 'delete ghead gnus-newsgroup-name nil
+ nil))
+ (setq articles (cdr articles))))
(when not-deleted
(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(gnus-summary-position-point)
"nndraft:queue")))
(error "Can't edit the raw article in group %s"
gnus-newsgroup-name))
- (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))
(gnus-set-global-variables)
(let ((nntp-server-buffer (current-buffer)))
(setq header (car (gnus-get-newsgroup-headers
nil t))))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(gnus-data-set-header
(gnus-data-find (cdr gnus-article-current))
header)
(cdr gnus-article-current))))
;; Prettify the article buffer again.
(unless no-highlight
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
;;;!!! Fix this -- article should be rehighlighted.
;;;(gnus-run-hooks 'gnus-article-display-hook)
(set-buffer gnus-original-article-buffer)
(interactive)
(let (gnus-mark-article-hook)
(gnus-summary-select-article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(let ((groups (nnmail-article-group 'identity trace)))
(unless silent
(if groups
(unless (numberp article)
(error "%s is not a number" article))
(push article gnus-newsgroup-replied)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(when (gnus-summary-goto-subject article nil t)
(gnus-summary-update-secondary-mark article))))))
(let ((articles (if (listp article) article (list article))))
(dolist (article articles)
(push article gnus-newsgroup-forwarded)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(when (gnus-summary-goto-subject article nil t)
(gnus-summary-update-secondary-mark article))))))
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
(when (gnus-summary-goto-subject article nil t)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(gnus-summary-show-thread)
;; Fix the mark.
(gnus-summary-update-mark mark 'unread)
(t gnus-no-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook))
t)
(defun gnus-summary-update-mark (mark type)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
(when forward
(when (looking-at "\r")
;; Go to the right position on the line.
(goto-char (+ forward (point)))
;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (char-after) mark)
+ (let ((to-insert
+ (mm-subst-char-in-string
+ (char-after) mark
+ (buffer-substring (point) (1+ (point))))))
+ (delete-region (point) (1+ (point)))
+ (insert to-insert))
;; Optionally update the marks by some user rule.
(when (eq type 'unread)
(gnus-data-set-mark
(defalias 'gnus-summary-mark-as-unread-forward
'gnus-summary-tick-article-forward)
(make-obsolete 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward)
+ 'gnus-summary-tick-article-forward "Emacs 20.4")
(defun gnus-summary-tick-article-forward (n)
"Tick N articles forwards.
If N is negative, tick backwards instead.
(defalias 'gnus-summary-mark-as-unread-backward
'gnus-summary-tick-article-backward)
(make-obsolete 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward)
+ 'gnus-summary-tick-article-backward "Emacs 20.4")
(defun gnus-summary-tick-article-backward (n)
"Tick N articles backwards.
The difference between N and the number of articles ticked is returned."
(gnus-summary-mark-forward (- n) gnus-ticked-mark))
(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
+(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article "Emacs 20.4")
(defun gnus-summary-tick-article (&optional article clear-mark)
"Mark current article as unread.
Optional 1st argument ARTICLE specifies article number to be marked as unread.
(gnus-summary-mark-forward (- n) gnus-unread-mark))
(defun gnus-summary-mark-unread-as-read ()
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-read-mark)))
(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
(or new-mark gnus-read-mark)))))
(defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
(or new-mark gnus-read-mark)))))
(defun gnus-summary-mark-unread-as-ticked ()
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(goto-char (point-min))
(while
(progn
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(goto-char (point-min))
(while (and (progn
(when (> (gnus-summary-article-score) score)
(defun gnus-summary-limit-include-expunged (&optional no-error)
"Display all the hidden articles that were expunged for low scores."
(interactive)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(let ((scored gnus-newsgroup-scored)
headers h)
(while scored
(gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
(gnus-summary-position-point)))
+(eval-and-compile
+ (if (fboundp 'remove-overlays)
+ (defalias 'gnus-remove-overlays 'remove-overlays)
+ (defun gnus-remove-overlays (beg end name val)
+ "Clear BEG and END of overlays whose property NAME has value VAL.
+For compatibility with Emacs 21 and XEmacs."
+ (dolist (ov (gnus-overlays-in beg end))
+ (when (eq (gnus-overlay-get ov name) val)
+ (gnus-delete-overlay ov))))))
+
(defun gnus-summary-show-all-threads ()
"Show all threads."
(interactive)
- (save-excursion
- (let ((buffer-read-only nil))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
+ (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
(gnus-summary-position-point))
(defun gnus-summary-show-thread ()
"Show thread subtrees.
Returns nil if no thread was there to be shown."
(interactive)
- (let ((buffer-read-only nil)
- (orig (point))
- (end (point-at-eol))
- ;; Leave point at bol
- (beg (progn (beginning-of-line) (point))))
- (prog1
- ;; Any hidden lines here?
- (search-forward "\r" end t)
- (subst-char-in-region beg end ?\^M ?\n t)
+ (let* ((orig (point))
+ (end (point-at-eol))
+ ;; Leave point at bol
+ (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
+ (eoi (when (eq (get-char-property end 'invisible) 'gnus-sum)
+ (if (fboundp 'next-single-char-property-change)
+ (or (next-single-char-property-change end 'invisible)
+ (point-max))
+ (while (progn
+ (end-of-line 2)
+ (and (not (eobp))
+ (eq (get-char-property (point) 'invisible)
+ 'gnus-sum))))
+ (point)))))
+ (when eoi
+ (gnus-remove-overlays beg eoi 'invisible 'gnus-sum)
(goto-char orig)
- (gnus-summary-position-point))))
+ (gnus-summary-position-point)
+ eoi)))
(defun gnus-summary-maybe-hide-threads ()
"If requested, hide the threads that should be hidden."
will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
- (let ((buffer-read-only nil)
- (start (point))
+ (let ((start (point))
+ (starteol (line-end-position))
(article (gnus-summary-article-number)))
(goto-char start)
- ;; Go forward until either the buffer ends or the subthread
- ;; ends.
+ ;; Go forward until either the buffer ends or the subthread ends.
(when (and (not (eobp))
(or (zerop (gnus-summary-next-thread 1 t))
(goto-char (point-max))))
- (prog1
- (if (and (> (point) start)
- (search-backward "\n" start t))
- (progn
- (subst-char-in-region start (point) ?\n ?\^M)
- (gnus-summary-goto-subject article))
- (goto-char start)
- nil)))))
+ (if (and (> (point) start)
+ ;; FIXME: this should actually search for a non-invisible \n.
+ (search-backward "\n" start t))
+ (progn
+ (when (> (point) starteol)
+ (gnus-remove-overlays starteol (point) 'invisible 'gnus-sum)
+ (let ((ol (gnus-make-overlay starteol (point) nil t nil)))
+ (gnus-overlay-put ol 'invisible 'gnus-sum)
+ (gnus-overlay-put ol 'evaporate t)))
+ (gnus-summary-goto-subject article))
+ (goto-char start)
+ nil))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
((> unmark 0)
(gnus-summary-mark-article-as-unread gnus-unread-mark))
((= unmark 0)
- (gnus-summary-mark-article-as-unread gnus-expirable-mark))
+ (gnus-summary-mark-article nil gnus-expirable-mark))
(t
(gnus-summary-mark-article-as-unread gnus-ticked-mark)))
(setq articles (cdr articles))))
(interactive "P")
(gnus-summary-sort 'number reverse))
+(defun gnus-summary-sort-by-most-recent-number (&optional reverse)
+ "Sort the summary buffer by most recent article number.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'most-recent-number reverse))
+
(defun gnus-summary-sort-by-random (&optional reverse)
"Randomize the order in the summary buffer.
Argument REVERSE means to randomize in reverse order."
(interactive "P")
(gnus-summary-sort 'date reverse))
+(defun gnus-summary-sort-by-most-recent-date (&optional reverse)
+ "Sort the summary buffer by most recent date.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'most-recent-date reverse))
+
(defun gnus-summary-sort-by-score (&optional reverse)
"Sort the summary buffer by score.
Argument REVERSE means reverse order."
"Sort the summary buffer using the default sorting method.
Argument REVERSE means reverse order."
(interactive "P")
- (let* ((buffer-read-only)
+ (let* ((inhibit-read-only t)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
(gnus-summary-prepare)
article
`(lambda (t1 t2)
(,article t2 t1))))
- (buffer-read-only)
+ (inhibit-read-only t)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
(gnus-summary-prepare)
(gnus-message 1 "Article %d is unsaveable" article))
;; This is a real 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 nil nil article)
- (gnus-summary-goto-subject article)))
- (save-excursion
- (set-buffer save-buffer)
+ (gnus-summary-select-article decode decode nil article)
+ (gnus-summary-goto-subject article))
+ (with-current-buffer save-buffer
(erase-buffer)
(insert-buffer-substring (if decode
gnus-article-buffer
(gnus-set-mode-line 'summary)
n))
-(defun gnus-summary-pipe-output (&optional arg headers)
+(defun gnus-summary-pipe-output (&optional n sym)
"Pipe the current article to a subprocess.
If N is a positive number, pipe the N next articles.
If N is a negative number, pipe the N previous articles.
If N is nil and any articles have been marked with the process mark,
pipe those articles instead.
-If HEADERS (the symbolic prefix), include the headers, too."
+The default command to which articles are piped is specified by the
+variable `gnus-summary-pipe-output-default-command'; if it is nil, you
+will be prompted for the command.
+
+The properties `:decode' and `:headers' that are put to the function
+symbol `gnus-summary-save-in-pipe' control whether this function
+decodes articles and what headers to keep (see the doc string for the
+`gnus-default-article-saver' variable). If SYM (the symbolic prefix)
+is neither omitted nor the symbol `r', force including all headers
+regardless of the `:headers' property. If it is the symbol `r',
+articles that are not decoded and include all headers will be piped
+no matter what the properties `:decode' and `:headers' are."
(interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
- (gnus-save-all-headers (or headers gnus-save-all-headers)))
- (gnus-summary-save-article arg t))
- (let ((buffer (get-buffer "*Shell Command Output*")))
- (when (and buffer
- (not (zerop (buffer-size buffer))))
- (gnus-configure-windows 'pipe))))
+ (let* ((articles (gnus-summary-work-articles n))
+ (result-buffer "*Shell Command Output*")
+ (all-headers (not (memq sym '(nil r))))
+ (gnus-save-all-headers (or all-headers gnus-save-all-headers))
+ (raw (eq sym 'r))
+ (headers (get 'gnus-summary-save-in-pipe :headers))
+ command result)
+ (unless (numberp (car articles))
+ (error "No article to pipe"))
+ (setq command (gnus-read-shell-command
+ (concat "Shell command on "
+ (if (cdr articles)
+ (format "these %d articles" (length articles))
+ "this article")
+ ": ")
+ gnus-summary-pipe-output-default-command))
+ (when (string-equal command "")
+ (error "A command is required"))
+ (when all-headers
+ (put 'gnus-summary-save-in-pipe :headers nil))
+ (unwind-protect
+ (while articles
+ (gnus-summary-goto-subject (pop articles))
+ (save-window-excursion (gnus-summary-save-in-pipe command raw))
+ (when (and (get-buffer result-buffer)
+ (not (zerop (buffer-size (get-buffer result-buffer)))))
+ (setq result (concat result (with-current-buffer result-buffer
+ (buffer-string))))))
+ (put 'gnus-summary-save-in-pipe :headers headers))
+ (unless (zerop (length result))
+ (if (with-current-buffer (get-buffer-create result-buffer)
+ (erase-buffer)
+ (insert result)
+ (prog1
+ (and (= (count-lines (point-min) (point)) 1)
+ (progn
+ (end-of-line 0)
+ (<= (current-column)
+ (window-width (minibuffer-window)))))
+ (goto-char (point-min))))
+ (message "%s" (substring result 0 -1))
+ (message nil)
+ (gnus-configure-windows 'pipe)))))
(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to a Unix mail box file.
(save-restriction
(widen)
(let ((start (window-start))
- buffer-read-only)
+ (inhibit-read-only t))
(message-pipe-buffer-body program)
(set-window-start (get-buffer-window (current-buffer)) start))))))
"Return a value based on the split METHODS."
(let (split-name method result match)
(when methods
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(save-restriction
(nnheader-narrow-to-headers)
(while (and methods (not split-name))
encoded)))
(defvar gnus-summary-save-parts-counter)
+(declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type))
(defun gnus-summary-save-parts (type dir n &optional reverse)
"Save parts matching TYPE to DIR.
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
+ gnus-article-prepare-hook
+ gnus-article-decode-hook
+ gnus-display-mime-function
+ gnus-break-pages
(gnus-inhibit-treatment t))
(gnus-summary-select-article))
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(let ((handles (or gnus-article-mime-handles
(mm-dissect-buffer nil gnus-article-loose-mime)
(and gnus-article-emulate-mime
;; Summary extract commands
(defun gnus-summary-insert-pseudos (pslist &optional not-view)
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
(article (gnus-summary-article-number))
after-article b e)
(unless (gnus-summary-goto-subject article)
;; We have found the header.
header
;; We have to really fetch the header to this article.
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(when (setq where (gnus-request-head id group))
(nnheader-fold-continuation-lines)
(goto-char (point-max))
;; a different group (or server), we fudge some bogus
;; article numbers for this article.
(mail-header-set-number header gnus-reffed-article-number))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(decf gnus-reffed-article-number)
(gnus-remove-header (mail-header-number header))
(push header gnus-newsgroup-headers)
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (gnus-check-backend-function 'request-set-mark group)
+ (when (and gnus-propagate-marks
+ (gnus-check-backend-function 'request-set-mark group))
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
(when (or add del)
(gnus-summary-limit (gnus-sorted-nunion old new))))
(gnus-summary-position-point)))
+;;; Bookmark support for Gnus.
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+(defvar bookmark-yank-point)
+(defvar bookmark-current-buffer)
+
+(defun gnus-summary-bookmark-make-record ()
+ "Make a bookmark entry for a Gnus summary buffer."
+ (let (pos buf)
+ (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current)
+ (save-restriction ; FIXME is it necessary to widen?
+ (widen) (setq pos (point))) ; Set position in gnus-article buffer.
+ (setq buf "art") ; We are recording bookmark from article buffer.
+ (setq bookmark-yank-point (point))
+ (setq bookmark-current-buffer (current-buffer))
+ (gnus-article-show-summary)) ; Go back in summary buffer.
+ ;; We are now recording bookmark from summary buffer.
+ (unless buf (setq buf "sum"))
+ (let* ((subject (elt (gnus-summary-article-header) 1))
+ (grp (car gnus-article-current))
+ (art (cdr gnus-article-current))
+ (head (gnus-summary-article-header art))
+ (id (mail-header-id head)))
+ `(,subject
+ ,@(condition-case nil
+ (bookmark-make-record-default 'no-file 'no-context pos)
+ (wrong-number-of-arguments
+ (bookmark-make-record-default 'point-only)))
+ (location . ,(format "Gnus-%s %s:%d:%s" buf grp art id))
+ (group . ,grp) (article . ,art)
+ (message-id . ,id) (handler . gnus-summary-bookmark-jump)))))
+
+;;;###autoload
+(defun gnus-summary-bookmark-jump (bookmark)
+ "Handler function for record returned by `gnus-summary-bookmark-make-record'.
+BOOKMARK is a bookmark name or a bookmark record."
+ (let ((group (bookmark-prop-get bookmark 'group))
+ (article (bookmark-prop-get bookmark 'article))
+ (id (bookmark-prop-get bookmark 'message-id))
+ (buf (car (split-string (bookmark-prop-get bookmark 'location)))))
+ (gnus-fetch-group group (list article))
+ (gnus-summary-insert-cached-articles)
+ (gnus-summary-goto-article id nil 'force)
+ ;; FIXME we have to wait article buffer is ready (only large buffer)
+ ;; Is there a better solution to know that?
+ ;; If we don't wait `bookmark-default-handler' will have no chance
+ ;; to set position. However there is no error, just wrong pos.
+ (sit-for 1)
+ (when (string= buf "Gnus-art")
+ (other-window 1))
+ (bookmark-default-handler
+ `(""
+ (buffer . ,(current-buffer))
+ . ,(bookmark-get-bookmark-record bookmark)))))
+
(gnus-summary-make-all-marking-commands)
(gnus-ems-redefine)
;; coding: iso-8859-1
;; End:
-;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here
projects / gnus / blobdiff