;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-group)
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode. If the value is neither nil
-nor t, Gnus will select the following unread newsgroup. In
+summary mode and go back to group mode. If the value is neither nil
+nor t, Gnus will select the following unread newsgroup. In
particular, if the value is the symbol `quietly', the next unread
newsgroup will be selected without any confirmation, and if it is
`almost-quietly', the next group will be selected without any
confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `Z n' command
+Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
will go to the next group without confirmation."
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "off" nil)
:group 'gnus-summary-maneuvering
:type 'boolean)
+(defcustom gnus-auto-goto-ignores 'unfetched
+ "*Says how to handle unfetched articles when maneuvering.
+
+This variable can either be the symbols `nil' (maneuver to any
+article), `undownloaded' (maneuvering while unplugged ignores articles
+that have not been fetched), `always-undownloaded' (maneuvering always
+ignores articles that have not been fetched), `unfetched' (maneuvering
+ignores articles whose headers have not been fetched).
+
+NOTE: The list of unfetched articles will always be nil when plugged
+and, when unplugged, a subset of the undownloaded article list."
+ :group 'gnus-summary-maneuvering
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Undownloaded when unplugged" undownloaded)
+ (const :tag "Undownloaded" always-undownloaded)
+ (const :tag "Unfetched" unfetched)))
+
(defcustom gnus-summary-check-current nil
"*If non-nil, consider the current article when moving.
The \"unread\" movement commands will stay on the same line if the
(integer :tag "height")
(sexp :menu-tag "both" t)))
+(defvar gnus-auto-center-group t
+ "*If non-nil, always center the group buffer.")
+
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
:group 'gnus-article-hiding
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-spam-mark ?H
+(defcustom gnus-spam-mark ?$
"*Mark used for spam articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary
:type 'hook)
+(defcustom gnus-summary-article-move-hook nil
+ "*A hook called after an article is moved, copied, respooled, or crossposted."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-delete-hook nil
+ "*A hook called after an article is deleted."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-expire-hook nil
+ "*A hook called after an article is expired."
+ :group 'gnus-summary
+ :type 'hook)
+
(defcustom gnus-summary-display-arrow
(and (fboundp 'display-graphic-p)
(display-graphic-p))
integer))
(defcustom gnus-summary-save-parts-default-mime "image/.*"
- "*A regexp to match MIME parts when saving multiple parts of a message
-with gnus-summary-save-parts (X m). This regexp will be used by default
-when prompting the user for which type of files to save."
+ "*A regexp to match MIME parts when saving multiple parts of a
+message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
+This regexp will be used by default when prompting the user for which
+type of files to save."
:group 'gnus-summary
:type 'regexp)
the MIME-Version header is missed."
:version "21.3"
:type 'boolean
- :group 'gnus-article)
+ :group 'gnus-article-mime)
(defcustom gnus-article-emulate-mime t
"If non-nil, use MIME emulation for uuencode and the like.
like uuencoded bits, yEncoded bits, and so on, and present that using
the normal Gnus MIME machinery."
:type 'boolean
- :group 'gnus-article)
+ :group 'gnus-article-mime)
;;; Internal variables
(defvar gnus-newsgroup-downloadable nil
"Sorted list of articles in the current newsgroup that can be processed.")
+(defvar gnus-newsgroup-unfetched nil
+ "Sorted list of articles in the current newsgroup whose headers have
+not been fetched into the agent.
+
+This list will always be a subset of gnus-newsgroup-undownloaded.")
+
(defvar gnus-newsgroup-undownloaded nil
- "List of articles in the current newsgroup that haven't been downloaded..")
+ "List of articles in the current newsgroup that haven't been downloaded.")
(defvar gnus-newsgroup-unsendable nil
"List of articles in the current newsgroup that won't be sent.")
(defvar gnus-article-before-search nil)
-(defconst gnus-summary-local-variables
+(defvar gnus-summary-local-variables
'(gnus-newsgroup-name
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
+ gnus-newsgroup-unfetched
gnus-newsgroup-unsendable gnus-newsgroup-unseen
gnus-newsgroup-seen gnus-newsgroup-articles
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
")
;; Byte-compiler warning.
-;(eval-when-compile (defvar gnus-article-mode-map))
(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-agent)
(require 'gnus-art)))
(defun gnus-simplify-whitespace (str)
"Remove excessive whitespace from STR."
- (let ((mystr str))
- ;; Multiple spaces.
- (while (string-match "[ \t][ \t]+" mystr)
- (setq mystr (concat (substring mystr 0 (match-beginning 0))
- " "
- (substring mystr (match-end 0)))))
- ;; Leading spaces.
- (when (string-match "^[ \t]+" mystr)
- (setq mystr (substring mystr (match-end 0))))
- ;; Trailing spaces.
- (when (string-match "[ \t]+$" mystr)
- (setq mystr (substring mystr 0 (match-beginning 0))))
- mystr))
+ ;; Multiple spaces.
+ (while (string-match "[ \t][ \t]+" str)
+ (setq str (concat (substring str 0 (match-beginning 0))
+ " "
+ (substring str (match-end 0)))))
+ ;; Leading spaces.
+ (when (string-match "^[ \t]+" str)
+ (setq str (substring str (match-end 0))))
+ ;; Trailing spaces.
+ (when (string-match "[ \t]+$" str)
+ (setq str (substring str 0 (match-beginning 0))))
+ str)
(defun gnus-simplify-all-whitespace (str)
"Remove all whitespace from STR."
- (let ((mystr str))
- (while (string-match "[ \t\n]+" mystr)
- (setq mystr (replace-match "" nil nil mystr)))
- mystr))
+ (while (string-match "[ \t\n]+" str)
+ (setq str (replace-match "" nil nil str)))
+ str)
(defsubst gnus-simplify-subject-re (subject)
"Remove \"Re:\" from subject lines."
(buffer-string))))
(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to gnus-summary-gather-subject-limit."
+ "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
(cond
(gnus-simplify-subject-functions
(gnus-map-function gnus-simplify-subject-functions subject))
(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
"Check whether two subjects are equal.
-If optional argument simple-first is t, first argument is already
+If optional argument SIMPLE-FIRST is t, first argument is already
simplified."
(cond
((null simple-first)
"c" gnus-article-hide-citation
"C" gnus-article-hide-citation-in-followups
"l" gnus-article-hide-list-identifiers
- "p" gnus-article-hide-pgp
"B" gnus-article-strip-banner
"P" gnus-article-hide-pem
"\C-c" gnus-article-hide-citation-maybe)
["Signature" gnus-article-hide-signature t]
["Citation" gnus-article-hide-citation t]
["List identifiers" gnus-article-hide-list-identifiers t]
- ["PGP" gnus-article-hide-pgp t]
["Banner" gnus-article-strip-banner t]
["Boring headers" gnus-article-hide-boring-headers t])
("Highlight"
["View MIME buttons" gnus-summary-display-buttonized t]
["View all" gnus-mime-view-all-parts t]
["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
- ["Encrypt body" gnus-article-encrypt-body t]
- ["Extract all parts" gnus-summary-save-parts t])
+ ["Encrypt body" gnus-article-encrypt-body
+ :active (not (gnus-group-read-only-p))
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Encrypt the message body on disk"))]
+ ["Extract all parts" gnus-summary-save-parts t]
+ ("Multipart"
+ ["Repair multipart" gnus-summary-repair-multipart t]
+ ["Add buttons" gnus-summary-display-buttonized t]
+ ["Pipe part" gnus-article-pipe-part t]
+ ["Inline part" gnus-article-inline-part t]
+ ["Encrypt body" gnus-article-encrypt-body
+ :active (not (gnus-group-read-only-p))
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Encrypt the message body on disk"))]
+ ["View part externally" gnus-article-view-part-externally t]
+ ["View part with charset" gnus-article-view-part-as-charset t]
+ ["Copy part" gnus-article-copy-part t]
+ ["Save part" gnus-article-save-part t]
+ ["View part" gnus-article-view-part t]))
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
,@(gnus-summary-menu-split
(mapcar
(lambda (cs)
- ;; Since easymenu under FSF Emacs doesn't allow lambda
- ;; forms for menu commands, we should provide intern'ed
- ;; function symbols.
+ ;; Since easymenu under Emacs doesn't allow
+ ;; lambda forms for menu commands, we should
+ ;; provide intern'ed function symbols.
(let ((command (intern (format "\
gnus-summary-show-article-from-menu-as-charset-%s" cs))))
(fset command
["Crosspost article..." gnus-summary-crosspost-article
(gnus-check-backend-function
'request-replace-article gnus-newsgroup-name)]
- ["Import file..." gnus-summary-import-article t]
- ["Create article..." gnus-summary-create-article t]
+ ["Import file..." gnus-summary-import-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
+ ["Create article..." gnus-summary-create-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
["Check if posted" gnus-summary-article-posted-p t]
["Edit article" gnus-summary-edit-article
(not (gnus-group-read-only-p))]
["Kill" gnus-summary-kill-process-mark t]
["Yank" gnus-summary-yank-process-mark
gnus-newsgroup-process-stack]
- ["Save" gnus-summary-save-process-mark t]))
+ ["Save" gnus-summary-save-process-mark t]
+ ["Run command on marked..." gnus-summary-universal-argument t]))
("Scroll article"
["Page forward" gnus-summary-next-page
,@(if (featurep 'xemacs) '(t)
["See old articles" gnus-summary-insert-old-articles t]
["See new articles" gnus-summary-insert-new-articles t]
["Filter articles..." gnus-summary-execute-command t]
- ["Run command on subjects..." gnus-summary-universal-argument t]
+ ["Run command on articles..." gnus-summary-universal-argument t]
["Search articles forward..." gnus-summary-search-article-forward t]
["Search articles backward..." gnus-summary-search-article-backward t]
["Toggle line truncation" gnus-summary-toggle-truncation t]
(make-local-variable 'gnus-summary-dummy-line-format)
(make-local-variable 'gnus-summary-dummy-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
- (make-local-hook 'pre-command-hook)
+ (gnus-make-local-hook 'pre-command-hook)
(add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
(gnus-run-hooks 'gnus-summary-mode-hook)
(turn-on-gnus-mailing-list-mode)
(point)
(current-buffer))))))
-(defun gnus-summary-buffer-name (group)
- "Return the summary buffer name of GROUP."
- (concat "*Summary " (gnus-group-decoded-name group) "*"))
-
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(let ((buffer (gnus-summary-buffer-name group))
(setq gnus-tmp-lines -1))
(if (= gnus-tmp-lines -1)
(setq gnus-tmp-lines "?")
- (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
+ (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)
+ 'gnus-number gnus-tmp-number)
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
(gnus-run-hooks 'gnus-summary-update-hook)
(defsubst gnus-summary-line-message-size (head)
"Return pretty-printed version of message size.
This function is intended to be used in
-`gnus-summary-line-format-alist', which see."
+`gnus-summary-line-format-alist'."
(let ((c (or (mail-header-chars head) -1)))
(cond ((< c 0) "n/a") ; chars not available
((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
(gnus-summary-position-point)
(gnus-configure-windows 'summary 'force)
(gnus-set-mode-line 'summary))
- (when (get-buffer-window gnus-group-buffer t)
+ (when (and gnus-auto-center-group
+ (get-buffer-window gnus-group-buffer t))
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(let ((owin (selected-window)))
((eq gnus-auto-select-subject 'first)
;; Do nothing.
)
- ((gnus-functionp gnus-auto-select-subject)
+ ((functionp gnus-auto-select-subject)
(funcall gnus-auto-select-subject))))
(defun gnus-summary-prepare ()
If nil, use subject instead."
:type 'string
:group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-false-root "> "
+ "With %B spec, used for a false root of a thread.
+If nil, use subject instead."
+ :type 'string
+ :group 'gnus-thread)
(defcustom gnus-sum-thread-tree-single-indent ""
"With %B spec, used for a thread with just one message.
If nil, use subject instead."
gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
tree-stack)
- (setq gnus-tmp-prev-subject nil)
+ (setq gnus-tmp-prev-subject nil
+ gnus-tmp-thread-tree-header-string "")
(if (vectorp (car threads))
;; If this is a straight (sic) list of headers, then a
(substring gnus-tmp-from
(1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from))
+
+ ;; Do the %B string
gnus-tmp-thread-tree-header-string
(cond
((not gnus-show-threads) "")
((zerop gnus-tmp-level)
- (if (cdar thread)
- (or gnus-sum-thread-tree-root subject)
- (or gnus-sum-thread-tree-single-indent subject)))
+ (cond ((cdar thread)
+ (or gnus-sum-thread-tree-root subject))
+ (gnus-tmp-new-adopts
+ (or gnus-sum-thread-tree-false-root subject))
+ (t
+ (or gnus-sum-thread-tree-single-indent subject))))
(t
(concat (apply 'concat
(mapcar (lambda (item)
(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)
(when (nth 1 thread)
(push (list (max 0 gnus-tmp-level)
- (copy-list tree-stack)
+ (copy-sequence tree-stack)
(nthcdr 1 thread))
stack))
(push (if (nth 1 thread) 1 0) tree-stack)
(gnus-activate-group group) ; Or we can activate it...
(progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
(error "Couldn't activate group %s: %s"
group (gnus-status-message group))))
(unless (gnus-request-group group t)
(when (equal major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
group (gnus-status-message group)))
+ (when gnus-agent
+ ;; The agent may be storing articles that are no longer in the
+ ;; server's active range. If that is the case, the active range
+ ;; needs to be expanded such that the agent's articles can be
+ ;; included in the summary.
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (alist (gnus-agent-load-alist group))
+ (active (gnus-active group)))
+ (if (and (car alist)
+ (< (caar alist) (car active)))
+ (gnus-set-active group (cons (caar alist) (cdr active))))))
+
(setq gnus-newsgroup-name group
gnus-newsgroup-unselected nil
gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point)
- (progn (end-of-line) (point))))
+ (setq xref (buffer-substring (point) (gnus-point-at-eol)))
(mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
(save-excursion
(gnus-group-best-unread-group exclude-group))))
-(defun gnus-summary-find-next (&optional unread article backward undownloaded)
- (if backward (gnus-summary-find-prev)
+(defun gnus-summary-find-next (&optional unread article backward)
+ (if backward (gnus-summary-find-prev unread article)
(let* ((dummy (gnus-summary-article-intangible-p))
(article (or article (gnus-summary-article-number)))
- (arts (gnus-data-find-list article))
+ (data (gnus-data-find-list article))
result)
(when (and (not dummy)
(or (not gnus-summary-check-current)
(not unread)
- (not (gnus-data-unread-p (car arts)))))
- (setq arts (cdr arts)))
+ (not (gnus-data-unread-p (car data)))))
+ (setq data (cdr data)))
(when (setq result
(if unread
(progn
- (while arts
- (when (or (and undownloaded
- (memq (car arts)
- gnus-newsgroup-undownloaded))
- (gnus-data-unread-p (car arts)))
- (setq result (car arts)
- arts nil))
- (setq arts (cdr arts)))
+ (while data
+ (unless (memq (gnus-data-number (car data))
+ (cond ((eq gnus-auto-goto-ignores 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores 'undownloaded)
+ gnus-newsgroup-undownloaded)))
+ (when (gnus-data-unread-p (car data))
+ (setq result (car data)
+ data nil)))
+ (setq data (cdr data)))
result)
- (car arts)))
+ (car data)))
(goto-char (gnus-data-pos result))
(gnus-data-number result)))))
(defun gnus-summary-find-prev (&optional unread article)
(let* ((eobp (eobp))
(article (or article (gnus-summary-article-number)))
- (arts (gnus-data-find-list article (gnus-data-list 'rev)))
+ (data (gnus-data-find-list article (gnus-data-list 'rev)))
result)
(when (and (not eobp)
(or (not gnus-summary-check-current)
(not unread)
- (not (gnus-data-unread-p (car arts)))))
- (setq arts (cdr arts)))
+ (not (gnus-data-unread-p (car data)))))
+ (setq data (cdr data)))
(when (setq result
(if unread
(progn
- (while arts
- (when (gnus-data-unread-p (car arts))
- (setq result (car arts)
- arts nil))
- (setq arts (cdr arts)))
+ (while data
+ (unless (memq (gnus-data-number (car data))
+ (cond ((eq gnus-auto-goto-ignores 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores 'undownloaded)
+ gnus-newsgroup-undownloaded)))
+ (when (gnus-data-unread-p (car data))
+ (setq result (car data)
+ data nil)))
+ (setq data (cdr data)))
result)
- (car arts)))
+ (car data)))
(goto-char (gnus-data-pos result))
(gnus-data-number result))))
If `gnus-auto-center-summary' is nil, or the article buffer isn't
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
-;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
(interactive)
- (let* ((top (cond ((< (window-height) 4) 0)
- ((< (window-height) 7) 1)
- (t (if (numberp gnus-auto-center-summary)
- gnus-auto-center-summary
- 2))))
- (height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
- (window (get-buffer-window (current-buffer))))
- ;; The user has to want it.
- (when gnus-auto-center-summary
+ ;; The user has to want it.
+ (when gnus-auto-center-summary
+ (let* ((top (cond ((< (window-height) 4) 0)
+ ((< (window-height) 7) 1)
+ (t (if (numberp gnus-auto-center-summary)
+ gnus-auto-center-summary
+ 2))))
+ (height (1- (window-height)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- 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
+ ;; 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))))
(> (prefix-numeric-value arg) 0)))
(redraw-display))
-(defun gnus-summary-find-uncancelled ()
- "Return the number of an uncancelled article.
+(defun gnus-summary-find-for-reselect ()
+ "Return the number of an article to stay on across a reselect.
The current article is considered, then following articles, then previous
-articles. If all articles are cancelled then return a dummy 0."
+articles. An article is sought which is not cancelled and isn't a temporary
+insertion from another group. If there's no such then return a dummy 0."
(let (found)
(dolist (rev '(nil t))
(unless found ; don't demand the reverse list if we don't need it
(let ((data (gnus-data-find-list
(gnus-summary-article-number) (gnus-data-list rev))))
(while (and data (not found))
- (if (not (eq gnus-canceled-mark (gnus-data-mark (car data))))
+ (if (and (< 0 (gnus-data-number (car data)))
+ (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
(setq found (gnus-data-number (car data))))
(setq data (cdr data))))))
(or found 0)))
(interactive "P")
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
- (let ((current-subject (gnus-summary-find-uncancelled))
+ (let ((current-subject (gnus-summary-find-for-reselect))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(gnus-summary-exit)
(interactive)
(let* ((group gnus-newsgroup-name)
(gnus-group-is-exiting-p t)
+ (gnus-group-is-exiting-without-update-p t)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (mapcar 'funcall
- (delq 'gnus-summary-expire-articles
- (copy-sequence gnus-summary-prepare-exit-hook)))
+ (run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-summary-clear-local-variables)
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
(gnus-summary-clear-local-variables))
- (when (get-buffer gnus-summary-buffer)
- (kill-buffer gnus-summary-buffer)))
+ (gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(when gnus-use-trees
(defun gnus-summary-next-group (&optional no-article target-group backward)
"Exit current newsgroup and then select next unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected
-initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
previous group instead."
(interactive "P")
;; Stop pre-fetching.
(let ((current-group gnus-newsgroup-name)
(current-buffer (current-buffer))
entered)
+ ;; First we semi-exit this group to update Xrefs and all variables.
+ ;; We can't do a real exit, because the window conf must remain
+ ;; the same in case the user is prompted for info, and we don't
+ ;; want the window conf to change before that...
+ (gnus-summary-exit t)
(while (not entered)
;; Then we find what group we are supposed to enter.
(set-buffer gnus-group-buffer)
(let ((unreads (gnus-group-group-unread)))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
- (progn
- ;; Now we semi-exit this group to update Xrefs
- ;; and all variables. We can't do a real exit,
- ;; because the window conf must remain the same
- ;; in case the user is prompted for info, and we
- ;; don't want the window conf to change before
- ;; that...
- (when (gnus-buffer-live-p current-buffer)
- (set-buffer current-buffer)
- (gnus-summary-exit t))
- (gnus-summary-read-group
- target-group nil no-article
- (and (buffer-name current-buffer) current-buffer)
- nil backward)))
+ (gnus-summary-read-group
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)
+ nil backward))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
;; Walking around summary lines.
(defun gnus-summary-first-subject (&optional unread undownloaded unseen)
- "Go to the first unread subject.
-If UNREAD is non-nil, go to the first unread article.
-Returns the article selected or nil if there are no unread articles."
+ "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 UNSEED is non-nil, the article should be unseen.
+Returns the article selected or nil if there are no matching articles."
(interactive "P")
- (prog1
- (cond
- ;; Empty summary.
- ((null gnus-newsgroup-data)
- (gnus-message 3 "No articles in the group")
- nil)
- ;; Pick the first article.
- ((not unread)
- (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
- (gnus-data-number (car gnus-newsgroup-data)))
- ;; No unread articles.
- ((null gnus-newsgroup-unreads)
- (gnus-message 3 "No more unread articles")
- nil)
- ;; Find the first unread article.
- (t
- (let ((data gnus-newsgroup-data))
- (while (and data
- (and (not (and undownloaded
- (memq (car data)
- gnus-newsgroup-undownloaded)))
- (if unseen
- (or (not (memq
- (gnus-data-number (car data))
- gnus-newsgroup-unseen))
- (not (gnus-data-unread-p (car data))))
- (not (gnus-data-unread-p (car data))))))
- (setq data (cdr data)))
- (when data
- (goto-char (gnus-data-pos (car data)))
- (gnus-data-number (car data))))))
- (gnus-summary-position-point)))
+ (cond
+ ;; Empty summary.
+ ((null gnus-newsgroup-data)
+ (gnus-message 3 "No articles in the group")
+ nil)
+ ;; Pick the first article.
+ ((not (or unread undownloaded unseen))
+ (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
+ (gnus-data-number (car gnus-newsgroup-data)))
+ ;; Find the first unread article.
+ (t
+ (let ((data gnus-newsgroup-data))
+ (while (and data
+ (let ((num (gnus-data-number (car data))))
+ (or (memq num gnus-newsgroup-unfetched)
+ (not (or (and unread
+ (memq num gnus-newsgroup-unreads))
+ (and undownloaded
+ (memq num gnus-newsgroup-undownloaded))
+ (and unseen
+ (memq num gnus-newsgroup-unseen)))))))
+ (setq data (cdr data)))
+ (prog1
+ (if data
+ (progn
+ (goto-char (gnus-data-pos (car data)))
+ (gnus-data-number (car data)))
+ (gnus-message 3 "No more%s articles"
+ (let* ((r (when unread " unread"))
+ (d (when undownloaded " undownloaded"))
+ (s (when unseen " unseen"))
+ (l (delq nil (list r d s))))
+ (cond ((= 3 (length l))
+ (concat r "," d ", or" s))
+ ((= 2 (length l))
+ (concat (car l) ", or" (cadr l)))
+ ((= 1 (length l))
+ (car l))
+ (t
+ ""))))
+ nil
+ )
+ (gnus-summary-position-point))))))
(defun gnus-summary-next-subject (n &optional unread dont-display)
"Go to next N'th summary line.
'old))))
(defun gnus-summary-force-verify-and-decrypt ()
+ "Display buttons for signed/encrypted parts and verify/decrypt them."
(interactive)
(let ((mm-verify-option 'known)
(mm-decrypt-option 'known)
(gnus-summary-display-article article)
(when article-window
(gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (gnus-article-next-page lines)))
+ (setq endp (or (gnus-article-next-page lines)
+ (gnus-article-only-boring-p))))
(when endp
(cond (stop
(gnus-message 3 "End of message"))
Return nil if there are no unseen articles."
(interactive)
(prog1
- (when (gnus-summary-first-subject t t t)
+ (when (gnus-summary-first-subject nil nil t)
(gnus-summary-show-thread)
- (gnus-summary-first-subject t t t))
+ (gnus-summary-first-subject nil nil t))
(gnus-summary-position-point)))
(defun gnus-summary-first-unseen-or-unread-subject ()
- "Place the point on the subject line of the first unseen article.
-Return nil if there are no unseen articles."
+ "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
+article."
(interactive)
(prog1
- (unless (when (gnus-summary-first-subject t t t)
+ (unless (when (gnus-summary-first-subject nil nil t)
(gnus-summary-show-thread)
- (gnus-summary-first-subject t t t))
+ (gnus-summary-first-subject nil nil t))
(when (gnus-summary-first-subject t)
(gnus-summary-show-thread)
(gnus-summary-first-subject t)))
(let ((id (mail-header-id (gnus-summary-article-header)))
(limit (if limit (prefix-numeric-value limit)
gnus-refer-thread-limit)))
- ;; We want to fetch LIMIT *old* headers, but we also have to
- ;; re-fetch all the headers in the current buffer, because many of
- ;; them may be undisplayed. So we adjust LIMIT.
- (when (numberp limit)
- (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin)))
(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 (gnus-retrieve-headers
- (list gnus-newsgroup-end) gnus-newsgroup-name limit)
+ (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 backends that don't support NOV"))
;; We fetch the article.
(catch 'found
(dolist (gnus-override-method (gnus-refer-article-methods))
- (gnus-check-server gnus-override-method)
- ;; Fetch the header, and display the article.
- (when (setq number (gnus-summary-insert-subject message-id))
+ (when (and (gnus-check-server gnus-override-method)
+ ;; Fetch the header,
+ (setq number (gnus-summary-insert-subject message-id)))
+ ;; and display the article.
(gnus-summary-select-article nil nil nil number)
(throw 'found t)))
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
+ (gnus-visual nil)
+ (gnus-keep-backlog nil)
+ (gnus-break-pages nil)
+ (gnus-summary-display-arrow nil)
+ (gnus-updated-mode-lines nil)
+ (gnus-auto-center-summary nil)
(sum (current-buffer))
(gnus-display-mime-function nil)
(found nil)
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'."
+without any article massaging functions being run. Normally, the key
+strokes are `C-u g'."
(interactive "P")
(cond
((numberp arg)
(1- (point))
(point-max))))
(insert-buffer-substring gnus-original-article-buffer s e)
- (article-decode-encoded-words)
+ (run-hooks 'gnus-article-decode-hook)
(if hidden
(let ((gnus-treat-hide-headers nil)
(gnus-treat-hide-boring-headers nil))
((eq art-group 'junk)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article)))
+ (gnus-message 4 "Deleted article %s" article)
+ ;; run the delete hook
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name nil
+ select-method)))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
- article gnus-newsgroup-name (current-buffer)))))
+ article gnus-newsgroup-name (current-buffer))))
+
+ ;; run the move/copy/crosspost/respool hook
+ (run-hook-with-args 'gnus-summary-article-move-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ to-newsgroup
+ select-method))
;;;!!!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))))
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
- (when (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)
+ (when (and (not gnus-group-is-exiting-without-update-p)
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name))
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable (if total
(dolist (article expirable)
(when (and (not (memq article es))
(gnus-data-find article))
- (gnus-summary-mark-article article gnus-canceled-mark))))))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (run-hook-with-args 'gnus-summary-article-expire-hook
+ 'delete
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ nil
+ nil))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
This command actually deletes articles. This is not a marking
command. The article will disappear forever from your life, never to
return.
+
If N is negative, delete backwards.
If N is nil and articles have been marked with the process mark,
-delete these instead."
+delete these instead.
+
+If `gnus-novice-user' is non-nil you will be asked for
+confirmation before the articles are deleted."
(interactive "P")
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
;; after all.
(unless (memq (car articles) not-deleted)
(gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (let* ((article (car articles))
+ (id (mail-header-id (gnus-data-header
+ (assoc article (gnus-data-list nil))))))
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ 'delete id gnus-newsgroup-name nil
+ nil))
(setq articles (cdr articles)))
(when not-deleted
(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
(set (make-local-variable 'mml-buffer-list) mbl1))
- (make-local-hook 'kill-buffer-hook)
+ (gnus-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
`(lambda (no-highlight)
(let ((mail-parse-charset ',gnus-newsgroup-charset)
(interactive (list (gnus-summary-article-number)))
(let ((articles (if (listp article) article (list article))))
(dolist (article articles)
+ (unless (numberp article)
+ (error "%s is not a number" article))
(push article gnus-newsgroup-replied)
(let ((buffer-read-only nil))
(when (gnus-summary-goto-subject article nil t)
t)
(defun gnus-summary-update-download-mark (article)
- "Update the secondary (read, process, cache) mark."
+ "Update the download mark."
(gnus-summary-update-mark
(cond ((memq article gnus-newsgroup-undownloaded)
gnus-undownloaded-mark)
gnus-newsgroup-spam-marked nil
gnus-newsgroup-dormant nil))
(setq gnus-newsgroup-unreads
- (gnus-intersection gnus-newsgroup-unreads
- gnus-newsgroup-downloadable)))
+ (gnus-sorted-nunion
+ (gnus-intersection gnus-newsgroup-unreads
+ gnus-newsgroup-downloadable)
+ gnus-newsgroup-unfetched)))
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
(goto-char to-here)
(while (and
(gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all) nil nil t))))
- (when (gnus-summary-first-subject (not all) t)
+ (gnus-summary-find-next (not all)))))
+ (when (gnus-summary-first-subject (not all))
(while (and
(if to-here (< (point) to-here) t)
(gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all) nil nil t)))))
+ (gnus-summary-find-next (not all))))))
(gnus-set-mode-line 'summary))
t))
(gnus-summary-position-point)))
(gnus-summary-position-point))
(defun gnus-summary-catchup-from-here (&optional all)
- "Mark all unticked articles after the current one as read.
+ "Mark all unticked articles after (and including) the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
(interactive "P")
(save-excursion
(interactive)
(let ((buffer-read-only nil)
(orig (point))
- ;; first goto end then to beg, to have point at beg after let
- (end (progn (end-of-line) (point)))
+ (end (gnus-point-at-eol))
+ ;; Leave point at bol
(beg (progn (beginning-of-line) (point))))
(prog1
;; Any hidden lines here?
gnus-thread-hide-subtree)
(gnus-summary-hide-all-threads
(if (or (consp gnus-thread-hide-subtree)
- (gnus-functionp gnus-thread-hide-subtree))
+ (functionp gnus-thread-hide-subtree))
(gnus-make-predicate gnus-thread-hide-subtree)
nil))))
;; Regular expression.
(ignore-errors
(re-search-forward match nil t)))
- ((gnus-functionp match)
+ ((functionp match)
;; Function.
(save-restriction
(widen)
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(when gnus-summary-selected-face
(save-excursion
- (let* ((beg (progn (beginning-of-line) (point)))
- (end (progn (end-of-line) (point)))
+ (let* ((beg (gnus-point-at-bol))
+ (end (gnus-point-at-eol))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
(c cond)
(list gnus-summary-highlight))
(while list
- (setcdr c (cons (list (caar list) (list 'quote (cdar list))) nil))
+ (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
+ nil))
(setq c (cdr c)
list (cdr list)))
(gnus-byte-compile (list 'lambda nil cond))))))
(mail-header-number h))
gnus-newsgroup-headers)))
(setq gnus-newsgroup-headers
- (merge 'list
- gnus-newsgroup-headers
- (gnus-fetch-headers articles)
- 'gnus-article-sort-by-number))
+ (gnus-merge 'list
+ gnus-newsgroup-headers
+ (gnus-fetch-headers articles)
+ 'gnus-article-sort-by-number))
;; Suppress duplicates?
(when gnus-suppress-duplicates
(gnus-dup-suppress-articles))
(run-hooks 'gnus-sum-load-hook)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; gnus-sum.el ends here
projects / elisp / gnus.git- / blobdiff