X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=e20aebadb67c30ee2c4a47d9c007cbbe9b1ee005;hb=a7c213c57c3e3fac5302d4c2fac24422cffa425c;hp=fbd3a65d6fda1de8163bf245923fd52b9f936e48;hpb=5f61f48a53b559a709b121921cafa66918ed1649;p=gnus diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index fbd3a65d6..e20aebadb 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -321,13 +321,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) @@ -360,6 +360,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 @@ -847,6 +850,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 +1034,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) @@ -1238,7 +1257,7 @@ the type of the variable (string, integer, character, etc).") "Sorted list of articles in the current newsgroup whose headers have not been fetched into the agent.") (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.") @@ -1392,26 +1411,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." @@ -1489,7 +1506,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)) @@ -1505,7 +1522,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) @@ -2050,7 +2067,18 @@ increase the score of each group you read." ["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]) + ["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 t] + ["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] @@ -2344,7 +2372,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) @@ -2399,7 +2428,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] @@ -2683,7 +2712,7 @@ The following commands are available: `(assq ,number gnus-newsgroup-data)) (defmacro gnus-data-find-list (number &optional data) - `(let* ((bdata ,(or data 'gnus-newsgroup-data))) + `(let ((bdata ,(or data 'gnus-newsgroup-data))) (memq (assq ,number bdata) bdata))) @@ -3519,7 +3548,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))) @@ -4545,7 +4575,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 @@ -4926,13 +4957,13 @@ 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))) @@ -6093,23 +6124,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)))) @@ -6470,8 +6501,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 @@ -6641,7 +6671,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. @@ -6905,6 +6935,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) @@ -7082,7 +7113,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")) @@ -7938,16 +7970,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")) @@ -8197,6 +8234,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) @@ -8751,8 +8794,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (nnheader-get-report (car to-method)))) ((eq art-group 'junk) (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article))) + (let ((id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article) + ;; run the move/copy/crosspost/respool hook + (run-hook-with-args 'gnus-summary-article-delete-hook + action id gnus-newsgroup-name nil + select-method)))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) @@ -8830,7 +8879,14 @@ 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 + (let ((id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-move-hook + action id gnus-newsgroup-name to-newsgroup + select-method))) ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) @@ -9051,7 +9107,13 @@ 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) + (let ((id (mail-header-id (gnus-data-header + (assoc article + (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-expire-hook + 'delete id gnus-newsgroup-name nil + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -9100,6 +9162,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)))