X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=b95fdfef9b947a5436256668c5692818e29ab3ea;hb=c5f7362aa49943397fec729fdcfca40679946ec8;hp=fd2f4fefcdfa34b4a373c60020e74af09f8c713f;hpb=f1206324939866662415ab655e7c134369f46c63;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index fd2f4fe..b95fdfe 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -26,7 +26,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (defvar tool-bar-map)) (require 'gnus) (require 'gnus-group) @@ -321,13 +323,13 @@ place point on some subject line." (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-catchup-and-goto-next-group]' command will go to the next group without confirmation." :group 'gnus-summary-maneuvering :type '(choice (const :tag "off" nil) @@ -343,6 +345,23 @@ the first unread article." :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 @@ -360,6 +379,9 @@ and non-`vertical', do both horizontal and vertical recentering." (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 @@ -429,7 +451,7 @@ this variable specifies group names." :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) @@ -847,6 +869,21 @@ automatically when it is selected." :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)) @@ -1016,9 +1053,10 @@ For example: ((1 . cn-gb-2312) (2 . big5))." 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-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) @@ -1044,7 +1082,7 @@ Set it to non-nil, Gnus will treat some articles as MIME even if 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. @@ -1052,7 +1090,7 @@ This means that Gnus will search message bodies for text that look 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 @@ -1234,8 +1272,14 @@ the type of the variable (string, integer, character, etc).") (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.") @@ -1283,7 +1327,7 @@ the type of the variable (string, integer, character, etc).") (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 @@ -1297,6 +1341,7 @@ the type of the variable (string, integer, character, etc).") 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 @@ -1339,9 +1384,18 @@ buffers. For example: ") ;; 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))) @@ -1388,26 +1442,24 @@ For example: (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." @@ -1485,7 +1537,7 @@ See `gnus-simplify-buffer-fuzzy' for details." (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)) @@ -1501,7 +1553,7 @@ See `gnus-simplify-buffer-fuzzy' for details." (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) @@ -1814,7 +1866,6 @@ increase the score of each group you read." "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) @@ -2031,7 +2082,6 @@ increase the score of each group you read." ["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" @@ -2047,8 +2097,25 @@ increase the score of each group you read." ["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] @@ -2067,9 +2134,9 @@ increase the score of each group you read." ,@(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 @@ -2151,8 +2218,12 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["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))] @@ -2342,7 +2413,8 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["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) @@ -2397,7 +2469,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["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] @@ -2606,7 +2678,7 @@ The following commands are available: (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) @@ -3005,10 +3077,6 @@ display only a single character." (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)) @@ -3247,11 +3315,11 @@ buffer that was in action when the last article was fetched." (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) @@ -3321,7 +3389,7 @@ the thread are to be displayed." (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))) @@ -3517,7 +3585,8 @@ If NO-DISPLAY, don't generate a summary buffer." (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))) @@ -3547,7 +3616,7 @@ If NO-DISPLAY, don't generate a summary buffer." ((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 () @@ -4498,6 +4567,11 @@ Unscored articles will be counted as having a score of zero." 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." @@ -4543,7 +4617,8 @@ or a straight list of headers." 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 @@ -4761,13 +4836,18 @@ or a straight list of headers." (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) @@ -4785,10 +4865,10 @@ or a straight list of headers." (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) @@ -4798,7 +4878,7 @@ or a straight list of headers." (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) @@ -4924,16 +5004,28 @@ If SELECT-ARTICLES, only select those articles from GROUP." (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)) @@ -5833,8 +5925,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (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) @@ -5996,53 +6087,68 @@ If EXCLUDE-GROUP, do not go to this group." (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)))) @@ -6091,23 +6197,23 @@ Also do horizontal recentering." 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)))) @@ -6245,17 +6351,19 @@ With arg, turn line truncation on if arg is positive." (> (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))) @@ -6266,7 +6374,7 @@ The prefix argument ALL means to select all articles." (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) @@ -6438,14 +6546,13 @@ If FORCE (the prefix), also save the .newsrc file(s)." (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) @@ -6468,8 +6575,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (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 @@ -6639,7 +6745,7 @@ in." (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. @@ -6647,6 +6753,11 @@ previous group instead." (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) @@ -6671,20 +6782,10 @@ previous group instead." (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))))))) @@ -6698,42 +6799,55 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially." ;; 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. @@ -6890,6 +7004,7 @@ be displayed." '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) @@ -7067,7 +7182,8 @@ If STOP is non-nil, just stop when reaching the end of the message." (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")) @@ -7188,19 +7304,20 @@ Return nil if there are no unread articles." 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))) @@ -7922,16 +8039,21 @@ of what's specified by the `gnus-refer-thread-limit' variable." (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")) @@ -7971,9 +8093,10 @@ of what's specified by the `gnus-refer-thread-limit' variable." ;; 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))))))) @@ -8181,6 +8304,12 @@ Optional argument BACKWARD means do search for backward. (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) @@ -8412,8 +8541,8 @@ 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'." +without any article massaging functions being run. Normally, the key +strokes are `C-u g'." (interactive "P") (cond ((numberp arg) @@ -8521,7 +8650,7 @@ If ARG is a negative number, hide the unwanted header lines." (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)) @@ -8736,7 +8865,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ((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)) @@ -8814,11 +8950,20 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (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)))) @@ -8990,8 +9135,9 @@ This will be the case if the article has both been mailed and posted." (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 @@ -9035,7 +9181,14 @@ This will be the case if the article has both been mailed and posted." (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 () @@ -9055,9 +9208,13 @@ deleted forever, right 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) @@ -9084,6 +9241,12 @@ delete these instead." ;; 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))) @@ -9147,7 +9310,7 @@ groups." (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) @@ -9432,6 +9595,8 @@ ARTICLE can also be a list of articles." (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) @@ -9691,7 +9856,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." 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) @@ -9980,8 +10145,10 @@ The number of articles marked as read is returned." 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) @@ -9990,12 +10157,12 @@ The number of articles marked as read is returned." (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))) @@ -10013,7 +10180,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (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 @@ -10214,8 +10381,8 @@ Returns nil if no thread was there to be shown." (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? @@ -10230,7 +10397,7 @@ Returns nil if no thread was there to be shown." 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)))) @@ -10646,7 +10813,7 @@ save those articles instead." ;; Regular expression. (ignore-errors (re-search-forward match nil t))) - ((gnus-functionp match) + ((functionp match) ;; Function. (save-restriction (widen) @@ -10966,8 +11133,8 @@ If REVERSE, save parts that do not match TYPE." ;; Added by Per Abrahamsen . (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 . (from (if (get-text-property beg gnus-mouse-face-prop) beg @@ -11008,7 +11175,8 @@ If REVERSE, save parts that do not match TYPE." (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)))))) @@ -11275,10 +11443,10 @@ returned." (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)) @@ -11407,4 +11575,8 @@ If ALL is a number, fetch this number of articles." (run-hooks 'gnus-sum-load-hook) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; gnus-sum.el ends here