;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2011 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.
+;; For Emacs <22.2 and XEmacs.
(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)
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
+(autoload 'nnir-article-rsv "nnir" nil nil 'macro)
+(autoload 'nnir-article-group "nnir" nil nil 'macro)
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
: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
"*Non-nil means that Gnus will try to build threads by grabbing old headers.
If an unread article in the group refers to an older, already
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
unread article), `best' (place point on the subject line of the
higest-scored article), `unseen' (place point on the subject line of
the first unseen article), `unseen-or-unread' (place point on the subject
-line of the first unseen article or, if all article have been seen, on the
+line of the first unseen article or, if all articles 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)
(integer :tag "height")
(sexp :menu-tag "both" t)))
-(defvar gnus-auto-center-group t
- "*If non-nil, always center the group buffer.")
+(defcustom gnus-auto-center-group t
+ "If non-nil, always center the group buffer."
+ :group 'gnus-summary-maneuvering
+ :type 'boolean)
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
: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)
+
+(defcustom gnus-widen-article-window nil
+ "If non-nil, selecting the article buffer will display only the article buffer."
+ :version "24.1"
:group 'gnus-article-various
:type 'boolean)
: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, Gnus will store and retrieve marks from the backends.
+This means that marks will be stored both in .newsrc.eld and in
+the backend, and will slow operation down somewhat."
+ :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)
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
+ (?Z (or ,(gnus-macroexpand-all
+ '(nnir-article-rsv (mail-header-number gnus-tmp-header)))
+ 0) ?d)
+ (?G (or ,(gnus-macroexpand-all
+ '(nnir-article-group (mail-header-number gnus-tmp-header)))
+ "") ?s)
+ (?g (or ,(gnus-macroexpand-all
+ '(gnus-group-short-name
+ (nnir-article-group (mail-header-number gnus-tmp-header))))
+ "") ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
(?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.")
(defvar gnus-newsgroup-last-directory nil)
(defvar gnus-newsgroup-auto-expire nil)
(defvar gnus-newsgroup-active nil)
+(defvar gnus-newsgroup-highest nil)
(defvar gnus-newsgroup-data nil)
(defvar gnus-newsgroup-data-reverse nil)
(defvar gnus-summary-local-variables
'(gnus-newsgroup-name
+
+ ;; Marks lists
+ gnus-newsgroup-unreads
+ gnus-newsgroup-unselected
+ gnus-newsgroup-marked
+ gnus-newsgroup-spam-marked
+ gnus-newsgroup-reads
+ gnus-newsgroup-saved
+ gnus-newsgroup-replied
+ gnus-newsgroup-forwarded
+ gnus-newsgroup-recent
+ gnus-newsgroup-expirable
+ gnus-newsgroup-killed
+ gnus-newsgroup-unseen
+ gnus-newsgroup-seen
+ gnus-newsgroup-cached
+ gnus-newsgroup-downloadable
+ gnus-newsgroup-undownloaded
+ gnus-newsgroup-unsendable
+
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-newsgroup-last-folder gnus-newsgroup-last-file
gnus-newsgroup-last-directory
- gnus-newsgroup-auto-expire gnus-newsgroup-unreads
- gnus-newsgroup-unselected gnus-newsgroup-marked
- gnus-newsgroup-spam-marked
- gnus-newsgroup-reads gnus-newsgroup-saved
- gnus-newsgroup-replied gnus-newsgroup-forwarded
- gnus-newsgroup-recent
- gnus-newsgroup-expirable
- gnus-newsgroup-processable gnus-newsgroup-killed
- gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
+ gnus-newsgroup-auto-expire
+ gnus-newsgroup-processable
gnus-newsgroup-unfetched
- gnus-newsgroup-unsendable gnus-newsgroup-unseen
- gnus-newsgroup-seen gnus-newsgroup-articles
+ gnus-newsgroup-articles
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-newsgroup-headers gnus-newsgroup-threads
gnus-newsgroup-prepared gnus-summary-highlight-line-function
gnus-current-article gnus-current-headers gnus-have-all-headers
gnus-last-article gnus-article-internal-prepare-hook
+ (gnus-summary-article-delete-hook . global)
+ (gnus-summary-article-move-hook . global)
gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-thread-expunge-below
(gnus-summary-mark-below . global)
(gnus-orphan-score . global)
gnus-newsgroup-active gnus-scores-exclude-files
+ gnus-newsgroup-highest
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse gnus-newsgroup-process-stack
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
(gnus-newsgroup-expunged-tally . 0)
- gnus-cache-removable-articles gnus-newsgroup-cached
+ gnus-cache-removable-articles
gnus-newsgroup-data gnus-newsgroup-data-reverse
gnus-newsgroup-limit gnus-newsgroup-limits
gnus-newsgroup-charset gnus-newsgroup-display
\"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
")
-;; Byte-compiler warning. Specifically, this is responsible for:
-;; "Warning: the following functions might not be defined at runtime:
-;; gnus-build-sparse-threads, gnus-dead-summary-mode, gnus-summary-mark-below".
(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
+ [tab] gnus-summary-widget-forward
"t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
"e" gnus-summary-end-of-article
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
+ "C" gnus-summary-show-complete-article
"D" gnus-summary-enter-digest-group
"R" gnus-summary-refer-references
"T" gnus-summary-refer-thread
+ "W" gnus-warp-to-article
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
+ [tab] gnus-summary-widget-forward
"P" gnus-summary-print-article
"S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
"a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
"p" gnus-article-verify-x-pgp-sig
"d" gnus-article-treat-dumbquotes
+ "U" gnus-article-treat-non-ascii
"i" gnus-summary-idna-message)
(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
"d" gnus-article-display-face
"s" gnus-treat-smiley
"D" gnus-article-remove-images
+ "W" gnus-article-show-images
"f" gnus-treat-from-picon
"m" gnus-treat-mail-picon
- "n" gnus-treat-newsgroups-picon)
+ "n" gnus-treat-newsgroups-picon
+ "g" gnus-treat-from-gravatar
+ "h" gnus-treat-mail-gravatar)
(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
"w" gnus-article-decode-mime-words
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
- "f" gnus-summary-fetch-faq
"d" gnus-summary-describe-group
"h" gnus-summary-describe-briefly
- "i" gnus-info-find-node
- "c" gnus-group-fetch-charter
- "C" gnus-group-fetch-control)
+ "i" gnus-info-find-node)
(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
"e" gnus-summary-expire-articles
"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]
["Show picons in From" gnus-treat-from-picon t]
["Show picons in mail headers" gnus-treat-mail-picon t]
["Show picons in news headers" gnus-treat-newsgroups-picon t]
+ ["Show Gravatars in From" gnus-treat-from-gravatar t]
+ ["Show Gravatars in mail headers" gnus-treat-mail-gravatar t]
("View as different encoding"
,@(gnus-summary-menu-split
(mapcar
gnus-article-remove-leading-whitespace t])
["Overstrike" gnus-article-treat-overstrike t]
["Dumb quotes" gnus-article-treat-dumbquotes t]
+ ["Non-ASCII" gnus-article-treat-non-ascii t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
["Fill long lines" gnus-article-fill-long-lines 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)
["Set expirable mark" gnus-summary-mark-as-expirable t]
["Set bookmark" gnus-summary-set-bookmark t]
["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Registry Mark"
- ["Important" gnus-registry-set-article-Important-mark t]
- ["Not Important" gnus-registry-remove-article-Important-mark t]
- ["Work" gnus-registry-set-article-Work-mark t]
- ["Not Work" gnus-registry-remove-article-Work-mark t]
- ["Later" gnus-registry-set-article-Later-mark t]
- ["Not Later" gnus-registry-remove-article-Later-mark t]
- ["Personal" gnus-registry-set-article-Personal-mark t]
- ["Not Personal" gnus-registry-remove-article-Personal-mark t]
- ["To Do" gnus-registry-set-article-To-Do-mark t]
- ["Not To Do" gnus-registry-remove-article-To-Do-mark t])
("Limit to"
["Marks..." gnus-summary-limit-to-marks t]
["Subject..." gnus-summary-limit-to-subject 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]
["Randomize" gnus-summary-sort-by-random t]
["Original sort" gnus-summary-sort-by-original t])
("Help"
- ["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
- ["Fetch charter" gnus-group-fetch-charter
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the charter of the current group"))]
- ["Fetch control message" gnus-group-fetch-control
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the archived control message for the current group"))]
["Read manual" gnus-info-find-node t])
("Modes"
["Pick and read" gnus-pick-mode t]
: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'.
(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))
;; Simple nil-valued local variable.
(set (make-local-variable local) nil)))))
-(defun gnus-summary-clear-local-variables ()
- (let ((locals gnus-summary-local-variables))
- (while locals
- (if (consp (car locals))
- (and (symbolp (caar locals))
- (set (caar locals) nil))
- (and (symbolp (car locals))
- (set (car locals) nil)))
- (setq locals (cdr locals)))))
-
;; Summary data functions.
(defmacro gnus-data-number (data)
(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)
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
(setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
(gnus-summary-mode group)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'summary))
(when (gnus-group-quit-config group)
(set (make-local-variable 'gnus-single-article-buffer) nil))
(make-local-variable 'gnus-article-buffer)
(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)
((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
(t (format "%dM" (/ c (* 1024.0 1024)))))))
+(defcustom gnus-summary-user-date-format-alist
+ '(((gnus-seconds-today) . "Today, %H:%M")
+ ((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
+ (604800 . "%A %H:%M") ; That's one week
+ ((gnus-seconds-month) . "%A %d")
+ ((gnus-seconds-year) . "%B %d")
+ (t . "%b %d %Y")) ; This one is used when no other
+ ; does match
+ "Specifies date format depending on age of article.
+This is an alist of items (AGE . FORMAT). AGE can be a number (of
+seconds) or a Lisp expression evaluating to a number. When the age of
+the article is less than this number, then use `format-time-string'
+with the corresponding FORMAT for displaying the date of the article.
+If AGE is not a number or a Lisp expression evaluating to a
+non-number, then the corresponding FORMAT is used as a default value.
+
+Note that the list is processed from the beginning, so it should be
+sorted by ascending AGE. Also note that items following the first
+non-number AGE will be ignored.
+
+You can use the functions `gnus-seconds-today', `gnus-seconds-month'
+and `gnus-seconds-year' in the AGE spec. They return the number of
+seconds passed since the start of today, of this month, of this year,
+respectively."
+ :version "24.1"
+ :group 'gnus-summary-format
+ :type '(alist :key-type sexp :value-type string))
+(make-obsolete-variable 'gnus-user-date-format-alist
+ 'gnus-summary-user-date-format-alist "24.1")
+
+(defun gnus-user-date (messy-date)
+ "Format the messy-date according to `gnus-summary-user-date-format-alist'.
+Returns \" ? \" if there's bad input or if another error occurs.
+Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
+ (condition-case ()
+ (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date)))
+ (now (gnus-float-time))
+ ;;If we don't find something suitable we'll use this one
+ (my-format "%b %d '%y"))
+ (let* ((difference (- now messy-date))
+ (templist gnus-summary-user-date-format-alist)
+ (top (eval (caar templist))))
+ (while (if (numberp top) (< top difference) (not top))
+ (progn
+ (setq templist (cdr templist))
+ (setq top (eval (caar templist)))))
+ (if (stringp (cdr (car templist)))
+ (setq my-format (cdr (car templist)))))
+ (format-time-string (eval my-format) (seconds-to-time messy-date)))
+ (error " ? ")))
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
- (let ((vars '(quit-config))) ; Ignore quit-config.
+ (let ((vars '(quit-config active))) ; Ignore things that aren't
+ ; really variables.
(dolist (elem (gnus-group-find-parameter group))
(and (consp elem) ; Has to be a cons.
(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
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(gnus-handle-ephemeral-exit quit-config)))
- (let ((grpinfo (gnus-get-info group)))
- (if (null (gnus-info-read grpinfo))
- (gnus-message 3 "Group %s contains no messages"
- (gnus-group-decoded-name group))
- (gnus-message 3 "Can't select group")))
+ (if (null (gnus-list-of-unread-articles group))
+ (gnus-message 3 "Group %s contains no messages" group)
+ (gnus-message 3 "Can't select group"))
nil)
;; The user did a `C-g' while prompting for number of articles,
;; so we exit this group.
(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.
(setq gnus-newsgroup-active
(gnus-copy-sequence
(gnus-active gnus-newsgroup-name)))
+ (setq gnus-newsgroup-highest (cdr gnus-newsgroup-active))
;; You can change the summary buffer in some way with this hook.
(gnus-run-hooks 'gnus-select-group-hook)
(when (memq 'summary (gnus-update-format-specifications
;; gnus-summary-prepare-hook since kill processing may not
;; work with hidden articles.
(gnus-summary-maybe-hide-threads)
+ (gnus-configure-windows 'summary)
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
(gnus-summary-auto-select-subject)
gnus-newsgroup-unreads
gnus-auto-select-first)
(progn
- (gnus-configure-windows 'summary)
(let ((art (gnus-summary-article-number)))
(unless (and (not gnus-plugged)
(or (memq art gnus-newsgroup-undownloaded)
(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)
(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))
(ignore-errors
(setq article (read (current-buffer))
- header (gnus-nov-parse-line article dependencies)))
+ header (gnus-nov-parse-line article dependencies t)))
(when header
(with-current-buffer gnus-summary-buffer
(push header gnus-newsgroup-headers)
(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"))))
(t
(gnus-thread-total-score-1 (list thread)))))
+(defun gnus-article-sort-by-most-recent-number (h1 h2)
+ "Sort articles by number."
+ (gnus-article-sort-by-number h1 h2))
+
(defun gnus-thread-sort-by-most-recent-number (h1 h2)
"Sort threads such that the thread with the most recently arrived article comes first."
(> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
(mail-header-number header))
(message-flatten-list thread))))
+(defun gnus-article-sort-by-most-recent-date (h1 h2)
+ "Sort articles by number."
+ (gnus-article-sort-by-date h1 h2))
+
(defun gnus-thread-sort-by-most-recent-date (h1 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 ...]...) ...])'
(if (= gnus-tmp-lines -1)
(setq gnus-tmp-lines "?")
(setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number number)
+ 'gnus-number number)
(when gnus-visual-p
(forward-line -1)
- (gnus-run-hooks 'gnus-summary-update-hook)
+ (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)))
(substring subject (match-end 1)))))
(mail-header-set-subject header subject))))))
-(defun gnus-fetch-headers (articles)
+(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
"Fetch headers of ARTICLES."
(let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
(gnus-message 5 "Fetching headers for %s..." name)
(setq gnus-headers-retrieved-by
(gnus-retrieve-headers
articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
+ (or limit
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers)))))
(gnus-get-newsgroup-headers-xover
- articles nil nil gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers))
+ articles force-new dependencies gnus-newsgroup-name t)
+ (gnus-get-newsgroup-headers dependencies force-new))
(gnus-message 5 "Fetching headers for %s...done" name))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
(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 gnus-agent
+ (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 (and gnus-agent
+ (gnus-active group))
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(setq gnus-summary-use-undownloaded-faces
(setq gnus-newsgroup-processable nil)
- (gnus-update-read-articles group gnus-newsgroup-unreads)
+ (gnus-update-read-articles group gnus-newsgroup-unreads t)
;; Adjust and set lists of article marks.
(when info
(unseen . unseen))
gnus-article-mark-lists))
(push (cons (cdr elem)
- (gnus-byte-compile
+ (gnus-byte-compile ;Why bother?
`(lambda () (gnus-article-marked-p ',(cdr elem)))))
gnus-summary-display-cache)))
(let ((gnus-category-predicate-alist gnus-summary-display-cache)
(gnus-category-predicate-cache gnus-summary-display-cache))
(gnus-get-predicate display)))
-;; Uses the dynamically bound `number' variable.
-(defvar number)
+;; Uses the dynamically bound `gnus-number' variable.
+(defvar gnus-number)
(defun gnus-article-marked-p (type &optional article)
- (let ((article (or article number)))
+ (let ((article (or article gnus-number)))
(cond
((eq type 'tick)
(memq article gnus-newsgroup-marked))
(types gnus-article-mark-lists)
marks var articles article mark mark-type
bgn end)
+ ;; Hack to avoid adjusting marks for imap.
+ (when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
+ 'nnimap)
+ (setq min 1))
(dolist (marks marked-lists)
(setq mark (car marks)
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
+ ;; Don't delete marks from outside the active range. This
+ ;; shouldn't happen, but is a sanity check.
+ (setq del (gnus-sorted-range-intersection
+ (gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
(when list
(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
(info (nth 2 entry))
(active (gnus-active group))
range)
- (when entry
+ (if (not entry)
+ ;; Group that Gnus doesn't know exists, but still allow the
+ ;; backend to set marks.
+ (gnus-request-set-mark
+ group (list (list (gnus-compress-sequence (sort articles #'<))
+ 'add '(read))))
+ ;; Normal, subscribed groups.
(setq range (gnus-compute-read-articles group articles))
(with-current-buffer gnus-group-buffer
(gnus-undo-register
(unless (gnus-ephemeral-group-p group)
(gnus-group-update-group group t))))))
-(defvar gnus-newsgroup-none-id 0)
-
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(let ((cur nntp-server-buffer)
(dependencies
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))))
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
- "Reconfigure windows to show article buffer."
+ "Reconfigure windows to show the article buffer.
+If `gnus-widen-article-buffer' is set, show only the article
+buffer."
(interactive)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(error "There is no article buffer for this summary buffer")
- (gnus-configure-windows 'article)
+ (unless (get-buffer-window gnus-article-buffer)
+ (gnus-summary-show-article))
+ (gnus-configure-windows
+ (if gnus-widen-article-window
+ 'only-article
+ 'article)
+ t)
(select-window (get-buffer-window gnus-article-buffer))))
(defun gnus-summary-universal-argument (arg)
(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
(interactive "P")
- (gnus-summary-reselect-current-group all t))
+ (let ((config gnus-current-window-configuration))
+ (gnus-summary-reselect-current-group all t)
+ (gnus-configure-windows config)
+ (when (eq config 'article)
+ (gnus-summary-select-article))))
(defun gnus-summary-update-info (&optional non-destructive)
(save-excursion
(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)
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(gnus-group-is-exiting-p t)
+ (article-buffer gnus-article-buffer)
(mode major-mode)
(group-point nil)
(buf (current-buffer)))
(when gnus-use-scoring
(gnus-score-save)))
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- ;; Don't kill sticky article buffers
- (unless (eq major-mode 'gnus-sticky-article-mode)
- (gnus-kill-buffer gnus-article-buffer)
- (setq gnus-article-current nil))))
- (gnus-kill-buffer gnus-original-article-buffer))
(when gnus-use-cache
(gnus-cache-possibly-remove-articles)
(gnus-cache-save-buffers))
(progn
(gnus-deaden-summary)
(setq mode nil))
- ;; We set all buffer-local variables to nil. It is unclear why
- ;; this is needed, but if we don't, buffer-local variables are
- ;; not garbage-collected, it seems. This would the lead to en
- ;; ever-growing Emacs.
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
+
(setq gnus-current-select-method gnus-select-method)
(set-buffer gnus-group-buffer)
(if quit-config
(if win (set-window-point win (point))))
(unless leave-hidden
(gnus-configure-windows 'group 'force)))
+
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (when (gnus-buffer-live-p article-buffer)
+ (with-current-buffer article-buffer
+ ;; Don't kill sticky article buffers
+ (unless (eq major-mode 'gnus-sticky-article-mode)
+ (gnus-kill-buffer article-buffer)
+ (setq gnus-article-current nil))))
+ (gnus-kill-buffer gnus-original-article-buffer))
+
;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name 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)
(gnus-kill-buffer gnus-article-buffer)
(gnus-kill-buffer gnus-original-article-buffer)
(setq gnus-article-current nil))
+ ;; Return to the group buffer.
+ (gnus-configure-windows 'group 'force)
(if (not gnus-kill-summary-on-exit)
(gnus-deaden-summary)
(gnus-close-group group)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
(gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(gnus-async-prefetch-remove-group group)
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
- ;; Return to the group buffer.
- (gnus-configure-windows 'group 'force)
;; Clear the current group name.
(setq gnus-newsgroup-name nil)
(unless (gnus-ephemeral-group-p group)
(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)
t)))
(gnus-message 3 "This dead summary is now alive again"))
-;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
-(defun gnus-summary-fetch-faq (&optional faq-dir)
- "Fetch the FAQ for the current group.
-If FAQ-DIR (the prefix), prompt for a directory to search for the faq
-in."
- (interactive
- (list
- (when current-prefix-arg
- (completing-read
- "FAQ dir: " (and (listp gnus-group-faq-directory)
- (mapcar 'list
- gnus-group-faq-directory))))))
- (let (gnus-faq-buffer)
- (when (setq gnus-faq-buffer
- (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
- (gnus-configure-windows 'summary-faq))))
-
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-summary-describe-group (&optional force)
"Describe the current newsgroup."
(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)
(null (get-buffer gnus-article-buffer))
(not (eq article (cdr gnus-article-current)))
(not (equal (car gnus-article-current)
- gnus-newsgroup-name))))
+ gnus-newsgroup-name))
+ (not (get-buffer gnus-original-article-buffer))))
(and (not gnus-single-article-buffer)
(or (null gnus-current-article)
+ (not (get-buffer gnus-original-article-buffer))
(not (eq gnus-current-article article))))
force)
;; The requested article is different from the current article.
(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)))
+ (current-summary (current-buffer))
(group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(gnus-summary-search-group backward gnus-keep-same-level))))
- ;; For some reason, the group window gets selected. We change
- ;; it back.
- (select-window (get-buffer-window (current-buffer)))
;; Select next unread newsgroup automagically.
(cond
((or (not gnus-auto-select-next)
(gnus-summary-next-group nil group backward)))
(t
(when (gnus-key-press-event-p last-input-event)
+ ;; Somehow or other, we may now have selected a different
+ ;; window. Make point go back to the summary buffer.
+ (when (eq current-summary (current-buffer))
+ (select-window (get-buffer-window current-summary)))
(gnus-summary-walk-group-buffer
gnus-newsgroup-name cmd unread backward 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)
(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))
(defun gnus-summary-scroll-up (lines)
"Scroll up (or down) one line current article.
-Argument LINES specifies lines to be scrolled up (or down if negative)."
+Argument LINES specifies lines to be scrolled up (or down if negative).
+If no article is selected, then the current article will be selected first."
(interactive "p")
(gnus-configure-windows 'article)
(gnus-summary-show-thread)
(defun gnus-summary-scroll-down (lines)
"Scroll down (or up) one line current article.
-Argument LINES specifies lines to be scrolled down (or up if negative)."
+Argument LINES specifies lines to be scrolled down (or up if negative).
+If no article is selected, then the current article will be selected first."
(interactive "p")
(gnus-summary-scroll-up (- lines)))
(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
is a number, it is the line the article is to be displayed on."
(interactive
(list
- (completing-read
- "Article number or Message-ID: "
- (mapcar (lambda (number) (list (int-to-string number)))
- gnus-newsgroup-limit))
+ (gnus-completing-read
+ "Article number or Message-ID"
+ (mapcar 'int-to-string gnus-newsgroup-limit))
current-prefix-arg
t))
(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
(interactive
(let ((header
(intern
- (gnus-completing-read-with-default
- (symbol-name (car gnus-extra-headers))
+ (gnus-completing-read
(if current-prefix-arg
"Exclude extra header"
"Limit extra header")
- (mapcar (lambda (x)
- (cons (symbol-name x) x))
- gnus-extra-headers)
- nil
- t))))
+ (mapcar 'symbol-name gnus-extra-headers)
+ t nil nil
+ (symbol-name (car gnus-extra-headers))))))
(list header
(read-string (format "%s header %s (regexp): "
(if current-prefix-arg "Exclude" "Limit to")
(unless gnus-newsgroup-display
(error "There is no `display' group parameter"))
(let (articles)
- (dolist (number gnus-newsgroup-articles)
+ (dolist (gnus-number gnus-newsgroup-articles)
(when (funcall gnus-newsgroup-display)
- (push number articles)))
+ (push gnus-number articles)))
(gnus-summary-limit articles))
(gnus-summary-position-point))
-(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)
-
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
If ALL is non-nil, limit strictly to unread articles."
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
(gnus-summary-limit gnus-newsgroup-replied))
(gnus-summary-position-point))
-(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
-(make-obsolete 'gnus-summary-delete-marked-with
- 'gnus-summary-limit-exclude-marks)
-
(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
"Exclude articles that are marked with MARKS (e.g. \"DK\").
If REVERSE, limit the summary buffer to articles that are marked
article."
(interactive (list (mail-header-id (gnus-summary-article-header))))
(let ((articles (gnus-articles-in-thread
- (gnus-id-to-thread (gnus-root-id id)))))
+ (gnus-id-to-thread (gnus-root-id id))))
+ ;;we REALLY want the whole thread---this prevents cut-threads
+ ;;from removing the thread we want to include.
+ (gnus-fetch-old-headers nil)
+ (gnus-build-sparse-threads nil))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
(gnus-summary-limit-include-matching-articles
(gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
(gnus-summary-position-point)))
+(defun gnus-summary-include-articles (articles)
+ "Fetch the headers for ARTICLES and then display the summary lines."
+ (let ((gnus-inhibit-demon t)
+ (gnus-agent nil)
+ (gnus-read-all-available-headers t))
+ (setq gnus-newsgroup-headers
+ (gnus-merge
+ 'list gnus-newsgroup-headers
+ (gnus-fetch-headers articles nil t)
+ 'gnus-article-sort-by-number))
+ (gnus-summary-limit (append articles gnus-newsgroup-limit))))
+
(defun gnus-summary-limit-exclude-dormant ()
"Hide all dormant articles."
(interactive)
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)))
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit nil)
(mapatoms
(apply '+ (mapcar 'gnus-summary-limit-children
(cdr thread)))
0))
- (number (mail-header-number (car thread)))
- score)
+ (number (mail-header-number (car thread)))
+ score)
(if (and
(not (memq number gnus-newsgroup-marked))
(or
t)
;; Do the `display' group parameter.
(and gnus-newsgroup-display
- (not (funcall gnus-newsgroup-display)))
- ;; Check NoCeM things.
- (when (and gnus-use-nocem
- (gnus-nocem-unwanted-article-p
- (mail-header-id (car thread))))
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- t)))
+ (let ((gnus-number number))
+ (not (funcall gnus-newsgroup-display))))))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
;; 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"))
(defun gnus-summary-refer-thread (&optional limit)
"Fetch all articles in the current thread.
-If LIMIT (the numerical prefix), fetch that many old headers instead
-of what's specified by the `gnus-refer-thread-limit' variable."
+If no backend-specific 'request-thread function is available
+fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil
+fetch what's specified by the `gnus-refer-thread-limit'
+variable."
(interactive "P")
- (let ((id (mail-header-id (gnus-summary-article-header)))
- (limit (if limit (prefix-numeric-value limit)
- gnus-refer-thread-limit)))
- (unless (eq gnus-fetch-old-headers 'invisible)
- (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
- ;; Retrieve the headers and read them in.
- (if (eq (if (numberp limit)
- (gnus-retrieve-headers
- (list (min
- (+ (mail-header-number
- (gnus-summary-article-header))
- limit)
- gnus-newsgroup-end))
- gnus-newsgroup-name (* limit 2))
- ;; gnus-refer-thread-limit is t, i.e. fetch _all_
- ;; headers.
- (gnus-retrieve-headers (list gnus-newsgroup-end)
- gnus-newsgroup-name limit))
- 'nov)
- (gnus-build-all-threads)
- (error "Can't fetch thread from back ends that don't support NOV"))
- (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
+ (gnus-warp-to-article)
+ (let* ((header (gnus-summary-article-header))
+ (id (mail-header-id header))
+ (gnus-inhibit-demon t)
+ (gnus-summary-ignore-duplicates t)
+ (gnus-read-all-available-headers t)
+ (limit (if limit (prefix-numeric-value limit)
+ gnus-refer-thread-limit)))
+ (setq gnus-newsgroup-headers
+ (gnus-merge
+ 'list gnus-newsgroup-headers
+ (if (gnus-check-backend-function
+ 'request-thread gnus-newsgroup-name)
+ (gnus-request-thread header)
+ (let* ((last (if (numberp limit)
+ (min (+ (mail-header-number header)
+ limit)
+ gnus-newsgroup-highest)
+ gnus-newsgroup-highest))
+ (subject (gnus-simplify-subject
+ (mail-header-subject header)))
+ (refs (split-string (or (mail-header-references header)
+ "")))
+ (gnus-parse-headers-hook
+ (lambda () (goto-char (point-min))
+ (keep-lines
+ (regexp-opt (append refs (list id subject)))))))
+ (gnus-fetch-headers (list last) (if (numberp limit)
+ (* 2 limit) limit) t)))
+ 'gnus-article-sort-by-number))
(gnus-summary-limit-include-thread id)))
(defun gnus-summary-refer-article (message-id)
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
-If FORCE, force a digest interpretation. If not, try
-to guess what the document format is."
+If FORCE, force a digest interpretation. If not, try to guess
+what the document format is.
+
+To control what happens when you exit the group, see the
+`gnus-auto-select-on-ephemeral-exit' variable."
(interactive "P")
(let ((conf gnus-current-window-configuration))
(save-window-excursion
(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))
(t
(error "Couldn't select virtual nndoc group")))))
+(defun gnus-summary-widget-forward (arg)
+ "Move point to the next field or button in the article.
+With optional ARG, move across that many fields."
+ (interactive "p")
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (select-window (gnus-get-buffer-window gnus-article-buffer))
+ (widget-forward arg))
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
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)
article. If BACKWARD (the prefix) is non-nil, search backward instead."
(interactive
(list (let ((completion-ignore-case t))
- (completing-read
- "Header name: "
- (mapcar (lambda (header) (list (format "%s" header)))
+ (gnus-completing-read
+ "Header name"
+ (mapcar 'symbol-name
(append
- '("Number" "Subject" "From" "Lines" "Date"
- "Message-ID" "Xref" "References" "Body")
+ '(Number Subject From Lines Date
+ Message-ID Xref References Body)
gnus-extra-headers))
- nil 'require-match))
+ 'require-match))
(read-string "Regexp: ")
(read-key-sequence "Command: ")
current-prefix-arg))
(ps-despool filename))
(defun gnus-print-buffer ()
- (let ((buffer (generate-new-buffer " *print*")))
+ (let ((ps-left-header
+ (list
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-subject gnus-current-headers)
+ 66) ")")
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-from gnus-current-headers)
+ 45) ")")))
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
+ (concat "("
+ (mail-header-date gnus-current-headers) ")"))))
+ (gnus-run-hooks 'gnus-ps-print-hook)
+ (save-excursion
+ (if ps-print-color-p
+ (ps-spool-buffer-with-faces)
+ (ps-spool-buffer)))))
+
+(defun gnus-summary-show-complete-article ()
+ "Show a complete version of the current article.
+This is only useful if you're looking at a partial version of the
+article currently."
+ (interactive)
+ (let ((gnus-keep-backlog nil)
+ (gnus-use-cache nil)
+ (gnus-agent nil)
+ (variable (intern
+ (format "%s-fetch-partial-articles"
+ (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))
+ obarray))
+ old-val)
(unwind-protect
(progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-remove-text-with-property 'gnus-decoration)
- (when (gnus-visual-p 'article-highlight 'highlight)
- ;; Copy-to-buffer doesn't copy overlay. So redo
- ;; highlight.
- (let ((gnus-article-buffer buffer))
- (gnus-article-highlight-citation t)
- (gnus-article-highlight-signature)
- (gnus-article-emphasize)
- (gnus-article-delete-invisible-text)))
- (let ((ps-left-header
- (list
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-subject gnus-current-headers)
- 66) ")")
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-from gnus-current-headers)
- 45) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
- (concat "("
- (mail-header-date gnus-current-headers) ")"))))
- (gnus-run-hooks 'gnus-ps-print-hook)
- (save-excursion
- (if ps-print-color-p
- (ps-spool-buffer-with-faces)
- (ps-spool-buffer)))))
- (kill-buffer buffer))))
+ (setq old-val (symbol-value variable))
+ (set variable nil)
+ (gnus-flush-original-article-buffer)
+ (gnus-summary-show-article))
+ (set variable old-val))))
(defun gnus-summary-show-article (&optional arg)
"Force redisplaying of the current article.
If ARG (the prefix) is a number, show the article with the charset
defined in `gnus-summary-show-article-charset-alist', or the charset
input.
-If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run. Normally, the key
-strokes are `C-u g'."
+If ARG (the prefix) is non-nil and not a number, show the article,
+but without running any of the article treatment functions
+article. Normally, the keystroke is `C-u g'. When using `C-u
+C-u g', show the raw article."
(interactive "P")
(cond
((numberp arg)
(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))
((not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force))
+ ((equal arg '(16))
+ ;; C-u C-u g
+ (let ((gnus-inhibit-article-treatments t))
+ (gnus-summary-select-article nil 'force)))
(t
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
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))
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))))
articles)
(while articles
(setq article (pop articles))
+ ;; Set any marks that may have changed in the summary buffer.
+ (when gnus-preserve-marks
+ (gnus-summary-push-marks-to-backend article))
(setq
art-group
(cond
gnus-newsgroup-name))
(to-method (or select-method
(gnus-find-method-for-group to-newsgroup)))
- (move-is-internal (gnus-method-equal from-method to-method)))
+ (move-is-internal (gnus-server-equal from-method to-method)))
(gnus-request-move-article
article ; Article to move
- gnus-newsgroup-name ; From newsgroup
+ gnus-newsgroup-name ; From newsgroup
(nth 1 (gnus-find-method-for-group
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
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
+ to-newsgroup ; Not respooling
+ ; Is this move internal?
+ (gnus-group-real-name to-newsgroup)))))
;; Copy the article.
((eq action 'copy)
- (save-excursion
- (set-buffer copy-buf)
- (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (with-current-buffer copy-buf
+ (when (gnus-request-article-this-buffer article
+ gnus-newsgroup-name)
(save-restriction
(nnheader-narrow-to-headers)
(dolist (hdr gnus-copy-article-ignored-headers)
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
- (mail-header-xref (gnus-summary-article-header article))
+ (mail-header-xref (gnus-summary-article-header
+ article))
" ")))
(setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
":" (number-to-string article)))
(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
(gnus-request-accept-article
- to-newsgroup select-method (not articles) t)))
+ to-newsgroup select-method (not articles)
+ t)))
(setq new-xref (concat new-xref " " (car art-group)
":"
(number-to-string (cdr art-group))))
(unless (member to-group to-groups)
(push to-group to-groups))
- (unless (memq article gnus-newsgroup-unreads)
+ (when (and (not (memq article gnus-newsgroup-unreads))
+ (cdr art-group))
(push 'read to-marks)
(gnus-info-set-read
info (gnus-add-to-range (gnus-info-read info)
(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.
- (when gnus-use-cache
+ (when (and to-article
+ gnus-use-cache)
(gnus-cache-possibly-enter-article
to-group to-article
(memq article gnus-newsgroup-marked)
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))
- (when gnus-preserve-marks
+ (when (and gnus-preserve-marks
+ to-article)
;; Copy any marks over to the new group.
(when (and (equal to-group gnus-newsgroup-name)
(not (memq article gnus-newsgroup-unreads)))
;; Mark this article as read in this group.
- (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+ (push (cons to-article gnus-read-mark)
+ gnus-newsgroup-reads)
+ ;; Increase the active status of this group.
(setcdr (gnus-active to-group) to-article)
(setcdr gnus-newsgroup-active to-article))
;; If the other group is the same as this group,
;; then we have to add the mark to the list.
(when (equal to-group gnus-newsgroup-name)
- (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (set (intern (format "gnus-newsgroup-%s"
+ (caar marks)))
(cons to-article
(symbol-value
(intern (format "gnus-newsgroup-%s"
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
to-newsgroup
select-method))
- ;;;!!!Why is this necessary?
+ ;;;!!!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)))
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
+(defun gnus-summary-push-marks-to-backend (article)
+ (let ((set nil)
+ (marks gnus-article-mark-lists))
+ (unless (memq article gnus-newsgroup-unreads)
+ (push 'read set))
+ (while marks
+ (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+ (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks))))))
+ (push (cdar marks) set))
+ (pop marks))
+ (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set)))))
+
(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
"Copy the current article to some other group.
If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
: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,
latter case, they will be copied into the relevant groups."
(interactive
(list current-prefix-arg
- (let* ((methods (gnus-methods-using 'respool))
+ (let* ((methods (mapcar #'car (gnus-methods-using 'respool)))
(methname
(symbol-name (or gnus-summary-respool-default-method
(car (gnus-find-method-for-group
gnus-newsgroup-name)))))
(method
- (gnus-completing-read-with-default
- methname "Backend to use when respooling"
- methods nil t nil 'gnus-mail-method-history))
+ (gnus-completing-read
+ "Backend to use when respooling"
+ methods t nil 'gnus-mail-method-history methname))
ms)
(cond
((zerop (length (setq ms (gnus-servers-using-backend
(car ms))
(t
(let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
- (cdr (assoc (completing-read "Server name: " ms-alist nil t)
+ (cdr (assoc (gnus-completing-read "Server name" ms-alist t)
ms-alist))))))))
(unless method
(error "No method given for respooling"))
(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)
"Make edits to the current article permanent."
(interactive)
(save-excursion
- ;; The buffer restriction contains the entire article if it exists.
+ ;; The buffer restriction contains the entire article if it exists.
(when (article-goto-body)
(let ((lines (count-lines (point) (point-max)))
(length (- (point-max) (point)))
(delete-region (match-beginning 1) (match-end 1))
(insert (number-to-string lines))))))
;; Replace the article.
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ (article (cdr gnus-article-current))
+ replace-result)
(with-temp-buffer
(insert-buffer-substring buf)
-
(if (and (not read-only)
- (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer) t)))
+ (not (setq replace-result
+ (gnus-request-replace-article
+ article (car gnus-article-current)
+ (current-buffer) t))))
(error "Couldn't replace article")
+ ;; If we got a number back, then that's the new article number
+ ;; for this article. Otherwise, the article number didn't change.
+ (when (numberp replace-result)
+ (with-current-buffer gnus-summary-buffer
+ (setq gnus-newsgroup-limit (delq article gnus-newsgroup-limit))
+ (gnus-summary-limit gnus-newsgroup-limit)
+ (setq article replace-result)
+ (gnus-summary-goto-subject article t)))
;; Update the summary buffer.
(if (and references
(equal (message-tokenize-header references " ")
(point-min) (point-max)))
header)
(with-temp-buffer
- (insert (format "211 %d Article retrieved.\n"
- (cdr gnus-article-current)))
+ (insert (format "211 %d Article retrieved.\n" article))
(insert head)
(insert ".\n")
(let ((nntp-server-buffer (current-buffer)))
- (setq header (car (gnus-get-newsgroup-headers
- nil t))))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-data-set-header
- (gnus-data-find (cdr gnus-article-current))
- header)
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header)
- (if (gnus-summary-goto-subject
- (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))))))
+ (setq header (car (gnus-get-newsgroup-headers nil t))))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-data-set-header (gnus-data-find article) header)
+ (gnus-summary-update-article-line article header)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))))))
;; Update threads.
(set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current))
- (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))
+ (gnus-summary-update-article article)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))
;; Prettify the article buffer again.
(unless no-highlight
- (save-excursion
- (set-buffer gnus-article-buffer)
- ;;;!!! Fix this -- article should be rehighlighted.
- ;;;(gnus-run-hooks 'gnus-article-display-hook)
+ (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)
(gnus-request-article
- (cdr gnus-article-current)
- (car gnus-article-current) (current-buffer))))
+ article (car gnus-article-current) (current-buffer))))
;; Prettify the summary buffer line.
(when (gnus-visual-p 'summary-highlight 'highlight)
(gnus-run-hooks 'gnus-visual-mark-article-hook))))))
(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))))))
(not (equal gnus-newsgroup-name (car gnus-article-current))))
(error "No current article selected"))
;; Remove old bookmark, if one exists.
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
;; Set the new bookmark, which is on the form
;; (article-number . line-number-in-body).
(push
;; Remove old bookmark, if one exists.
(if (not (assq article gnus-newsgroup-bookmarks))
(gnus-message 6 "No bookmark in current article.")
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
(gnus-message 6 "Removed bookmark.")))
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads
article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
;; See whether the article is to be put in the cache.
(and gnus-use-cache
(= 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
(t
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
t)))
-(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)
(defun gnus-summary-tick-article-forward (n)
"Tick N articles forwards.
If N is negative, tick backwards instead.
(interactive "p")
(gnus-summary-mark-forward n gnus-ticked-mark))
-(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)
(defun gnus-summary-tick-article-backward (n)
"Tick N articles backwards.
The difference between N and the number of articles ticked is returned."
(interactive "p")
(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)
(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.
(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
(mail-header-subject (gnus-data-header (car data)))))
(t nil)))
(end-point (save-excursion
+ (goto-char (gnus-data-pos (car data)))
(if (gnus-summary-go-to-next-thread)
(point) (point-max))))
articles)
(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 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))
+(defsubst gnus-summary--inv (p)
+ (and (eq (get-char-property p 'invisible) 'gnus-sum) p))
+
(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))
+ (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
+ ;; Leave point at bol
+ (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
+ (eoi (when end
+ (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))
(nreverse split-name)))
(defun gnus-valid-move-group-p (group)
- (and (boundp group)
+ (and (symbolp group)
+ (boundp group)
(symbol-name group)
(symbol-value group)
(gnus-get-function (gnus-find-method-for-group
(format "these %d articles" (length articles))
"this article")))
(to-newsgroup
- (let (active group)
- (when (or (null split-name) (= 1 (length split-name)))
- (setq active (gnus-make-hashtable (length gnus-active-hashtb)))
- (mapatoms (lambda (symbol)
- (setq group (symbol-name symbol))
- (when (string-match "[^\000-\177]" group)
- (setq group (gnus-group-decoded-name group)))
- (set (intern group active) group))
- gnus-active-hashtb))
- (cond
- ((null split-name)
- (gnus-completing-read-with-default
- default prom active 'gnus-valid-move-group-p nil prefix
- 'gnus-group-history))
- ((= 1 (length split-name))
- (gnus-completing-read-with-default
- (car split-name) prom active 'gnus-valid-move-group-p nil nil
- 'gnus-group-history))
- (t
- (gnus-completing-read-with-default
- nil prom (mapcar 'list (nreverse split-name)) nil nil nil
- 'gnus-group-history)))))
- (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
+ (cond
+ ((null split-name)
+ (gnus-group-completing-read
+ prom
+ (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
+ nil prefix nil default))
+ ((= 1 (length split-name))
+ (gnus-group-completing-read
+ prom
+ (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
+ nil prefix 'gnus-group-history (car split-name)))
+ (t
+ (gnus-completing-read
+ prom (nreverse split-name) nil nil 'gnus-group-history))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
encoded)
(when to-newsgroup
(if (or (string= to-newsgroup "")
gnus-summary-save-parts-default-mime)
'gnus-summary-save-parts-type-history)
(setq gnus-summary-save-parts-last-directory
- (read-file-name "Save to directory: "
- gnus-summary-save-parts-last-directory
- nil t))
+ (read-directory-name "Save to directory: "
+ gnus-summary-save-parts-last-directory
+ nil t))
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)
(interactive)
(prog1
(let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
- (old-active gnus-newsgroup-active)
+ (old-high gnus-newsgroup-highest)
(nnmail-fetched-sources (list t))
i new)
(setq gnus-newsgroup-active
- (gnus-activate-group gnus-newsgroup-name 'scan))
- (setq i (cdr gnus-newsgroup-active))
- (while (> i (cdr old-active))
+ (gnus-copy-sequence
+ (gnus-activate-group gnus-newsgroup-name 'scan)))
+ (setq i (cdr gnus-newsgroup-active)
+ gnus-newsgroup-highest i)
+ (while (> i old-high)
(push i new)
(decf i))
(if (not new)
(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