X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=952b901e5fd4ff6628f547a86ed4bb5eef7a09a6;hb=09a6c5997ca53642d041233d6a11f5550e1b2943;hp=295fa92bfe68eb57d836010e1f84e967f55cb8f0;hpb=33073b2c705c23892d353f27e83ce0e38393b0cb;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 295fa92..952b901 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -51,11 +51,10 @@ (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (autoload 'gnus-cache-write-active "gnus-cache") -(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) (autoload 'mm-uu-dissect "mm-uu") -(autoload 'gnus-article-outlook-deuglify-article "deuglify" +(autoload 'gnus-article-outlook-deuglify-article "deuglify" "Deuglify broken Outlook (Express) articles and redisplay." t) @@ -148,8 +147,9 @@ comparing subjects." "List of functions taking a string argument that simplify subjects. The functions are applied recursively. -Useful functions to put in this list include: `gnus-simplify-subject-re', -`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'." +Useful functions to put in this list include: +`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy', +`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'." :group 'gnus-thread :type '(repeat function)) @@ -196,7 +196,7 @@ This applies to marking commands as well as other commands that the end of an article. If nil, the marking commands do NOT go to the next unread article -(they go to the next article instead). If `never', commands that +\(they go to the next article instead). If `never', commands that usually go to the next unread article, will go to the next article, whether it is read or not." :group 'gnus-summary-marks @@ -447,6 +447,11 @@ this variable specifies group names." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-spam-mark ?H + "*Mark used for spam articles." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-souped-mark ?F "*Mark used for souped articles." :group 'gnus-summary-marks @@ -607,7 +612,7 @@ with some simple extensions. %S The subject General format specifiers can also be used. -See (gnus)Formatting Variables." +See `(gnus)Formatting Variables'." :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-threading :type 'string) @@ -666,7 +671,8 @@ was sent, sorting by number means sorting by arrival time.) Ready-made functions include `gnus-article-sort-by-number', `gnus-article-sort-by-author', `gnus-article-sort-by-subject', -`gnus-article-sort-by-date' and `gnus-article-sort-by-score'. +`gnus-article-sort-by-date', `gnus-article-sort-by-random' +and `gnus-article-sort-by-score'. When threading is turned on, the variable `gnus-thread-sort-functions' controls how articles are sorted." @@ -676,6 +682,7 @@ controls how articles are sorted." (function-item gnus-article-sort-by-subject) (function-item gnus-article-sort-by-date) (function-item gnus-article-sort-by-score) + (function-item gnus-article-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) @@ -695,7 +702,8 @@ Ready-made functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number', -`gnus-thread-sort-by-most-recent-date', and +`gnus-thread-sort-by-most-recent-date', +`gnus-thread-sort-by-random', and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). When threading is turned off, the variable @@ -707,6 +715,7 @@ When threading is turned off, the variable (function-item gnus-thread-sort-by-date) (function-item gnus-thread-sort-by-score) (function-item gnus-thread-sort-by-total-score) + (function-item gnus-thread-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-score-function '+ @@ -811,7 +820,7 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -(defcustom gnus-parse-headers-hook '(gnus-set-summary-default-charset) +(defcustom gnus-parse-headers-hook '(gnus-summary-inherit-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -883,6 +892,8 @@ automatically when it is selected." . gnus-summary-low-ancient-face) ((eq mark gnus-ancient-mark) . gnus-summary-normal-ancient-face) + (downloaded + . gnus-agent-downloaded-article-face) ((and (> score default-high) (eq mark gnus-unread-mark)) . gnus-summary-high-unread-face) ((and (< score default-low) (eq mark gnus-unread-mark)) @@ -1127,6 +1138,7 @@ the MIME-Version header is missed." (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) + (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) (?L gnus-tmp-lines ?s) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) @@ -1175,6 +1187,7 @@ the type of the variable (string, integer, character, etc).") (?u gnus-tmp-user-defined ?s) (?d (length gnus-newsgroup-dormant) ?d) (?t (length gnus-newsgroup-marked) ?d) + (?h (length gnus-newsgroup-spam-marked) ?d) (?r (length gnus-newsgroup-reads) ?d) (?z (gnus-summary-article-score gnus-tmp-article-number) ?d) (?E gnus-newsgroup-expunged-tally ?d) @@ -1219,6 +1232,9 @@ end position and text.") (defvar gnus-newsgroup-marked nil "Sorted list of ticked articles in the current newsgroup (a subset of unread art).") +(defvar gnus-newsgroup-spam-marked nil + "List of ranges of articles that have been marked as spam.") + (defvar gnus-newsgroup-killed nil "List of ranges of articles that have been through the scoring process.") @@ -1307,6 +1323,7 @@ end position and text.") gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked + gnus-newsgroup-spam-marked gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-forwarded gnus-newsgroup-recent @@ -1376,6 +1393,13 @@ buffers. For example: (setq mystr (substring mystr 0 (match-beginning 0)))) mystr)) +(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)) + (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." (if (string-match message-subject-re-regexp subject) @@ -1558,6 +1582,7 @@ increase the score of each group you read." "\C-c\C-s\C-d" gnus-summary-sort-by-date "\C-c\C-s\C-i" gnus-summary-sort-by-score "\C-c\C-s\C-o" gnus-summary-sort-by-original + "\C-c\C-s\C-r" gnus-summary-sort-by-random "=" gnus-summary-expand-window "\C-x\C-s" gnus-summary-reselect-current-group "\M-g" gnus-summary-rescan-group @@ -1586,7 +1611,7 @@ increase the score of each group you read." "i" gnus-summary-news-other-window "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - "t" gnus-article-toggle-headers + "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article "v" gnus-summary-preview-mime-message @@ -1655,6 +1680,7 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age + "." gnus-summary-limit-to-unseen "x" gnus-summary-limit-to-extra "p" gnus-summary-limit-to-display-predicate "E" gnus-summary-limit-include-expunged @@ -1754,7 +1780,8 @@ increase the score of each group you read." "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message - "t" gnus-article-toggle-headers + "m" gnus-summary-morse-message + "t" gnus-summary-toggle-header "g" gnus-treat-smiley "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime @@ -1765,7 +1792,7 @@ increase the score of each group you read." (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) "a" gnus-article-hide - "h" gnus-article-toggle-headers + "h" gnus-article-hide-headers "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation @@ -1820,7 +1847,9 @@ increase the score of each group you read." "f" gnus-summary-fetch-faq "d" gnus-summary-describe-group "h" gnus-summary-describe-briefly - "i" gnus-info-find-node) + "i" gnus-info-find-node + "c" gnus-group-fetch-charter + "C" gnus-group-fetch-control) (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) "e" gnus-summary-expire-articles @@ -1913,6 +1942,30 @@ increase the score of each group you read." (defvar gnus-article-post-menu nil) +(defconst gnus-summary-menu-maxlen 20) + +(defun gnus-summary-menu-split (menu) + ;; If we have lots of elements, divide them into groups of 20 + ;; and make a pane (or submenu) for each one. + (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2)) + (let ((menu menu) sublists next + (i 1)) + (while menu + ;; Pull off the next gnus-summary-menu-maxlen elements + ;; and make them the next element of sublist. + (setq next (nthcdr gnus-summary-menu-maxlen menu)) + (if next + (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu) + nil)) + (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0) + (aref (car (last menu)) 0)) menu) + sublists)) + (setq i (1+ i)) + (setq menu next)) + (nreverse sublists)) + ;; Few elements--put them all in one pane. + menu)) + (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1951,7 +2004,7 @@ increase the score of each group you read." (let ((innards `(("Hide" ["All" gnus-article-hide t] - ["Headers" gnus-article-toggle-headers t] + ["Headers" gnus-article-hide-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t] ["List identifiers" gnus-article-hide-list-identifiers t] @@ -1978,27 +2031,26 @@ increase the score of each group you read." ["Show picons in mail headers" gnus-treat-mail-picon t] ["Show picons in news headers" gnus-treat-newsgroups-picon t] ("View as different encoding" - ,@(mapcar - (lambda (cs) - ;; Since easymenu under FSF Emacs doesn't allow lambda - ;; forms for menu commands, we should provide intern'ed - ;; function symbols. - (let ((command (intern (format "\ + ,@(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. + (let ((command (intern (format "\ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) - (fset command - `(lambda () - (interactive) - (let ((gnus-summary-show-article-charset-alist - '((1 . ,cs)))) - (gnus-summary-show-article 1)))) - `[,(symbol-name cs) ,command t])) - (sort (if (fboundp 'coding-system-list) - (coding-system-list) - ;;(mapcar 'car mm-mime-mule-charset-alist) - ) - (lambda (a b) - (string< (symbol-name a) - (symbol-name b))))))) + (fset command + `(lambda () + (interactive) + (let ((gnus-summary-show-article-charset-alist + '((1 . ,cs)))) + (gnus-summary-show-article 1)))) + `[,(symbol-name cs) ,command t])) + (sort (if (fboundp 'coding-system-list) + (coding-system-list) + ;;(mapcar 'car mm-mime-mule-charset-alist) + ) + 'string<))))) ("Washing" ("Remove Blanks" ["Leading" gnus-article-strip-leading-blank-lines t] @@ -2020,7 +2072,8 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Rot 13" gnus-summary-caesar-message ,@(if (featurep 'xemacs) '(t) '(:help "\"Caesar rotate\" article by 13"))] - ["Unix pipe" gnus-summary-pipe-message t] + ["Morse decode" gnus-summary-morse-message t] + ["Unix pipe..." gnus-summary-pipe-message t] ["Add buttons" gnus-article-add-buttons t] ["Add buttons to head" gnus-article-add-buttons-to-head t] ["Stop page breaking" gnus-summary-stop-page-breaking t] @@ -2216,9 +2269,10 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Author..." gnus-summary-limit-to-author t] ["Age..." gnus-summary-limit-to-age t] ["Extra..." gnus-summary-limit-to-extra t] - ["Score" gnus-summary-limit-to-score t] + ["Score..." gnus-summary-limit-to-score t] ["Display Predicate" gnus-summary-limit-to-display-predicate t] ["Unread" gnus-summary-limit-to-unread t] + ["Unseen" gnus-summary-limit-to-unseen t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] ["Articles" gnus-summary-limit-to-articles t] ["Pop limit" gnus-summary-pop-limit t] @@ -2279,10 +2333,17 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Sort by score" gnus-summary-sort-by-score t] ["Sort by lines" gnus-summary-sort-by-lines t] ["Sort by characters" gnus-summary-sort-by-chars t] + ["Randomize" gnus-summary-sort-by-random t] ["Original sort" gnus-summary-sort-by-original t]) ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] + ["Fetch charter" gnus-group-fetch-charter + ,@(if (featurep 'xemacs) nil + '(:help "Display the charter of the current group"))] + ["Fetch control message" gnus-group-fetch-control + ,@(if (featurep 'xemacs) nil + '(:help "Display the archived control message for the current group"))] ["Read manual" gnus-info-find-node t]) ("Modes" ["Pick and read" gnus-pick-mode t] @@ -2696,6 +2757,7 @@ The following commands are available: (defun gnus-article-read-p (article) "Say whether ARTICLE is read or not." (not (or (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-spam-marked) (memq article gnus-newsgroup-unreads) (memq article gnus-newsgroup-unselected) (memq article gnus-newsgroup-dormant)))) @@ -2797,10 +2859,11 @@ time; i.e., when generating the summary lines. After that, marks of articles." `(cond ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark) - ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) +;;;; ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark) ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) + ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark) ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq ,number gnus-newsgroup-reads)) @@ -2941,6 +3004,7 @@ buffer that was in action when the last article was fetched." (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) + (spam gnus-newsgroup-spam-marked) (unread gnus-newsgroup-unreads) (headers gnus-current-headers) (data gnus-newsgroup-data) @@ -2963,6 +3027,7 @@ buffer that was in action when the last article was fetched." (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name gnus-newsgroup-marked marked + gnus-newsgroup-spam-marked spam gnus-newsgroup-unreads unread gnus-current-headers headers gnus-newsgroup-data data @@ -3034,17 +3099,19 @@ buffer that was in action when the last article was fetched." 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) 2))))) + (- (point) (point-min) 1))))) (goto-char (point-min)) (push (cons 'replied (and (search-forward "\201" nil t) - (- (point) 2))) + (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) + (push (cons 'score (and (search-forward "\202" nil t) + (- (point) (point-min) 1))) pos) (goto-char (point-min)) (push (cons 'download - (and (search-forward "\203" nil t) (- (point) 2))) + (and (search-forward "\203" nil t) + (- (point) (point-min) 1))) pos))) (setq gnus-summary-mark-positions pos)))) @@ -3204,6 +3271,18 @@ the thread are to be displayed." gnus-empty-thread-mark) number))) +(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." + (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))) + ((< c (* 1000 100)) (format "%dk" (/ c 1024.0))) + ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024)))) + (t (format "%dM" (/ c (* 1024.0 1024))))))) + + (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." (let ((params (gnus-group-find-parameter group)) @@ -3642,7 +3721,7 @@ entered. Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) (id-dep (and id (intern id dependencies))) - ref ref-dep ref-header replaced) + parent-id ref ref-dep ref-header replaced) ;; Enter this `header' in the `dependencies' table. (cond ((not id-dep) @@ -3685,7 +3764,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (when (and header (not replaced)) ;; First check that we are not creating a References loop. - (setq ref (gnus-parent-id (mail-header-references header))) + (setq parent-id (gnus-parent-id (mail-header-references header))) + (setq ref parent-id) (while (and ref (setq ref-dep (intern-soft ref dependencies)) (boundp ref-dep) @@ -3695,10 +3775,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; root article. (progn (mail-header-set-references (car (symbol-value id-dep)) "none") - (setq ref nil)) + (setq ref nil) + (setq parent-id nil)) (setq ref (gnus-parent-id (mail-header-references ref-header))))) - (setq ref (gnus-parent-id (mail-header-references header))) - (setq ref-dep (intern (or ref "none") dependencies)) + (setq ref-dep (intern (or parent-id "none") dependencies)) (if (boundp ref-dep) (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) @@ -4206,6 +4286,15 @@ using some other form will lead to serious barfage." (gnus-article-sort-by-number (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-random (h1 h2) + "Sort articles by article number." + (zerop (random 2))) + +(defun gnus-thread-sort-by-random (h1 h2) + "Sort threads by root article number." + (gnus-article-sort-by-random + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-lines (h1 h2) "Sort articles by article Lines header." (< (mail-header-lines h1) @@ -4398,7 +4487,7 @@ or a straight list of headers." (default-score (or gnus-summary-default-score 0)) (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end + new-roots gnus-tmp-new-adopts thread-end simp-subject gnus-tmp-header gnus-tmp-unread gnus-tmp-replied gnus-tmp-subject-or-nil gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score @@ -4487,7 +4576,8 @@ or a straight list of headers." (setq gnus-tmp-level -1))) (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header)) + subject (mail-header-subject gnus-tmp-header) + simp-subject (gnus-simplify-subject-fully subject)) (cond ;; If the thread has changed subject, we might want to make @@ -4495,8 +4585,7 @@ or a straight list of headers." ((and (null gnus-thread-ignore-subject) (not (zerop gnus-tmp-level)) gnus-tmp-prev-subject - (not (inline - (gnus-subject-equal gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) (setq new-roots (nconc new-roots (list (car thread))) thread-end t gnus-tmp-header nil)) @@ -4557,15 +4646,13 @@ or a straight list of headers." (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-subject - (not (inline (gnus-subject-equal - gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) subject) ((zerop gnus-tmp-level) (if (and (eq gnus-summary-make-false-root 'empty) (memq number gnus-tmp-gathered) gnus-tmp-prev-subject - (inline (gnus-subject-equal - gnus-tmp-prev-subject subject))) + (string= gnus-tmp-prev-subject simp-subject)) gnus-summary-same-subject subject)) (t gnus-summary-same-subject))) @@ -4650,7 +4737,7 @@ or a straight list of headers." (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)) - (setq gnus-tmp-prev-subject subject))) + (setq gnus-tmp-prev-subject simp-subject))) (when (nth 1 thread) (push (list (max 0 gnus-tmp-level) @@ -4833,7 +4920,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Adjust and set lists of article marks. (when info (gnus-adjust-marked-articles info)) - (if (setq articles select-articles) (setq gnus-newsgroup-unselected (gnus-sorted-difference gnus-newsgroup-unreads articles)) @@ -4850,6 +4936,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-make-hashtable (length articles))) (gnus-set-global-variables) ;; Retrieve the headers and read them in. + (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) ;; Kludge to avoid having cached articles nixed out in virtual groups. @@ -4935,6 +5022,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (cond ((eq type 'tick) (memq article gnus-newsgroup-marked)) + ((eq type 'spam) + (memq article gnus-newsgroup-spam-marked)) ((eq type 'unsend) (memq article gnus-newsgroup-unsendable)) ((eq type 'undownload) @@ -6475,10 +6564,6 @@ 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. @@ -6504,10 +6589,20 @@ previous group instead." (let ((unreads (gnus-group-group-unread))) (if (and (or (eq t unreads) (and unreads (not (zerop unreads)))) - (gnus-summary-read-group - target-group nil no-article - (and (buffer-name current-buffer) current-buffer) - nil backward)) + (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))) (setq entered t) (setq current-group target-group target-group nil))))))) @@ -6706,7 +6801,10 @@ be displayed." (defun gnus-summary-force-verify-and-decrypt () (interactive) (let ((mm-verify-option 'known) - (mm-decrypt-option 'known)) + (mm-decrypt-option 'known) + (gnus-buttonized-mime-types (append (list "multipart/signed" + "multipart/encrypted") + gnus-buttonized-mime-types))) (gnus-summary-select-article nil 'force))) (defun gnus-summary-set-current-mark (&optional current-mark) @@ -7274,7 +7372,7 @@ If ALL is non-nil, limit strictly to unread articles." ;; Concat all the marks that say that an article is read and have ;; those removed. (list gnus-del-mark gnus-read-mark gnus-ancient-mark - gnus-killed-mark gnus-kill-file-mark + gnus-killed-mark gnus-spam-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark gnus-duplicate-mark gnus-souped-mark) @@ -7282,7 +7380,7 @@ If ALL is non-nil, limit strictly to unread articles." (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) (make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exlude-marks) + 'gnus-summary-limit-exclude-marks) (defun gnus-summary-limit-exclude-marks (marks &optional reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). @@ -7326,6 +7424,13 @@ Returns how many articles were removed." (gnus-summary-limit articles) (gnus-summary-position-point)))) +(defun gnus-summary-limit-to-unseen () + "Limit to unseen articles." + (interactive) + (prog1 + (gnus-summary-limit gnus-newsgroup-unseen) + (gnus-summary-position-point))) + (defun gnus-summary-limit-include-thread (id) "Display all the hidden articles that is in the thread with ID in it. When called interactively, ID is the Message-ID of the current @@ -7826,8 +7931,8 @@ to guess what the document format is." (set-buffer gnus-original-article-buffer) ;; Have the digest group inherit the main mail address of ;; the parent article. - (when (setq to-address (or (message-fetch-field "reply-to") - (message-fetch-field "from"))) + (when (setq to-address (or (gnus-fetch-field "reply-to") + (gnus-fetch-field "from"))) (setq params (append (list (cons 'to-address (funcall gnus-decode-encoded-word-function @@ -8205,12 +8310,19 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." ;; We don't want to change current point nor window configuration. (save-excursion (save-window-excursion - (gnus-message 6 "Executing %s..." (key-description command)) - ;; We'd like to execute COMMAND interactively so as to give arguments. - (gnus-execute header regexp - `(call-interactively ',(key-binding command)) - backward) - (gnus-message 6 "Executing %s...done" (key-description command))))) + (let (gnus-visual + gnus-treat-strip-trailing-blank-lines + gnus-treat-strip-leading-blank-lines + gnus-treat-strip-multiple-blank-lines + gnus-treat-hide-boring-headers + gnus-treat-fold-newsgroups + gnus-article-prepare-hook) + (gnus-message 6 "Executing %s..." (key-description command)) + ;; We'd like to execute COMMAND interactively so as to give arguments. + (gnus-execute header regexp + `(call-interactively ',(key-binding command)) + backward) + (gnus-message 6 "Executing %s...done" (key-description command)))))) (defun gnus-summary-beginning-of-article () "Scroll the article back to the beginning." @@ -8387,35 +8499,38 @@ If ARG is a negative number, turn header display off." If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines." (interactive "P") - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction + (let ((window (and (gnus-buffer-live-p gnus-article-buffer) + (get-buffer-window gnus-article-buffer t)))) + (with-current-buffer gnus-article-buffer + (widen) + (article-narrow-to-head) (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) - hidden e) - (save-restriction - (article-narrow-to-head) - (setq e (point-max) - hidden (if (numberp arg) - (>= arg 0) - (gnus-article-hidden-text-p 'headers)))) - (delete-region (point-min) e) - (goto-char (point-min)) - (save-excursion - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (setq e (search-forward "\n\n" nil t) - e (if e (1- e) (point-max)))) - (insert-buffer-substring gnus-original-article-buffer 1 e) - (save-restriction - (narrow-to-region (point-min) (point)) - (article-decode-encoded-words) - (if hidden - (let ((gnus-treat-hide-headers nil) - (gnus-treat-hide-boring-headers nil)) - (gnus-delete-wash-type 'headers) - (gnus-treat-article 'head)) - (gnus-treat-article 'head))) + (hidden (if (numberp arg) + (>= arg 0) + (gnus-article-hidden-text-p 'headers))) + s e) + (delete-region (point-min) (point-max)) + (with-current-buffer gnus-original-article-buffer + (goto-char (setq s (point-min))) + (setq e (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max)))) + (insert-buffer-substring gnus-original-article-buffer s e) + (article-decode-encoded-words) + (if hidden + (let ((gnus-treat-hide-headers nil) + (gnus-treat-hide-boring-headers nil)) + (gnus-delete-wash-type 'headers) + (gnus-treat-article 'head)) + (gnus-treat-article 'head)) + (widen) + (if window + (set-window-start window (goto-char (point-min)))) + (setq gnus-page-broken + (when gnus-break-pages + (gnus-narrow-to-page) + t)) (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () @@ -8448,6 +8563,31 @@ forward." (message-caesar-buffer-body arg) (set-window-start (get-buffer-window (current-buffer)) start)))))) +(autoload 'unmorse-region "morse" + "Convert morse coded text in region to ordinary ASCII text." + t) + +(defun gnus-summary-morse-message (&optional arg) + "Morse decode the current article." + (interactive "P") + (gnus-summary-select-article) + (let ((mail-header-separator "")) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (let ((pos (window-start)) + buffer-read-only) + (goto-char (point-min)) + (when (message-goto-body) + (gnus-narrow-to-body)) + (goto-char (point-min)) + (while (re-search-forward "ยท" (point-max) t) + (replace-match ".")) + (unmorse-region (point-min) (point-max)) + (widen) + (set-window-start (get-buffer-window (current-buffer)) pos))))))) + (defun gnus-summary-stop-page-breaking () "Stop page breaking in the current article." (interactive) @@ -8471,6 +8611,10 @@ If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method. +When called interactively with TO-NEWSGROUP being nil, the value of +the variable `gnus-move-split-methods' is used for finding a default +for the target newsgroup. + For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' and `request-accept' functions. @@ -8708,6 +8852,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. +When called interactively, if TO-NEWSGROUP is nil, use the value of +the variable `gnus-move-split-methods' for finding a default target +newsgroup. If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method." (interactive "P") @@ -8926,6 +9073,7 @@ delete these instead." (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) + (nnmail-expiry-target 'delete) not-deleted) (if (and gnus-novice-user (not (gnus-yes-or-no-p @@ -9230,6 +9378,13 @@ the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-expirable-mark)) +(defun gnus-summary-mark-as-spam (n) + "Mark N articles forward as spam. +If N is negative, mark backward instead. The difference between N and +the actual number of articles marked is returned." + (interactive "p") + (gnus-summary-mark-forward n gnus-spam-mark)) + (defun gnus-summary-mark-article-as-replied (article) "Mark ARTICLE as replied to and update the summary line. ARTICLE can also be a list of articles." @@ -9360,6 +9515,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (let ((article (gnus-summary-article-number))) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -9391,6 +9547,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) @@ -9398,6 +9555,10 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (setq gnus-newsgroup-marked (gnus-add-to-sorted-list gnus-newsgroup-marked article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked + article))) ((= mark gnus-dormant-mark) (setq gnus-newsgroup-dormant (gnus-add-to-sorted-list gnus-newsgroup-dormant @@ -9450,6 +9611,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (error "No article on current line")) (if (not (if (or (= mark gnus-unread-mark) (= mark gnus-ticked-mark) + (= mark gnus-spam-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) (gnus-mark-article-as-read article mark))) @@ -9524,6 +9686,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." ;; Remove from unread and marked lists. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -9539,6 +9702,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) + gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked) gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) @@ -9550,6 +9714,9 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (cond ((= mark gnus-ticked-mark) (setq gnus-newsgroup-marked (gnus-add-to-sorted-list gnus-newsgroup-marked article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked article))) ((= mark gnus-dormant-mark) (setq gnus-newsgroup-dormant (gnus-add-to-sorted-list gnus-newsgroup-dormant article))) @@ -9763,6 +9930,7 @@ The number of articles marked as read is returned." (progn (when all (setq gnus-newsgroup-marked nil + gnus-newsgroup-spam-marked nil gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable)) ;; We actually mark all articles as canceled, which we @@ -10194,6 +10362,12 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'number reverse)) +(defun gnus-summary-sort-by-random (&optional reverse) + "Randomize the order in the summary buffer. +Argument REVERSE means to randomize in reverse order." + (interactive "P") + (gnus-summary-sort 'random reverse)) + (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. If `case-fold-search' is non-nil, case of letters is ignored. @@ -10764,6 +10938,27 @@ If REVERSE, save parts that do not match TYPE." (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) 'face gnus-summary-selected-face)))))) +(defvar gnus-summary-highlight-line-cached nil) +(defvar gnus-summary-highlight-line-trigger nil) +(defun gnus-summary-highlight-line-0 () + (if (and (eq gnus-summary-highlight-line-trigger + gnus-summary-highlight) + gnus-summary-highlight-line-cached) + gnus-summary-highlight-line-cached + (setq gnus-summary-highlight-line-trigger gnus-summary-highlight + gnus-summary-highlight-line-cached + (let* ((cond (list 'cond)) + (c cond) + (list gnus-summary-highlight)) + (while list + (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)))))) + +(defvar gnus-summary-highlight-line-downloaded-alist nil) +(defvar gnus-summary-highlight-line-downloaded-cached nil) + ;; New implementation by Christian Limpach . (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." @@ -10777,12 +10972,23 @@ If REVERSE, save parts that do not match TYPE." (inhibit-read-only t) (default gnus-summary-default-score) (default-high gnus-summary-default-high-score) - (default-low gnus-summary-default-low-score)) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))) - (let ((face (cdar list))) + (default-low gnus-summary-default-low-score) + (downloaded (and (boundp 'gnus-agent-article-alist) + gnus-agent-article-alist + ;; Optimized for when gnus-summary-highlight-line is called multiple times for articles in ascending order (i.e. initial generation of summary buffer). + (progn + (if (and (eq gnus-summary-highlight-line-downloaded-alist gnus-agent-article-alist) + (<= (caar gnus-summary-highlight-line-downloaded-cached) article)) + nil + (setq gnus-summary-highlight-line-downloaded-alist gnus-agent-article-alist + gnus-summary-highlight-line-downloaded-cached gnus-agent-article-alist)) + (let (n) + (while (and (< (caar gnus-summary-highlight-line-downloaded-cached) article) + (setq n (cdr gnus-summary-highlight-line-downloaded-cached))) + (setq gnus-summary-highlight-line-downloaded-cached n))) + (and (eq (caar gnus-summary-highlight-line-downloaded-cached) article) + (cdar gnus-summary-highlight-line-downloaded-cached)))))) + (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (get-text-property beg 'face)) (gnus-put-text-property-excluding-characters-with-faces beg (gnus-point-at-eol) 'face @@ -10981,20 +11187,52 @@ UNREAD is a sorted list." ;;; @ end ;;; +(defun gnus-summary-inherit-default-charset () + "Import `default-mime-charset' from summary buffer. +Also take care of `default-mime-charset-unlimited' if the LIMIT version +of FLIM is used." + (if (buffer-live-p gnus-summary-buffer) + (let (d-m-c d-m-c-u) + (with-current-buffer gnus-summary-buffer + (setq d-m-c (if (local-variable-p 'default-mime-charset + gnus-summary-buffer) + default-mime-charset + t) + ;; LIMIT + d-m-c-u (if (local-variable-p 'default-mime-charset-unlimited + gnus-summary-buffer) + (symbol-value 'default-mime-charset-unlimited) + t))) + (if (eq t d-m-c) + (kill-local-variable 'default-mime-charset) + (set (make-local-variable 'default-mime-charset) d-m-c)) + (if (eq t d-m-c-u) + (kill-local-variable 'default-mime-charset-unlimited) + (set (make-local-variable 'default-mime-charset-unlimited) + d-m-c-u))))) + (defun gnus-summary-setup-default-charset () "Setup newsgroup default charset." - (if (equal gnus-newsgroup-name "nndraft:drafts") - (setq gnus-newsgroup-charset nil) - (let* ((ignored-charsets - (or gnus-newsgroup-ephemeral-ignored-charsets - (append - (and gnus-newsgroup-name - (gnus-parameter-ignored-charsets gnus-newsgroup-name)) - gnus-newsgroup-ignored-charsets)))) + (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts")) + (progn + (setq gnus-newsgroup-charset nil) + (set (make-local-variable 'default-mime-charset) nil) + (when (boundp 'default-mime-charset-unlimited);; LIMIT + (set (make-local-variable 'default-mime-charset-unlimited) nil))) + (let ((ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (gnus-parameter-ignored-charsets gnus-newsgroup-name)) + gnus-newsgroup-ignored-charsets))) + charset) (setq gnus-newsgroup-charset (or gnus-newsgroup-ephemeral-charset - (and gnus-newsgroup-name - (gnus-parameter-charset gnus-newsgroup-name)) + (when (and gnus-newsgroup-name + (setq charset (gnus-parameter-charset + gnus-newsgroup-name))) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) gnus-default-charset)) (set (make-local-variable 'gnus-newsgroup-ignored-charsets) ignored-charsets)))) @@ -11263,21 +11501,36 @@ If ALL is a number, fetch this number of articles." (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) older len) (setq older - (gnus-sorted-difference - (gnus-uncompress-range (list gnus-newsgroup-active)) - old)) - (setq len (length older)) +;;; Some nntp servers lie about their active range. When this happens, the active range can be in the millions. +;;; (gnus-sorted-difference +;;; (gnus-uncompress-range (list gnus-newsgroup-active)) +;;; old) + (gnus-remove-from-range (list gnus-newsgroup-active) old) +) + (setq len (gnus-range-length older)) (cond ((null older) nil) ((numberp all) (if (< all len) - (setq older (last older all)))) + (let ((older-range (nreverse older))) + (setq older nil) + + (while (> all 0) + (let* ((r (pop older-range)) + (min (if (numberp r) r (car r))) + (max (if (numberp r) r (cdr r)))) + (while (and (<= min max) + (> all 0)) + (push max older) + (setq all (1- all) + max (1- max)))))) + (setq older (gnus-uncompress-range older)))) (all nil) (t (if (and (numberp gnus-large-newsgroup) (> len gnus-large-newsgroup)) (let* ((cursor-in-echo-area nil) - (initial (gnus-parameter-large-newsgroup-initial + (initial (gnus-parameter-large-newsgroup-initial gnus-newsgroup-name)) (input (read-string @@ -11293,7 +11546,19 @@ If ALL is a number, fetch this number of articles." (unless (string-match "^[ \t]*$" input) (setq all (string-to-number input)) (if (< all len) - (setq older (last older all)))))))) + (let ((older-range (nreverse older))) + (setq older nil) + + (while (> all 0) + (let* ((r (pop older-range)) + (min (if (numberp r) r (car r))) + (max (if (numberp r) r (cdr r)))) + (while (and (<= min max) + (> all 0)) + (push max older) + (setq all (1- all) + max (1- max)))))) + (setq older (gnus-uncompress-range older)))))))) (if (not older) (message "No old news.") (gnus-summary-insert-articles older) @@ -11310,13 +11575,12 @@ If ALL is a number, fetch this number of articles." i new) (setq gnus-newsgroup-active (gnus-activate-group gnus-newsgroup-name 'scan)) - (setq i (1+ (cdr old-active))) - (while (<= i (cdr gnus-newsgroup-active)) + (setq i (cdr gnus-newsgroup-active)) + (while (> i (cdr old-active)) (push i new) - (incf i)) + (decf i)) (if (not new) (message "No gnus is bad news.") - (setq new (nreverse new)) (gnus-summary-insert-articles new) (setq gnus-newsgroup-unreads (gnus-sorted-nunion gnus-newsgroup-unreads new))