X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=b53eca289095925a85c8ae1e9f9fa23e675da388;hb=09868cf7efbfa51562d76580eafc9a7b6b0c8d72;hp=075cf44110421aaea0d9b8ae49d85e359fa024e7;hpb=33bb7337c1d9482e730963cd66ea54d334d3a8c1;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 075cf44..b53eca2 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,5 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -256,8 +256,8 @@ If this variable is `best', select the highest-scored unread article in the group. If t, select the first unread article. This variable can also be a function to place point on a likely -subject line. Useful values include `gnus-summary-first-unread-subject', -`gnus-summary-first-unread-article' and +subject line. Useful values include `gnus-summary-first-unread-subject', +`gnus-summary-first-unread-article' and `gnus-summary-best-unread-article'. If you want to prevent automatic selection of the first unread article @@ -345,7 +345,7 @@ It uses the same syntax as the `gnus-split-methods' variable." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-unread-mark ? +(defcustom gnus-unread-mark ? ;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks :type 'character) @@ -460,7 +460,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-empty-thread-mark ? +(defcustom gnus-empty-thread-mark ? ;Whitespace "*There is no thread under the article." :group 'gnus-summary-marks :type 'character) @@ -606,7 +606,7 @@ See `gnus-thread-score-function' for en explanation of what a \"thread score\" is. This variable is local to the summary buffers." - :group 'gnus-treading + :group 'gnus-threading :group 'gnus-score-default :type '(choice (const :tag "off" nil) integer)) @@ -797,12 +797,55 @@ which it may alter in any way.") :group 'gnus-summary :type 'regexp) +(defcustom gnus-group-charset-alist + '(("^hk\\>\\|^tw\\>\\|\\" cn-big5) + ("^cn\\>\\|\\" cn-gb-2312) + ("^fj\\>\\|^japan\\>" iso-2022-jp-2) + ("^relcom\\>" koi8-r) + ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) + ("^israel\\>" iso-8859-1) + ("^han\\>" euc-kr) + ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) + (".*" iso-8859-1)) + "Alist of regexps (to match group names) and default charsets to be used when reading." + :type '(repeat (list (regexp :tag "Group") + (symbol :tag "Charset"))) + :group 'gnus-charset) + +(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit) + "List of charsets that should be ignored. +When these charsets are used in the \"charset\" parameter, the +default charset will be used instead." + :type '(repeat symbol) + :group 'gnus-charset) + +(defcustom gnus-group-ignored-charsets-alist + '(("alt\\.chinese\\.text" iso-8859-1)) + "Alist of regexps (to match group names) and charsets that should be ignored. +When these charsets are used in the \"charset\" parameter, the +default charset will be used instead." + :type '(repeat (cons (regexp :tag "Group") + (repeat symbol))) + :group 'gnus-charset) + +(defcustom gnus-group-highlight-words-alist nil + "Alist of group regexps and highlight regexps. +This variable uses the same syntax as `gnus-emphasis-alist'." + :type '(repeat (cons (regexp :tag "Group") + (repeat (list (regexp :tag "Highlight regexp") + (number :tag "Group for entire word" 0) + (number :tag "Group for displayed part" 0) + (symbol :tag "Face" + gnus-emphasis-highlight-words))))) + :group 'gnus-summary-visual) + ;;; Internal variables (defvar gnus-article-mime-handles nil) (defvar gnus-article-decoded-p nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-page-broken nil) +(defvar gnus-inhibit-mime-unbuttonizing nil) (defvar gnus-original-article nil) (defvar gnus-article-internal-prepare-hook nil) @@ -984,6 +1027,9 @@ variable (string, integer, character, etc).") (defvar gnus-have-all-headers nil) (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) +(defvar gnus-newsgroup-charset nil) +(defvar gnus-newsgroup-ephemeral-charset nil) +(defvar gnus-newsgroup-ephemeral-ignored-charsets nil) (defconst gnus-summary-local-variables '(gnus-newsgroup-name @@ -1005,7 +1051,8 @@ variable (string, integer, character, etc).") gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers gnus-thread-expunge-below - gnus-score-alist gnus-current-score-file gnus-summary-expunge-below + gnus-score-alist gnus-current-score-file + (gnus-summary-expunge-below . global) (gnus-summary-mark-below . global) gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient @@ -1015,7 +1062,8 @@ variable (string, integer, character, etc).") (gnus-newsgroup-expunged-tally . 0) gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse - gnus-newsgroup-limit gnus-newsgroup-limits) + gnus-newsgroup-limit gnus-newsgroup-limits + gnus-newsgroup-charset) "Variables that are buffer-local to the summary buffers.") ;; Byte-compiler warning. @@ -1032,9 +1080,9 @@ FUNCTION, FUNCTION will be apply to all newsgroups. If item is a (REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups whose names match REGEXP. -For example: +For example: ((\"chinese\" . gnus-decode-encoded-word-string-by-guess) - mail-decode-encoded-word-string + mail-decode-encoded-word-string (\"chinese\" . rfc1843-decode-string)) ") @@ -1043,15 +1091,15 @@ For example: (defun gnus-multi-decode-encoded-word-string (string) "Apply the functions from `gnus-encoded-word-methods' that match." (unless (and gnus-decode-encoded-word-methods-cache - (eq gnus-newsgroup-name + (eq gnus-newsgroup-name (car gnus-decode-encoded-word-methods-cache))) (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) - (mapc '(lambda (x) + (mapc '(lambda (x) (if (symbolp x) (nconc gnus-decode-encoded-word-methods-cache (list x)) - (if (and gnus-newsgroup-name + (if (and gnus-newsgroup-name (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-encoded-word-methods-cache + (nconc gnus-decode-encoded-word-methods-cache (list (cdr x)))))) gnus-decode-encoded-word-methods)) (let ((xlist gnus-decode-encoded-word-methods-cache)) @@ -1250,6 +1298,7 @@ increase the score of each group you read." "\C-c\M-\C-s" gnus-summary-limit-include-expunged "\C-c\C-s\C-n" gnus-summary-sort-by-number "\C-c\C-s\C-l" gnus-summary-sort-by-lines + "\C-c\C-s\C-c" gnus-summary-sort-by-chars "\C-c\C-s\C-a" gnus-summary-sort-by-author "\C-c\C-s\C-s" gnus-summary-sort-by-subject "\C-c\C-s\C-d" gnus-summary-sort-by-date @@ -1280,7 +1329,7 @@ increase the score of each group you read." "a" gnus-summary-post-news "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - "t" gnus-article-hide-headers + "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article "\C-c\C-v\C-v" gnus-uu-decode-uu-view @@ -1297,8 +1346,10 @@ increase the score of each group you read." "L" gnus-summary-lower-score "\M-i" gnus-symbolic-argument "h" gnus-summary-select-article-buffer + "b" gnus-article-view-part - + "\M-t" gnus-summary-toggle-display-buttonized + "V" gnus-summary-score-map "X" gnus-uu-extract-map "S" gnus-summary-send-map) @@ -1340,12 +1391,14 @@ increase the score of each group you read." "a" gnus-summary-limit-to-author "u" gnus-summary-limit-to-unread "m" gnus-summary-limit-to-marks + "M" gnus-summary-limit-exclude-marks "v" gnus-summary-limit-to-score "*" gnus-summary-limit-include-cached "D" gnus-summary-limit-include-dormant "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read) @@ -1416,11 +1469,13 @@ increase the score of each group you read." "e" gnus-summary-end-of-article "^" gnus-summary-refer-parent-article "r" gnus-summary-refer-parent-article + "D" gnus-summary-enter-digest-group "R" gnus-summary-refer-references "T" gnus-summary-refer-thread "g" gnus-summary-show-article "s" gnus-summary-isearch-article - "P" gnus-summary-print-article) + "P" gnus-summary-print-article + "t" gnus-article-babel) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) "b" gnus-article-add-buttons @@ -1428,6 +1483,8 @@ increase the score of each group you read." "o" gnus-article-treat-overstrike "e" gnus-article-emphasize "w" gnus-article-fill-cited-article + "Q" gnus-article-fill-long-lines + "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr "q" gnus-article-de-quoted-unreadable "f" gnus-article-display-x-face @@ -1436,6 +1493,7 @@ increase the score of each group you read." "t" gnus-article-hide-headers "v" gnus-summary-verbose-headers "h" gnus-article-treat-html + "H" gnus-article-strip-headers-in-body "d" gnus-article-treat-dumbquotes) (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) @@ -1446,6 +1504,7 @@ increase the score of each group you read." "c" gnus-article-hide-citation "C" gnus-article-hide-citation-in-followups "p" gnus-article-hide-pgp + "B" gnus-article-strip-banner "P" gnus-article-hide-pem "\C-c" gnus-article-hide-citation-maybe) @@ -1476,7 +1535,8 @@ increase the score of each group you read." "m" gnus-article-strip-multiple-blank-lines "a" gnus-article-strip-blank-lines "A" gnus-article-strip-all-blank-lines - "s" gnus-article-strip-leading-space) + "s" gnus-article-strip-leading-space + "e" gnus-article-strip-trailing-space) (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) "v" gnus-version @@ -1490,6 +1550,7 @@ increase the score of each group you read." "\M-\C-e" gnus-summary-expire-articles-now "\177" gnus-summary-delete-article [delete] gnus-summary-delete-article + [backspace] gnus-summary-delete-article "m" gnus-summary-move-article "r" gnus-summary-respool-article "w" gnus-summary-edit-article @@ -1510,7 +1571,18 @@ increase the score of each group you read." "h" gnus-summary-save-article-folder "v" gnus-summary-save-article-vm "p" gnus-summary-pipe-output - "s" gnus-soup-add-article)) + "s" gnus-soup-add-article) + + (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) + "b" gnus-summary-display-buttonized + "m" gnus-summary-repair-multipart + "v" gnus-article-view-part + "o" gnus-article-save-part + "c" gnus-article-copy-part + "e" gnus-article-externalize-part + "i" gnus-article-inline-part + "|" gnus-article-pipe-part) + ) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1554,6 +1626,7 @@ increase the score of each group you read." ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t] ["PGP" gnus-article-hide-pgp t] + ["Banner" gnus-article-strip-banner t] ["Boring headers" gnus-article-hide-boring-headers t]) ("Highlight" ["All" gnus-article-highlight t] @@ -1579,11 +1652,14 @@ increase the score of each group you read." ["Trailing" gnus-article-remove-trailing-blank-lines t] ["All of the above" gnus-article-strip-blank-lines t] ["All" gnus-article-strip-all-blank-lines t] - ["Leading space" gnus-article-strip-leading-space t]) + ["Leading space" gnus-article-strip-leading-space t] + ["Trailing space" gnus-article-strip-trailing-space t]) ["Overstrike" gnus-article-treat-overstrike t] ["Dumb quotes" gnus-article-treat-dumbquotes t] ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] + ["Fill long lines" gnus-article-fill-long-lines t] + ["Capitalize sentences" gnus-article-capitalize-sentences t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] @@ -1638,6 +1714,7 @@ increase the score of each group you read." ("Cache" ["Enter article" gnus-cache-enter-article t] ["Remove article" gnus-cache-remove-article t]) + ["Translate" gnus-article-babel t] ["Select article buffer" gnus-summary-select-article-buffer t] ["Enter digest buffer" gnus-summary-enter-digest-group t] ["Isearch article..." gnus-summary-isearch-article t] @@ -1728,6 +1805,7 @@ increase the score of each group you read." ["Subject..." gnus-summary-limit-to-subject t] ["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] ["Unread" gnus-summary-limit-to-unread t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] @@ -1737,6 +1815,7 @@ increase the score of each group you read." ["Hide childless dormant" gnus-summary-limit-exclude-childless-dormant t] ;;["Hide thread" gnus-summary-limit-exclude-thread t] + ["Hide marked" gnus-summary-limit-exclude-marks t] ["Show expunged" gnus-summary-show-all-expunged t]) ("Process Mark" ["Set mark" gnus-summary-mark-as-processable t] @@ -1783,7 +1862,8 @@ increase the score of each group you read." ["Sort by subject" gnus-summary-sort-by-subject t] ["Sort by date" gnus-summary-sort-by-date t] ["Sort by score" gnus-summary-sort-by-score t] - ["Sort by lines" gnus-summary-sort-by-lines t]) + ["Sort by lines" gnus-summary-sort-by-lines t] + ["Sort by characters" gnus-summary-sort-by-chars t]) ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] @@ -1953,8 +2033,6 @@ 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 'post-command-hook) - (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-hooks 'gnus-summary-mode-hook) @@ -1964,9 +2042,8 @@ The following commands are available: (defun gnus-summary-make-local-variables () "Make all the local summary buffer variables." - (let ((locals gnus-summary-local-variables) - global local) - (while (setq local (pop locals)) + (let (global) + (dolist (local gnus-summary-local-variables) (if (consp local) (progn (if (eq (cdr local) 'global) @@ -1974,11 +2051,9 @@ The following commands are available: (setq global (symbol-value (car local))) ;; Use the value from the list. (setq global (eval (cdr local)))) - (make-local-variable (car local)) - (set (car local) global)) + (set (make-local-variable (car local)) global)) ;; Simple nil-valued local variable. - (make-local-variable local) - (set local nil))))) + (set (make-local-variable local) nil))))) (defun gnus-summary-clear-local-variables () (let ((locals gnus-summary-local-variables)) @@ -2374,7 +2449,8 @@ marks of articles." (original gnus-original-article-buffer) (gac gnus-article-current) (reffed gnus-reffed-article-number) - (score-file gnus-current-score-file)) + (score-file gnus-current-score-file) + (default-charset gnus-newsgroup-charset)) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2387,7 +2463,8 @@ marks of articles." gnus-article-buffer article-buffer gnus-original-article-buffer original gnus-reffed-article-number reffed - gnus-current-score-file score-file) + gnus-current-score-file score-file + gnus-newsgroup-charset default-charset) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -2406,7 +2483,8 @@ marks of articles." (defun gnus-summary-last-article-p (&optional article) "Return whether ARTICLE is the last article in the buffer." (if (not (setq article (or article (gnus-summary-article-number)))) - t ; All non-existent numbers are the last article. :-) + ;; All non-existent numbers are the last article. :-) + t (not (cdr (gnus-data-find-list article))))) (defun gnus-make-thread-indent-array () @@ -2462,7 +2540,11 @@ marks of articles." (defun gnus-summary-from-or-to-or-newsgroups (header) (let ((to (cdr (assq 'To (mail-header-extra header)))) - (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))) + (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (save-excursion (set-buffer gnus-summary-buffer) + gnus-newsgroup-ignored-charsets))) (cond ((and to gnus-ignored-from-addresses @@ -2496,7 +2578,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) (gnus-tmp-replied @@ -2561,7 +2643,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? + ? ;Whitespace (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) 'score)) @@ -3129,31 +3211,6 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) -(defmacro gnus-nov-read-integer () - '(prog1 - (if (eq (char-after) ?\t) - 0 - (let ((num (ignore-errors (read buffer)))) - (if (numberp num) num 0))) - (unless (eobp) - (search-forward "\t" eol 'move)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -(defmacro gnus-nov-parse-extra () - '(let (out string) - (while (not (memq (char-after) '(?\n nil))) - (setq string (gnus-nov-field)) - (when (string-match "^\\([^ :]+\\): " string) - (push (cons (intern (match-string 1 string)) - (substring string (match-end 0))) - out))) - out)) - ;; This function has to be called with point after the article number ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) @@ -3170,20 +3227,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header - number ; number + number ; number (funcall gnus-decode-encoded-word-function - (gnus-nov-field)) ; subject + (nnheader-nov-field)) ; subject (funcall gnus-decode-encoded-word-function - (gnus-nov-field)) ; from - (gnus-nov-field) ; date - (or (gnus-nov-field) - (nnheader-generate-fake-message-id)) ; id - (gnus-nov-field) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (unless (eq (char-after) ?\n) - (gnus-nov-field)) ; misc - (gnus-nov-parse-extra)))) ; extra + (nnheader-nov-field)) ; from + (nnheader-nov-field) ; date + (nnheader-nov-read-message-id) ; id + (nnheader-nov-field) ; refs + (nnheader-nov-read-integer) ; chars + (nnheader-nov-read-integer) ; lines + (unless (eobp) + (nnheader-nov-field)) ; misc + (nnheader-nov-parse-extra)))) ; extra (widen)) @@ -3568,6 +3624,16 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-article-sort-by-lines (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-chars (h1 h2) + "Sort articles by octet length." + (< (mail-header-chars h1) + (mail-header-chars h2))) + +(defun gnus-thread-sort-by-chars (h1 h2) + "Sort threads by root article octet length." + (gnus-article-sort-by-chars + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp @@ -3628,7 +3694,7 @@ Unscored articles will be counted as having a score of zero." (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) (defun gnus-thread-total-score (thread) - ;; This function find the total score of THREAD. + ;; This function find the total score of THREAD. (cond ((null thread) 0) ((consp thread) @@ -3862,7 +3928,7 @@ or a straight list of headers." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) gnus-tmp-replied @@ -3981,6 +4047,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-name group) (setq gnus-newsgroup-unselected nil) (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) + (gnus-summary-setup-default-charset) ;; Adjust and set lists of article marks. (when info @@ -4168,7 +4235,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." out)) (defun gnus-adjust-marked-articles (info) - "Set all article lists and remove all marks that are no longer legal." + "Set all article lists and remove all marks that are no longer valid." (let* ((marked-lists (gnus-info-marks info)) (active (gnus-active (gnus-info-group info))) (min (car active)) @@ -4228,13 +4295,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." (uncompressed '(score bookmark killed)) type list newmarked symbol delta-marks) (when info - ;; Add all marks lists that are non-nil to the list of marks lists. + ;; Add all marks lists to the list of marks lists. (while (setq type (pop types)) - (when (setq list (symbol-value + (setq list (symbol-value (setq symbol (intern (format "gnus-newsgroup-%s" (car type)))))) + (when list ;; Get rid of the entries of the articles that have the ;; default score. (when (and (eq (cdr type) 'score) @@ -4249,14 +4317,32 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr prev (cdr arts)) (setq prev arts)) (setq arts (cdr arts))) - (setq list (cdr all)))) - - (push (cons (cdr type) - (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence - (set symbol (sort list '<)) t))) - newmarked))) - + (setq list (cdr all))))) + + (or (memq (cdr type) uncompressed) + (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) + + (when (gnus-check-backend-function 'request-set-mark + gnus-newsgroup-name) + ;; uncompressed:s are not proper flags (they are cons cells) + ;; cache is a internal gnus flag + (unless (memq (cdr type) (cons 'cache uncompressed)) + (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) + (del (gnus-remove-from-range (gnus-copy-sequence old) list)) + (add (gnus-remove-from-range (gnus-copy-sequence list) old))) + (if add + (push (list add 'add (list (cdr type))) delta-marks)) + (if del + (push (list del 'del (list (cdr type))) delta-marks))))) + + (when list + (push (cons (cdr type) list) newmarked))) + + (when delta-marks + (unless (gnus-check-group gnus-newsgroup-name) + (error "Can't open server for %s" gnus-newsgroup-name)) + (gnus-request-set-mark gnus-newsgroup-name delta-marks)) + ;; Enter these new marks into the info of the group. (if (nthcdr 3 info) (setcar (nthcdr 3 info) newmarked) @@ -4405,7 +4491,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (active (gnus-active group)) ninfo) (when entry - ;; First peel off all illegal article numbers. + ;; First peel off all invalid article numbers. (when active (let ((ids articles) id first) @@ -4474,15 +4560,6 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Update the group buffer. (gnus-group-update-group group t))))) -(defun gnus-methods-equal-p (m1 m2) - (let ((m1 (or m1 gnus-select-method)) - (m2 (or m2 gnus-select-method))) - (or (equal m1 m2) - (and (eq (car m1) (car m2)) - (or (not (memq 'address (assoc (symbol-name (car m1)) - gnus-valid-select-methods))) - (equal (nth 1 m1) (nth 1 m2))))))) - (defvar gnus-newsgroup-none-id 0) (defun gnus-get-newsgroup-headers (&optional dependencies force-new) @@ -4491,7 +4568,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (or dependencies (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) - headers id end ref) + headers id end ref + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (save-excursion (set-buffer gnus-summary-buffer) + gnus-newsgroup-ignored-charsets))) (save-excursion (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. @@ -4644,7 +4725,9 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) - (let ((cur nntp-server-buffer) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) + (cur nntp-server-buffer) (dependencies (or dependencies gnus-newsgroup-dependencies)) number headers header) (save-excursion @@ -4820,7 +4903,8 @@ executed with point over the summary line of the articles." `(let ((,articles (gnus-summary-work-articles ,arg))) (while ,articles (gnus-summary-goto-subject (car ,articles)) - ,@forms)))) + ,@forms + (pop ,articles))))) (put 'gnus-summary-iterate 'lisp-indent-function 1) (put 'gnus-summary-iterate 'edebug-form-spec '(form body)) @@ -5181,6 +5265,10 @@ If FORCE (the prefix), also save the .newsrc file(s)." gnus-exit-group-hook is called with no arguments if that value is non-nil." (interactive) (gnus-set-global-variables) + (when (gnus-buffer-live-p gnus-article-buffer) + (save-excursion + (set-buffer gnus-article-buffer) + (mm-destroy-parts gnus-article-mime-handles))) (gnus-kill-save-kill-buffer) (gnus-async-halt-prefetch) (let* ((group gnus-newsgroup-name) @@ -5188,6 +5276,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (mode major-mode) (group-point nil) (buf (current-buffer))) + (unless quit-config + ;; Do adaptive scoring, and possibly save score files. + (when gnus-newsgroup-adaptive + (gnus-score-adaptive)) + (when gnus-use-scoring + (gnus-score-save))) (gnus-run-hooks 'gnus-summary-prepare-exit-hook) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer @@ -5206,12 +5300,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." ;; Make all changes in this group permanent. (unless quit-config (gnus-run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info) - ;; Do adaptive scoring, and possibly save score files. - (when gnus-newsgroup-adaptive - (gnus-score-adaptive)) - (when gnus-use-scoring - (gnus-score-save))) + (gnus-summary-update-info)) (gnus-close-group group) ;; Make sure where we were, and go to next newsgroup. (set-buffer gnus-group-buffer) @@ -5226,10 +5315,6 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (setq group-point (point)) (if temporary nil ;Nothing to do. - (when (gnus-buffer-live-p gnus-article-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5273,8 +5358,9 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) - (gnus-run-hooks (delq 'gnus-summary-expire-articles - (copy-list gnus-summary-prepare-exit-hook))) + (mapcar 'funcall + (delq 'gnus-summary-expire-articles + (copy-list gnus-summary-prepare-exit-hook))) (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) @@ -5447,8 +5533,7 @@ in." (defun gnus-summary-describe-briefly () "Describe summary mode commands briefly." (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) + (gnus-message 6 (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. @@ -5668,7 +5753,9 @@ be displayed." ;; The requested article is different from the current article. (prog1 (gnus-summary-display-article article all-headers) - (setq did article)) + (setq did article) + (when (or all-headers gnus-show-all-headers) + (gnus-article-show-all-headers))) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) 'old)) @@ -6086,7 +6173,7 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." - (interactive "nTime in days: \nP") + (interactive "nLimit to articles older than (in days): \nP") (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -6104,6 +6191,30 @@ articles that are younger than AGE days." (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) +(defun gnus-summary-limit-to-extra (header regexp) + "Limit the summary buffer to articles that match an 'extra' header." + (interactive + (let ((header + (intern + (gnus-completing-read + (symbol-name (car gnus-extra-headers)) + "Score extra header:" + (mapcar (lambda (x) + (cons (symbol-name x) x)) + gnus-extra-headers) + nil + t)))) + (list header + (read-string (format "Limit to header %s (regexp): " header))))) + (when (not (equal "" regexp)) + (prog1 + (let ((articles (gnus-summary-find-matching + (cons 'extra header) regexp 'all))) + (unless articles + (error "Found no matches for \"%s\"" regexp)) + (gnus-summary-limit articles)) + (gnus-summary-position-point)))) + (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) @@ -6643,11 +6754,14 @@ to guess what the document format is." (delete-matching-lines "^\\(Path\\):\\|^From ") (widen)) (unwind-protect - (if (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type - ,(if force 'digest 'guess))) t) - ;; Make all postings to this group go to the parent group. + (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) + (gnus-newsgroup-ephemeral-ignored-charsets + gnus-newsgroup-ignored-charsets)) + (gnus-group-read-ephemeral-group + name `(nndoc ,name (nndoc-address ,(get-buffer dig)) + (nndoc-article-type + ,(if force 'digest 'guess))) t)) + ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) params) ;; Couldn't select this doc group. @@ -6755,7 +6869,6 @@ Optional argument BACKWARD means do search for backward. (require 'gnus-async) (require 'gnus-art) (let ((gnus-select-article-hook nil) ;Disable hook. - (gnus-article-display-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. @@ -6820,11 +6933,18 @@ in the comparisons." (let ((data (if (eq backward 'all) gnus-newsgroup-data (gnus-data-find-list (gnus-summary-article-number) (gnus-data-list backward)))) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) - articles d) - (unless (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) + articles d func) + (if (consp header) + (if (eq (car header) 'extra) + (setq func + `(lambda (h) + (or (cdr (assq ',(cdr header) (mail-header-extra h))) + ""))) + (error "%s is an invalid header" header)) + (unless (fboundp (intern (concat "mail-header-" header))) + (error "%s is not a valid header" header)) + (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) (while data (setq d (car data)) (and (or (not unread) ; We want all articles... @@ -6893,7 +7013,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." If N is negative, print the N previous articles. If N is nil and articles have been marked with the process mark, print these instead. -If the optional second argument FILENAME is nil, send the image to the +If the optional first argument FILENAME is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." @@ -6938,12 +7058,16 @@ article massaging functions being run." (require 'gnus-art) ;; Bind the article treatment functions to nil. (let ((gnus-have-all-headers t) - gnus-article-display-hook gnus-article-prepare-hook gnus-article-decode-hook gnus-display-mime-function gnus-break-pages gnus-visual) + ;; Destroy any MIME parts. + (when (gnus-buffer-live-p gnus-article-buffer) + (save-excursion + (set-buffer gnus-article-buffer) + (mm-destroy-parts gnus-article-mime-handles))) (gnus-summary-select-article nil 'force))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -6968,25 +7092,31 @@ If ARG is a negative number, hide the unwanted header lines." (interactive "P") (save-excursion (set-buffer gnus-article-buffer) - (let* ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden (text-property-any - (goto-char (point-min)) (search-forward "\n\n") - 'invisible t)) - e) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (1- (point)))) - (goto-char (point-min)) - (save-excursion - (set-buffer gnus-original-article-buffer) + (save-restriction + (let* ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + hidden e) + (save-restriction + (article-narrow-to-head) + (setq hidden (gnus-article-hidden-text-p 'headers))) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (delete-region (point-min) (1- (point)))) (goto-char (point-min)) - (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) - (insert-buffer-substring gnus-original-article-buffer 1 e) - (let ((article-inhibit-hiding t)) - (gnus-run-hooks 'gnus-article-display-hook)) - (when (or (not hidden) (and (numberp arg) (< arg 0))) - (gnus-article-hide-headers))))) + (save-excursion + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) + (insert-buffer-substring gnus-original-article-buffer 1 e) + (save-restriction + (narrow-to-region (point-min) (point)) + (article-decode-encoded-words) + (if (or hidden + (and (numberp arg) (< arg 0))) + (let ((gnus-treat-hide-headers nil) + (gnus-treat-hide-boring-headers nil)) + (gnus-treat-article 'head)) + (gnus-treat-article 'head))))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -7149,7 +7279,8 @@ and `request-accept' functions." (entry (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) - (to-group (gnus-info-group info))) + (to-group (gnus-info-group info)) + to-marks) ;; Update the group that has been moved to. (when (and info (memq action '(move copy))) @@ -7157,6 +7288,7 @@ and `request-accept' functions." (push to-group to-groups)) (unless (memq article gnus-newsgroup-unreads) + (push 'read to-marks) (gnus-info-set-read info (gnus-add-to-range (gnus-info-read info) (list (cdr art-group))))) @@ -7169,10 +7301,6 @@ and `request-accept' functions." (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) @@ -7188,6 +7316,7 @@ and `request-accept' functions." (when (memq article (symbol-value (intern (format "gnus-newsgroup-%s" (caar marks))))) + (push (cdar marks) to-marks) ;; If the other group is the same as this group, ;; then we have to add the mark to the list. (when (equal to-group gnus-newsgroup-name) @@ -7201,6 +7330,10 @@ and `request-accept' functions." to-group (cdar marks) (list to-article) info)) (setq marks (cdr marks))) + (gnus-request-set-mark to-group (list (list (list to-article) + 'set + to-marks))) + (gnus-dribble-enter (concat "(gnus-group-set-info '" (gnus-prin1-to-string (gnus-get-info to-group)) @@ -7368,6 +7501,8 @@ This will be the case if the article has both been mailed and posted." ;; There are expirable articles in this group, so we run them ;; through the expiry process. (gnus-message 6 "Expiring articles...") + (unless (gnus-check-group gnus-newsgroup-name) + (error "Can't open server for %s" gnus-newsgroup-name)) ;; The list of articles that weren't expired is returned. (save-excursion (if expiry-wait @@ -7449,20 +7584,23 @@ groups." (interactive "P") (save-excursion (set-buffer gnus-summary-buffer) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - ;; Select article if needed. - (unless (eq (gnus-summary-article-number) - gnus-current-article) - (gnus-summary-select-article t)) - (gnus-article-date-original) - (gnus-article-edit-article - `(lambda (no-highlight) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) + (gnus-set-global-variables) + (when (and (not force) + (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing")) + (gnus-summary-show-article t) + (gnus-article-edit-article + 'mime-to-mml + `(lambda (no-highlight) + (let ((mail-parse-charset ',gnus-newsgroup-charset) + (mail-parse-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + (mml-to-mime) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))))) (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) @@ -7473,12 +7611,11 @@ groups." ;; Replace the article. (let ((buf (current-buffer))) (with-temp-buffer - (insert-buffer buf) + (insert-buffer-substring buf) (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) - (current-buffer) - (not gnus-article-decoded-p)))) + (current-buffer) t))) (error "Couldn't replace article") ;; Update the summary buffer. (if (and references @@ -7516,7 +7653,8 @@ groups." (unless no-highlight (save-excursion (set-buffer gnus-article-buffer) - (gnus-run-hooks 'gnus-article-display-hook) + ;;;!!! Fix this -- article should be rehighlighted. + ;;;(gnus-run-hooks 'gnus-article-display-hook) (set-buffer gnus-original-article-buffer) (gnus-request-article (cdr gnus-article-current) @@ -7838,7 +7976,6 @@ returned." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -7884,7 +8021,6 @@ marked." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -8016,7 +8152,8 @@ returned." The difference between N and the actual number of articles marked is returned." (interactive "p") - (gnus-summary-mark-forward (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) + (gnus-summary-mark-forward + (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) (defun gnus-summary-mark-as-read (&optional article mark) "Mark current article as read. @@ -8299,25 +8436,15 @@ is non-nil or the Subject: of both articles are the same." (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) - ;; We don't want the article to be marked as read. - (let (gnus-mark-article-hook) - (gnus-summary-select-article t t nil current-article)) - (set-buffer gnus-original-article-buffer) - (let ((buf (format "%s" (buffer-string)))) - (with-temp-buffer - (insert buf) - (goto-char (point-min)) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n")) - (unless (gnus-request-replace-article - current-article (car gnus-article-current) - (current-buffer)) - (error "Couldn't replace article")))) + (gnus-with-article current-article + (goto-char (point-min)) + (if (re-search-forward "^References: " nil t) + (progn + (re-search-forward "^[^ \t]" nil t) + (forward-line -1) + (end-of-line) + (insert " " message-id)) + (insert "References: " message-id "\n"))) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) @@ -8551,11 +8678,17 @@ Argument REVERSE means reverse order." (gnus-summary-sort 'score reverse)) (defun gnus-summary-sort-by-lines (&optional reverse) - "Sort the summary buffer by article length. + "Sort the summary buffer by the number of lines. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'lines reverse)) +(defun gnus-summary-sort-by-chars (&optional reverse) + "Sort the summary buffer by article length. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'chars reverse)) + (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) @@ -8592,10 +8725,9 @@ The variable `gnus-default-article-saver' specifies the saver function." (save-buffer (save-excursion (nnheader-set-temp-buffer " *Gnus Save*"))) (num (length articles)) - header article file) - (while articles - (setq header (gnus-summary-article-header - (setq article (pop articles)))) + header file) + (dolist (article articles) + (setq header (gnus-summary-article-header article)) (if (not (vectorp header)) ;; This is a pseudo-article. (if (assq 'name header) @@ -8725,17 +8857,14 @@ save those articles instead." split-name)) ((consp result) (setq split-name (append result split-name))))))))) - split-name)) + (nreverse split-name))) (defun gnus-valid-move-group-p (group) (and (boundp group) (symbol-name group) (symbol-value group) - (memq 'respool - (assoc (symbol-name - (car (gnus-find-method-for-group - (symbol-name group)))) - gnus-valid-select-methods)))) + (gnus-get-function (gnus-find-method-for-group + (symbol-name group)) 'request-accept-article t))) (defun gnus-read-move-group-name (prompt default articles prefix) "Read a group name." @@ -8786,6 +8915,41 @@ save those articles instead." (error "No such group: %s" to-newsgroup))) to-newsgroup)) +(defun gnus-summary-save-parts (type dir n reverse) + "Save parts matching TYPE to DIR. +If REVERSE, save parts that do not match TYPE." + (interactive + (list (read-string "Save parts of type: " "image/.*") + (read-file-name "Save to directory: " t nil t) + current-prefix-arg)) + (gnus-summary-iterate n + (let ((gnus-display-mime-function nil) + (gnus-inhibit-treatment t)) + (gnus-summary-select-article)) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (when handles + (gnus-summary-save-parts-1 type dir handles reverse) + (mm-destroy-parts handles)))))) + +(defun gnus-summary-save-parts-1 (type dir handle reverse) + (if (stringp (car handle)) + (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse)) + (cdr handle)) + (when (if reverse + (not (string-match type (car (mm-handle-type handle)))) + (string-match type (car (mm-handle-type handle)))) + (let ((file (expand-file-name + (file-name-nondirectory + (or + (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (concat gnus-newsgroup-name "." gnus-current-article))) + dir))) + (unless (file-exists-p file) + (mm-save-part-to-file handle file)))))) + ;; Summary extract commands (defun gnus-summary-insert-pseudos (pslist &optional not-view) @@ -9076,6 +9240,16 @@ save those articles instead." (gnus-info-set-read ',info ',(gnus-info-read info)) (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) + ;; Propagate the read marks to the backend. + (if (gnus-check-backend-function 'request-set-mark group) + (let ((del (gnus-remove-from-range (gnus-info-read info) read)) + (add (gnus-remove-from-range read (gnus-info-read info)))) + (when (or add del) + (unless (gnus-check-group group) + (error "Can't open server for %s" group)) + (gnus-request-set-mark + group (delq nil (list (if add (list add 'add '(read))) + (if del (list del 'del '(read))))))))) ;; Enter this list into the group info. (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. @@ -9110,6 +9284,195 @@ save those articles instead." (gnus-summary-exit)) buffers))))) +(defun gnus-summary-setup-default-charset () + "Setup newsgroup default charset." + (let* ((name (and gnus-newsgroup-name + (gnus-group-real-name gnus-newsgroup-name))) + (ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name + 'ignored-charsets t) + (let ((alist gnus-group-ignored-charsets-alist) + elem (charsets nil)) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charsets (cdr elem)))) + charsets)))) + gnus-newsgroup-ignored-charsets))) + (setq gnus-newsgroup-charset + (or gnus-newsgroup-ephemeral-charset + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name + 'charset) + (let ((alist gnus-group-charset-alist) + elem (charset nil)) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charset (cadr elem)))) + charset))) + gnus-default-charset)) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + ignored-charsets))) + +;;; +;;; Mime Commands +;;; + +(defun gnus-summary-display-buttonized (&optional show-all-parts) + "Display the current article buffer fully MIME-buttonized. +If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are +treated as multipart/mixed." + (interactive "P") + (require 'gnus-art) + (let ((gnus-unbuttonized-mime-types nil) + (gnus-mime-display-multipart-as-mixed show-all-parts)) + (gnus-summary-show-article))) + +(defun gnus-summary-repair-multipart (article) + "Add a Content-Type header to a multipart article without one." + (interactive (list (gnus-summary-article-number))) + (gnus-with-article article + (message-narrow-to-head) + (goto-char (point-max)) + (widen) + (when (search-forward "\n--" nil t) + (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) + (message-narrow-to-head) + (message-remove-header "Mime-Version") + (message-remove-header "Content-Type") + (goto-char (point-max)) + (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" + separator)) + (insert "Mime-Version: 1.0\n") + (widen)))) + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil article))) + +(defun gnus-summary-toggle-display-buttonized () + "Toggle the buttonizing of the article buffer." + (interactive) + (require 'gnus-art) + (if (setq gnus-inhibit-mime-unbuttonizing + (not gnus-inhibit-mime-unbuttonizing)) + (let ((gnus-unbuttonized-mime-types nil)) + (gnus-summary-show-article)) + (gnus-summary-show-article))) + +;;; +;;; with article +;;; + +(defmacro gnus-with-article (article &rest forms) + "Select ARTICLE and perform FORMS in the original article buffer. +Then replace the article with the result." + `(progn + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil ,article)) + (set-buffer gnus-original-article-buffer) + ,@forms + (if (not (gnus-check-backend-function + 'request-replace-article (car gnus-article-current))) + (gnus-message 5 "Read-only group; not replacing") + (unless (gnus-request-replace-article + ,article (car gnus-article-current) + (current-buffer) t) + (error "Couldn't replace article"))) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))))) + +(put 'gnus-with-article 'lisp-indent-function 1) +(put 'gnus-with-article 'edebug-form-spec '(form body)) + +;;; +;;; Generic summary marking commands +;;; + +(defvar gnus-summary-marking-alist + '((read gnus-del-mark "d") + (unread gnus-unread-mark "u") + (ticked gnus-ticked-mark "!") + (dormant gnus-dormant-mark "?") + (expirable gnus-expirable-mark "e")) + "An alist of names/marks/keystrokes.") + +(defvar gnus-summary-generic-mark-map (make-sparse-keymap)) +(defvar gnus-summary-mark-map) + +(defun gnus-summary-make-all-marking-commands () + (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map) + (dolist (elem gnus-summary-marking-alist) + (apply 'gnus-summary-make-marking-command elem))) + +(defun gnus-summary-make-marking-command (name mark keystroke) + (let ((map (make-sparse-keymap))) + (define-key gnus-summary-generic-mark-map keystroke map) + (dolist (lway `((next "next" next nil "n") + (next-unread "next unread" next t "N") + (prev "previous" prev nil "p") + (prev-unread "previous unread" prev t "P") + (nomove "" nil nil ,keystroke))) + (let ((func (gnus-summary-make-marking-command-1 + mark (car lway) lway name))) + (setq func (eval func)) + (define-key map (nth 4 lway) func))))) + +(defun gnus-summary-make-marking-command-1 (mark way lway name) + `(defun ,(intern + (format "gnus-summary-put-mark-as-%s%s" + name (if (eq way 'nomove) + "" + (concat "-" (symbol-name way))))) + (n) + ,(format + "Mark the current article as %s%s. +If N, the prefix, then repeat N times. +If N is negative, move in reverse order. +The difference between N and the actual number of articles marked is +returned." + name (cadr lway)) + (interactive "p") + (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) + +(defun gnus-summary-generic-mark (n mark move unread) + "Mark N articles with MARK." + (unless (eq major-mode 'gnus-summary-mode) + (error "This command can only be used in the summary buffer")) + (gnus-summary-show-thread) + (let ((nummove + (cond + ((eq move 'next) 1) + ((eq move 'prev) -1) + (t 0)))) + (if (zerop nummove) + (setq n 1) + (when (< n 0) + (setq n (abs n) + nummove (* -1 nummove)))) + (while (and (> n 0) + (gnus-summary-mark-article nil mark) + (zerop (gnus-summary-next-subject nummove unread t))) + (setq n (1- n))) + (when (/= 0 n) + (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) + (gnus-summary-recenter) + (gnus-summary-position-point) + (gnus-set-mode-line 'summary) + n)) + +(gnus-summary-make-all-marking-commands) + (gnus-ems-redefine) (provide 'gnus-sum)