X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=08e56baa80791b774327386b969d4a1c404027d7;hb=bdabbfed3335a47469d394c934e0b796f27fcabc;hp=1cbd476bbfaf88ea436ec3946a6952345300bcc2;hpb=3c7ebb5757218763ad5f2d74d5001681f578adbe;p=gnus diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 1cbd476bb..08e56baa8 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996-2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -35,7 +36,13 @@ (require 'gnus-undo) (require 'gnus-util) (require 'mm-decode) +;; Recursive :-(. +;; (require 'gnus-art) +(require 'nnoo) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-cache-write-active "gnus-cache") +(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) +(autoload 'mm-uu-dissect "mm-uu") (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -344,7 +351,9 @@ variable." (defcustom gnus-move-split-methods nil "*Variable used to suggest where articles are to be moved to. -It uses the same syntax as the `gnus-split-methods' variable." +It uses the same syntax as the `gnus-split-methods' variable. +However, whereas `gnus-split-methods' specifies file names as targets, +this variable specifies group names." :group 'gnus-summary-mail :type '(repeat (choice (list :value (fun) function) (cons :value ("" "") regexp (repeat string)) @@ -485,11 +494,13 @@ It uses the same syntax as the `gnus-split-methods' variable." gnus-low-score-mark gnus-ancient-mark gnus-read-mark gnus-souped-mark gnus-duplicate-mark) "*The list of marks converted into expiration if a group is auto-expirable." + :version "21.1" :group 'gnus-summary :type '(repeat character)) (defcustom gnus-inhibit-user-auto-expire t "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." + :version "21.1" :group 'gnus-summary :type 'boolean) @@ -550,6 +561,7 @@ with some simple extensions: (defcustom gnus-list-identifiers nil "Regexp that matches list identifiers to be removed from subject. This can also be a list of regexps." + :version "21.1" :group 'gnus-summary-format :group 'gnus-article-hiding :type '(choice (const :tag "none" nil) @@ -628,6 +640,7 @@ This variable is local to the summary buffers." (defcustom gnus-summary-mode-hook nil "*A hook for Gnus summary mode. This hook is run before any variables are set in the summary buffer." + :options '(turn-on-gnus-mailing-list-mode) :group 'gnus-summary-various :type 'hook) @@ -803,12 +816,14 @@ which it may alter in any way.") (defcustom gnus-extra-headers nil "*Extra headers to parse." + :version "21.1" :group 'gnus-summary :type '(repeat symbol)) (defcustom gnus-ignored-from-addresses (and user-mail-address (regexp-quote user-mail-address)) "*Regexp of From headers that may be suppressed in favor of To headers." + :version "21.1" :group 'gnus-summary :type 'regexp) @@ -835,10 +850,11 @@ which it may alter in any way.") "List of charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." + :version "21.1" :type '(repeat symbol) :group 'gnus-charset) -(defcustom gnus-group-ignored-charsets-alist +(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 @@ -850,11 +866,12 @@ default charset will be used instead." (defcustom gnus-group-highlight-words-alist nil "Alist of group regexps and highlight regexps. This variable uses the same syntax as `gnus-emphasis-alist'." + :version "21.1" :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" + (symbol :tag "Face" gnus-emphasis-highlight-words))))) :group 'gnus-summary-visual) @@ -864,19 +881,50 @@ This variable uses the same syntax as `gnus-emphasis-alist'." The article will be shown with the charset corresponding to the numbered argument. For example: ((1 . cn-gb-2312) (2 . big5))." + :version "21.1" :type '(repeat (cons (number :tag "Argument" 1) (symbol :tag "Charset"))) :group 'gnus-charset) (defcustom gnus-preserve-marks t "Whether marks are preserved when moving, copying and respooling messages." + :version "21.1" :type 'boolean :group 'gnus-summary-marks) +(defcustom gnus-alter-articles-to-read-function nil + "Function to be called to alter the list of articles to be selected." + :type 'function + :group 'gnus-summary) + +(defcustom gnus-orphan-score nil + "*All orphans get this score added. Set in the score file." + :group 'gnus-score-default + :type '(choice (const nil) + integer)) + +(defcustom gnus-summary-save-parts-default-mime "image/.*" + "*A regexp to match MIME parts when saving multiple parts of a message +with gnus-summary-save-parts (X m). This regexp will be used by default +when prompting the user for which type of files to save." + :group 'gnus-summary + :type 'regexp) + + +(defcustom gnus-summary-save-parts-default-mime "image/.*" + "*A regexp to match MIME parts when saving multiple parts of a message +with gnus-summary-save-parts (X m). This regexp will be used by default +when prompting the user for which type of files to save." + :group 'gnus-summary + :type 'regexp) + + ;;; Internal variables (defvar gnus-article-mime-handles nil) (defvar gnus-article-decoded-p nil) +(defvar gnus-article-charset nil) +(defvar gnus-article-ignored-charsets nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-page-broken nil) (defvar gnus-inhibit-mime-unbuttonizing nil) @@ -890,6 +938,12 @@ For example: ((1 . cn-gb-2312) (2 . big5))." (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number "Function called to sort the articles within a thread after it has been gathered together.") +(defvar gnus-summary-save-parts-type-history nil) +(defvar gnus-summary-save-parts-last-directory nil) + +(defvar gnus-summary-save-parts-type-history nil) +(defvar gnus-summary-save-parts-last-directory nil) + ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) (defvar gnus-newsgroup-selected-overlay nil) @@ -945,9 +999,9 @@ For example: ((1 . cn-gb-2312) (2 . big5))." ?c) (?u gnus-tmp-user-defined ?s) (?P (gnus-pick-line-number) ?d)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") + "An alist of format specifications that can appear in summary lines. +These are paired with what variables they correspond with, along with +the type of the variable (string, integer, character, etc).") (defvar gnus-summary-dummy-line-format-alist `((?S gnus-tmp-subject ?s) @@ -1067,6 +1121,8 @@ variable (string, integer, character, etc).") (defvar gnus-newsgroup-ephemeral-charset nil) (defvar gnus-newsgroup-ephemeral-ignored-charsets nil) +(defvar gnus-article-before-search nil) + (defconst gnus-summary-local-variables '(gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end @@ -1090,6 +1146,7 @@ variable (string, integer, character, etc).") gnus-score-alist gnus-current-score-file (gnus-summary-expunge-below . global) (gnus-summary-mark-below . global) + (gnus-orphan-score . global) gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient gnus-newsgroup-sparse gnus-newsgroup-process-stack @@ -1102,8 +1159,11 @@ variable (string, integer, character, etc).") gnus-newsgroup-charset) "Variables that are buffer-local to the summary buffers.") +(defvar gnus-newsgroup-variables nil + "Variables that have separate values in the newsgroups.") + ;; Byte-compiler warning. -(defvar gnus-article-mode-map) +(eval-when-compile (defvar gnus-article-mode-map)) ;; MIME stuff. @@ -1119,8 +1179,7 @@ whose names match REGEXP. For example: ((\"chinese\" . gnus-decode-encoded-word-string-by-guess) mail-decode-encoded-word-string - (\"chinese\" . rfc1843-decode-string)) -") + (\"chinese\" . rfc1843-decode-string))") (defvar gnus-decode-encoded-word-methods-cache nil) @@ -1147,7 +1206,7 @@ For example: ;; Subject simplification. (defun gnus-simplify-whitespace (str) - "Remove excessive whitespace." + "Remove excessive whitespace from STR." (let ((mystr str)) ;; Multiple spaces. (while (string-match "[ \t][ \t]+" mystr) @@ -1200,7 +1259,7 @@ The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. Whitespace is generally cleaned up, and miscellaneous leading/trailing matter is removed. Additional things can be deleted by setting -gnus-simplify-subject-fuzzy-regexp." +`gnus-simplify-subject-fuzzy-regexp'." (let ((case-fold-search t) (modified-tick)) (gnus-simplify-buffer-fuzzy-step "\t" " ") @@ -1436,7 +1495,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 - "x" gnus-summary-limit-to-extra + "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) @@ -1513,6 +1572,7 @@ increase the score of each group you read." "g" gnus-summary-show-article "s" gnus-summary-isearch-article "P" gnus-summary-print-article + "M" gnus-mailing-list-insinuate "t" gnus-article-babel) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) @@ -1525,12 +1585,17 @@ increase the score of each group you read." "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr "q" gnus-article-de-quoted-unreadable + "6" gnus-article-de-base64-unreadable + "Z" gnus-article-decode-HZ + "h" gnus-article-wash-html + "s" gnus-summary-force-verify-and-decrypt "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message - "t" gnus-article-hide-headers + "t" gnus-summary-toggle-header "v" gnus-summary-verbose-headers "H" gnus-article-strip-headers-in-body + "p" gnus-article-verify-x-pgp-sig "d" gnus-article-treat-dumbquotes) (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) @@ -1617,7 +1682,9 @@ increase the score of each group you read." "v" gnus-article-view-part "o" gnus-article-save-part "c" gnus-article-copy-part + "C" gnus-article-view-part-as-charset "e" gnus-article-externalize-part + "E" gnus-article-encrypt-body "i" gnus-article-inline-part "|" gnus-article-pipe-part)) @@ -1675,7 +1742,10 @@ increase the score of each group you read." ["Words" gnus-article-decode-mime-words t] ["Charset" gnus-article-decode-charset t] ["QP" gnus-article-de-quoted-unreadable t] - ["View all" gnus-mime-view-all-parts t]) + ["Base64" gnus-article-de-base64-unreadable t] + ["View all" gnus-mime-view-all-parts t] + ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] + ["Encrypt body" gnus-article-encrypt-body t]) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] @@ -1701,17 +1771,26 @@ increase the score of each group you read." ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["Rot 13" gnus-summary-caesar-message t] + ["Base64" gnus-article-de-base64-unreadable t] + ["Rot 13" gnus-summary-caesar-message + ;;:help "\"Caesar rotate\" article by 13" + ] ["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] ["Verbose header" gnus-summary-verbose-headers t] ["Toggle header" gnus-summary-toggle-header t] + ["Html" gnus-article-wash-html t] + ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] ["HZ" gnus-article-decode-HZ t]) ("Output" - ["Save in default format" gnus-summary-save-article t] - ["Save in file" gnus-summary-save-article-file t] + ["Save in default format" gnus-summary-save-article + ;;:help "Save article using default method" + ] + ["Save in file" gnus-summary-save-article-file + ;;:help "Save article in file" + ] ["Save in Unix mail format" gnus-summary-save-article-mail t] ["Save in MH folder" gnus-summary-save-article-folder t] ["Save in VM folder" gnus-summary-save-article-vm t] @@ -1742,7 +1821,9 @@ increase the score of each group you read." (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)]) ("Extract" - ["Uudecode" gnus-uu-decode-uu t] + ["Uudecode" gnus-uu-decode-uu + ;;:help "Decode uuencoded article(s)" + ] ["Uudecode and save" gnus-uu-decode-uu-and-save t] ["Unshar" gnus-uu-decode-unshar t] ["Unshar and save" gnus-uu-decode-unshar-and-save t] @@ -1762,6 +1843,7 @@ increase the score of each group you read." ["Fetch referenced articles" gnus-summary-refer-references t] ["Fetch current thread" gnus-summary-refer-thread t] ["Fetch article with id..." gnus-summary-refer-article t] + ["Setup Mailing List Params" gnus-mailing-list-insinuate t] ["Redisplay" gnus-summary-show-article t]))) (easy-menu-define gnus-summary-article-menu gnus-summary-mode-map "" @@ -1792,15 +1874,25 @@ increase the score of each group you read." (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" '("Post" - ["Post an article" gnus-summary-post-news t] - ["Followup" gnus-summary-followup t] - ["Followup and yank" gnus-summary-followup-with-original t] + ["Post an article" gnus-summary-post-news + ;;:help "Post an article" + ] + ["Followup" gnus-summary-followup + ;;:help "Post followup to this article" + ] + ["Followup and yank" gnus-summary-followup-with-original + ;;:help "Post followup to this article, quoting its contents" + ] ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article t] + ["Cancel article" gnus-summary-cancel-article + ;;:help "Cancel an article you posted" + ] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ["Wide reply" gnus-summary-wide-reply t] - ["Wide reply and yank" gnus-summary-wide-reply-with-original t] + ["Wide reply and yank" gnus-summary-wide-reply-with-original + ;;:help "Mail a reply, quoting this article" + ] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] ["Digest and mail" gnus-uu-digest-mail-forward t] @@ -1808,7 +1900,9 @@ increase the score of each group you read." ["Resend message" gnus-summary-resend-message t] ["Send bounced mail" gnus-summary-resend-bounced-mail t] ["Send a mail" gnus-summary-mail-other-window t] - ["Uuencode and post" gnus-uu-post-news t] + ["Uuencode and post" gnus-uu-post-news + ;;:help "Post a uuencoded article" + ] ["Followup via news" gnus-summary-followup-to-mail t] ["Followup via news and yank" gnus-summary-followup-to-mail-with-original t] @@ -1825,7 +1919,9 @@ increase the score of each group you read." ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup t] + ["Catchup" gnus-summary-catchup + ;;:help "Mark unread articles in this group as read" + ] ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] ["Catchup region" gnus-summary-mark-region-as-read t] @@ -1875,8 +1971,12 @@ increase the score of each group you read." gnus-newsgroup-process-stack] ["Save" gnus-summary-save-process-mark t])) ("Scroll article" - ["Page forward" gnus-summary-next-page t] - ["Page backward" gnus-summary-prev-page t] + ["Page forward" gnus-summary-next-page + ;;:help "Show next page of article" + ] + ["Page backward" gnus-summary-prev-page + ;;:help "Show previous page of article" + ] ["Line forward" gnus-summary-scroll-up t]) ("Move" ["Next unread article" gnus-summary-next-unread-article t] @@ -1927,10 +2027,14 @@ increase the score of each group you read." ["Customize group parameters" gnus-summary-customize-parameters t] ["Send a bug report" gnus-bug t] ("Exit" - ["Catchup and exit" gnus-summary-catchup-and-exit t] + ["Catchup and exit" gnus-summary-catchup-and-exit + ;;:help "Mark unread articles in this group as read, then exit" + ] ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] - ["Exit group" gnus-summary-exit t] + ["Exit group" gnus-summary-exit + ;;:help "Exit current group, return to group selection mode" + ] ["Exit group without updating" gnus-summary-exit-no-update t] ["Exit and goto next group" gnus-summary-next-group t] ["Exit and goto prev group" gnus-summary-prev-group t] @@ -1940,6 +2044,49 @@ increase the score of each group you read." (gnus-run-hooks 'gnus-summary-menu-hook))) +(defvar gnus-summary-tool-bar-map nil) + +;; Emacs 21 tool bar. Should be no-op otherwise. +(defun gnus-summary-make-tool-bar () + (if (and (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-summary-tool-bar-map)) + (setq gnus-summary-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + (tool-bar-add-item-from-menu + 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-post-news "post" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-followup "followup" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-reply "reply" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-save-article "save-art" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-uu-post-news "uu-post" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-catchup "catchup" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-exit "exit-summ" gnus-summary-mode-map) + tool-bar-map))) + (if gnus-summary-tool-bar-map + (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) + (defun gnus-score-set-default (var value) "A version of set that updates the GNU Emacs menu-bar." (set var value) @@ -2048,10 +2195,13 @@ The following commands are available: \\{gnus-summary-mode-map}" (interactive) - (when (gnus-visual-p 'summary-menu 'menu) - (gnus-summary-make-menu-bar)) (kill-all-local-variables) + (when (gnus-visual-p 'summary-menu 'menu) + (gnus-summary-make-menu-bar) + (gnus-summary-make-tool-bar)) (gnus-summary-make-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-make-local-variables)) (gnus-make-thread-indent-array) (gnus-simplify-mode-line) (setq major-mode 'gnus-summary-mode) @@ -2074,7 +2224,7 @@ The following commands are available: (make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-hooks 'gnus-summary-mode-hook) - (mm-enable-multibyte) + (mm-enable-multibyte-mule4) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -2411,12 +2561,13 @@ marks of articles." (defun gnus-restore-hidden-threads-configuration (config) "Restore hidden threads configuration from CONFIG." - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (eq (char-after) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r))))) + (save-excursion + (let (point buffer-read-only) + (while (setq point (pop config)) + (when (and (< point (point-max)) + (goto-char point) + (eq (char-after) ?\n)) + (subst-char-in-region point (1+ point) ?\n ?\r)))))) ;; Various summary mode internalish functions. @@ -2426,9 +2577,10 @@ marks of articles." (gnus-summary-next-page nil t)) (defun gnus-summary-set-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. + "Change the display table. +Odd characters have a tendency to mess +up nicely formatted displays - we make all possible glyphs +display only a single character." ;; We start from the standard display table, if any. (let ((table (or (copy-sequence standard-display-table) @@ -2472,9 +2624,9 @@ marks of articles." t))) (defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. + "Set the global equivalents of the buffer-local variables. +They are set to the latest values they had. These reflect the summary +buffer that was in action when the last article was fetched." (when (eq major-mode 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) @@ -2488,7 +2640,15 @@ marks of articles." (gac gnus-article-current) (reffed gnus-reffed-article-number) (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset)) + (default-charset gnus-newsgroup-charset) + vlist) + (let ((locals gnus-newsgroup-variables)) + (while locals + (if (consp (car locals)) + (push (eval (caar locals)) vlist) + (push (eval (car locals)) vlist)) + (setq locals (cdr locals))) + (setq vlist (nreverse vlist))) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2503,6 +2663,12 @@ marks of articles." gnus-reffed-article-number reffed gnus-current-score-file score-file gnus-newsgroup-charset default-charset) + (let ((locals gnus-newsgroup-variables)) + (while locals + (if (consp (car locals)) + (set (caar locals) (pop vlist)) + (set (car locals) (pop vlist))) + (setq locals (cdr locals)))) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -2580,7 +2746,7 @@ marks of articles." (let ((to (cdr (assq 'To (mail-header-extra header)))) (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (cond @@ -2632,9 +2798,8 @@ marks of articles." (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg)))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -2659,7 +2824,7 @@ marks of articles." (forward-line 1)))) (defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. + "Update summary line after change." (when (and gnus-summary-default-score (not gnus-summary-inhibit-highlight)) (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. @@ -3044,7 +3209,7 @@ If NO-DISPLAY, don't generate a summary buffer." result)) (defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by article number." + "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'." (let ((result threads)) (while threads (when (stringp (caar threads)) @@ -3280,7 +3445,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines (unless (eobp) - (nnheader-nov-field)) ; misc + (if (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field)) ; Xref (nnheader-nov-parse-extra)))) ; extra (widen)) @@ -3290,9 +3457,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (gnus-dependencies-add-header header dependencies force-new))) (defun gnus-build-get-header (id) - ;; Look through the buffer of NOV lines and find the header to - ;; ID. Enter this line into the dependencies hash table, and return - ;; the id of the parent article (if any). + "Look through the buffer of NOV lines and find the header to ID. +Enter this line into the dependencies hash table, and return +the id of the parent article (if any)." (let ((deps gnus-newsgroup-dependencies) found header) (prog1 @@ -3619,13 +3786,22 @@ If LINE, insert the rebuilt thread starting on line LINE." (1+ (gnus-point-at-eol)) (gnus-delete-line))))))) +(defun gnus-sort-threads-1 (threads func) + (sort (mapcar (lambda (thread) + (cons (car thread) + (and (cdr thread) + (gnus-sort-threads-1 (cdr thread) func)))) + threads) func)) + (defun gnus-sort-threads (threads) "Sort THREADS." (if (not gnus-thread-sort-functions) threads (gnus-message 8 "Sorting threads...") (prog1 - (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) + (gnus-sort-threads-1 + threads + (gnus-make-sort-function gnus-thread-sort-functions)) (gnus-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) @@ -3640,12 +3816,12 @@ If LINE, insert the rebuilt thread starting on line LINE." ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. + "Return header of first article in THREAD. +Note that THREAD must never, ever be anything else than a variable - +using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) @@ -3769,7 +3945,7 @@ Unscored articles will be counted as having a score of zero." (defvar gnus-tmp-root-expunged nil) (defvar gnus-tmp-dummy-line nil) -(defvar gnus-tmp-header) +(eval-when-compile (defvar gnus-tmp-header)) (defun gnus-extra-header (type &optional header) "Return the extra header of TYPE." (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header)))) @@ -3990,9 +4166,8 @@ or a straight list of headers." (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (setq beg-match (match-beginning 0)) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg-match))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -4062,13 +4237,17 @@ or a straight list of headers." gnus-list-identifiers (mapconcat 'identity gnus-list-identifiers " *\\|")))) (dolist (header gnus-newsgroup-headers) - (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)") + (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") (mail-header-subject header)) (mail-header-set-subject header (concat (substring (mail-header-subject header) - 0 (match-beginning 2)) + 0 (match-beginning 1)) + (or + (match-string 3 (mail-header-subject header)) + (match-string 5 (mail-header-subject header))) (substring (mail-header-subject header) - (match-end 2)))))))) + (match-end 1)))))))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. @@ -4093,7 +4272,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (progn ; Or we bug out. (when (equal major-mode 'gnus-summary-mode) (kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" + (error "Couldn't activate group %s: %s" group (gnus-status-message group)))) (unless (gnus-request-group group t) @@ -4209,7 +4388,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or gnus-newsgroup-headers t))))) (defun gnus-articles-to-read (group &optional read-all) - ;; Find out what articles the user wants to read. + "Find out what articles the user wants to read." (let* ((articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. @@ -4256,7 +4435,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (if (string-match "^[ \t]*$" input) number input))) (t number)) - (quit nil)))))) + (quit + (message "Quit getting the articles to read") + nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) select @@ -4276,6 +4457,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-sorted-intersection gnus-newsgroup-unreads (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (when gnus-alter-articles-to-read-function + (setq gnus-newsgroup-unreads + (sort + (funcall gnus-alter-articles-to-read-function + gnus-newsgroup-name gnus-newsgroup-unreads) + '<))) articles))) (defun gnus-killed-articles (killed articles) @@ -4387,9 +4574,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when (gnus-check-backend-function 'request-set-mark gnus-newsgroup-name) + ;; propagate flags to server, with the following exceptions: ;; uncompressed:s are not proper flags (they are cons cells) ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) + ;; download are local to one gnus installation (well) + ;; unsend are for nndraft groups only + ;; xxx: generality of this? this suits nnimap anyway + (unless (memq (cdr type) (append '(cache download unsend) + 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 @@ -4422,7 +4614,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr (nthcdr i info) nil))))))) (defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. + "Set the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." ;; Is this mode line one we keep updated? (when (and (memq where gnus-updated-mode-lines) @@ -4438,7 +4630,11 @@ If WHERE is `summary', the summary mode line format will be used." (let* ((mformat (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name gnus-newsgroup-name) + (gnus-tmp-group-name (gnus-group-name-decode + gnus-newsgroup-name + (gnus-group-name-charset + nil + gnus-newsgroup-name))) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) @@ -4634,7 +4830,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." gnus-newsgroup-dependencies))) headers id end ref (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case nil (set-buffer gnus-summary-buffer) (error)) @@ -4681,7 +4877,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; From. (progn (goto-char p) - (if (search-forward "\nfrom: " nil t) + (if (or (search-forward "\nfrom: " nil t) + (search-forward "\nfrom:" nil t)) (funcall gnus-decode-encoded-word-function (nnheader-header-value)) "(nobody)")) @@ -4786,8 +4983,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + "Parse the news overview data in the server buffer. +Return a 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)) @@ -5105,8 +5303,7 @@ articles with that subject. If BACKWARD, search backward instead." "Center point in window and redisplay frame. Also do horizontal recentering." (interactive "P") - (when (and nil - gnus-auto-center-summary + (when (and gnus-auto-center-summary (not (eq gnus-auto-center-summary 'vertical))) (gnus-horizontal-recenter)) (recenter n)) @@ -5135,10 +5332,22 @@ displayed, no centering will be performed." ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. - (set-window-start - window (min bottom (save-excursion - (forward-line (- top)) (point))) - t)) + (let ((top-pos (save-excursion (forward-line (- top)) (point)))) + (if (> bottom top-pos) + ;; Keep the second line from the top visible + (set-window-start window top-pos t) + ;; Try to keep the bottom line visible; if it's partially + ;; obscured, either scroll one more line to make it fully + ;; visible, or revert to using TOP-POS. + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (let ((last-line-start (point))) + (goto-char bottom) + (set-window-start window (point) t) + (when (not (pos-visible-in-window-p last-line-start window)) + (forward-line 1) + (set-window-start window (min (point) top-pos) t))))))) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) (not (eq gnus-auto-center-summary 'vertical))) @@ -5340,7 +5549,10 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles))) + (mm-destroy-parts gnus-article-mime-handles) + ;; Set it to nil for safety reason. + (setq gnus-article-mime-handle-alist nil) + (setq gnus-article-mime-handles nil))) (gnus-kill-save-kill-buffer) (gnus-async-halt-prefetch) (let* ((group gnus-newsgroup-name) @@ -5402,12 +5614,16 @@ If FORCE (the prefix), also save the .newsrc file(s)." ;; not garbage-collected, it seems. This would the lead to en ;; ever-growing Emacs. (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) ;; Return to group mode buffer. (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) @@ -5438,7 +5654,10 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles))) + (mm-destroy-parts gnus-article-mime-handles) + ;; Set it to nil for safety reason. + (setq gnus-article-mime-handle-alist nil) + (setq gnus-article-mime-handles nil))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5448,8 +5667,12 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-deaden-summary) (gnus-close-group group) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (when (get-buffer gnus-summary-buffer) (kill-buffer gnus-summary-buffer))) (unless gnus-single-article-buffer @@ -5776,7 +5999,15 @@ Given a prefix, will force an `article' buffer configuration." (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (mm-enable-multibyte-mule4))) (gnus-set-global-variables) + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (setq gnus-article-charset gnus-newsgroup-charset) + (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) + (mm-enable-multibyte-mule4))) (if (null article) nil (prog1 @@ -5826,6 +6057,10 @@ be displayed." ;; The requested article is different from the current article. (progn (gnus-summary-display-article article all-headers) + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (if (not gnus-article-decoded-p) ;; a local variable + (mm-disable-multibyte-mule4)))) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) (gnus-article-set-window-start @@ -5835,6 +6070,12 @@ be displayed." (gnus-article-show-all-headers)) 'old)))) +(defun gnus-summary-force-verify-and-decrypt () + (interactive) + (let ((mm-verify-option 'known) + (mm-decrypt-option 'known)) + (gnus-summary-select-article nil 'force))) + (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." nil) @@ -6252,7 +6493,7 @@ articles that are younger than AGE days." (while (not days-got) (setq days (if younger (read-string "Limit to articles within (in days): ") - (read-string "Limit to articles old than (in days): "))) + (read-string "Limit to articles older than (in days): "))) (when (> (length days) 0) (setq days (read days))) (if (numberp days) @@ -6285,12 +6526,12 @@ articles that are younger than AGE days." (let ((header (intern (gnus-completing-read - (symbol-name (car gnus-extra-headers)) - "Limit extra header:" - (mapcar (lambda (x) + (symbol-name (car gnus-extra-headers)) + "Limit extra header:" + (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) - nil + nil t)))) (list header (read-string (format "Limit to header %s (regexp): " header))))) @@ -6804,7 +7045,8 @@ of what's specified by the `gnus-refer-thread-limit' variable." ((eq 'current gnus-refer-article-method) (list gnus-current-select-method)) ;; List of select methods. - ((not (stringp (cadr gnus-refer-article-method))) + ((not (and (symbolp (car gnus-refer-article-method)) + (assq (car gnus-refer-article-method) nnoo-definition-alist))) (let (out) (dolist (method gnus-refer-article-method) (push (if (eq 'current method) @@ -6854,7 +7096,10 @@ to guess what the document format is." ;; the parent article. (when (setq to-address (or (message-fetch-field "reply-to") (message-fetch-field "from"))) - (setq params (append (list (cons 'to-address to-address))))) + (setq params (append + (list (cons 'to-address + (funcall gnus-decode-encoded-word-function + to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) ;; Remove lines that may lead nndoc to misinterpret the @@ -6957,10 +7202,14 @@ If BACKWARD, search backward instead." current-prefix-arg)) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) - (setq gnus-last-search-regexp regexp)) - (if (gnus-summary-search-article regexp backward) - (gnus-summary-show-thread) - (error "Search failed: \"%s\"" regexp))) + (setq gnus-last-search-regexp regexp) + (setq gnus-article-before-search gnus-current-article)) + ;; Intentionally set gnus-last-article. + (setq gnus-last-article gnus-article-before-search) + (let ((gnus-last-article gnus-last-article)) + (if (gnus-summary-search-article regexp backward) + (gnus-summary-show-thread) + (error "Search failed: \"%s\"" regexp)))) (defun gnus-summary-search-article-backward (regexp) "Search for an article containing REGEXP backward." @@ -7163,19 +7412,38 @@ to save in." (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. -If ARG (the prefix) is a number, show the article with the charset +If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset inputed. -If ARG (the prefix) is non-nil and not a number, show the raw article +If ARG (the prefix) is non-nil and not a number, show the raw article without any article massaging functions being run." (interactive "P") - (cond + (cond ((numberp arg) - (let ((gnus-newsgroup-charset + (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (read-coding-system "Charset: "))) (gnus-newsgroup-ignored-charsets 'gnus-all)) - (gnus-summary-select-article nil 'force))) + (gnus-summary-select-article nil 'force) + (let ((deps gnus-newsgroup-dependencies) + head header) + (save-excursion + (set-buffer gnus-original-article-buffer) + (save-restriction + (message-narrow-to-head) + (setq head (buffer-string))) + (with-temp-buffer + (insert (format "211 %d Article retrieved.\n" + (cdr gnus-article-current))) + (insert head) + (insert ".\n") + (let ((nntp-server-buffer (current-buffer))) + (setq header (car (gnus-get-newsgroup-headers deps t)))))) + (gnus-data-set-header + (gnus-data-find (cdr gnus-article-current)) + header) + (gnus-summary-update-article-line + (cdr gnus-article-current) header)))) ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) @@ -7194,7 +7462,10 @@ without any article massaging functions being run." (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles))) + (mm-destroy-parts gnus-article-mime-handles) + ;; Set it to nil for safety reason. + (setq gnus-article-mime-handle-alist nil) + (setq gnus-article-mime-handles nil))) (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -7226,7 +7497,7 @@ If ARG is a negative number, hide the unwanted header lines." (setq hidden (if (numberp arg) (>= arg 0) - (save-restriction + (save-restriction (article-narrow-to-head) (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) @@ -7445,7 +7716,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when gnus-preserve-marks + (when gnus-preserve-marks ;; Copy any marks over to the new group. (when (and (equal to-group gnus-newsgroup-name) (not (memq article gnus-newsgroup-unreads))) @@ -7588,7 +7859,7 @@ latter case, they will be copied into the relevant groups." (save-excursion (set-buffer (gnus-get-buffer-create " *import file*")) (erase-buffer) - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (unless (nnheader-article-p) ;; This doesn't look like an article, so we fudge some headers. @@ -7637,6 +7908,9 @@ This will be the case if the article has both been mailed and posted." (expiry-wait (if now 'immediate (gnus-group-find-parameter gnus-newsgroup-name 'expiry-wait))) + (nnmail-expiry-target + (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target) + nnmail-expiry-target)) es) (when expirable ;; There are expirable articles in this group, so we run them @@ -7652,19 +7926,19 @@ This will be the case if the article has both been mailed and posted." (setq es (gnus-request-expire-articles expirable gnus-newsgroup-name))) (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name)))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable))))) + expirable gnus-newsgroup-name))) + (unless total + (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (while expirable + (unless (memq (car expirable) es) + (when (gnus-data-find (car expirable)) + (gnus-summary-mark-article + (car expirable) gnus-canceled-mark))) + (setq expirable (cdr expirable)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -7691,6 +7965,8 @@ delete these instead." (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion")) + (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) + (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) not-deleted) @@ -7717,31 +7993,72 @@ delete these instead." (gnus-set-mode-line 'summary) not-deleted)) -(defun gnus-summary-edit-article (&optional force) +(defun gnus-summary-edit-article (&optional arg) "Edit the current article. This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only +If ARG is nil, edit the decoded articles. +If ARG is 1, edit the raw articles. +If ARG is 2, edit the raw articles even in read-only groups. +If ARG is 3, edit the articles with the current handles. +Otherwise, allow editing of articles even in read-only groups." (interactive "P") - (save-excursion - (set-buffer gnus-summary-buffer) - (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))))))) + (let (force raw current-handles) + (cond + ((null arg)) + ((eq arg 1) (setq raw t)) + ((eq arg 2) (setq raw t + force t)) + ((eq arg 3) (setq current-handles + (and (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (prog1 + gnus-article-mime-handles + (setq gnus-article-mime-handles nil)))))) + (t (setq force t))) + (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) + (error "Can't edit the raw article in group nndraft:drafts.")) + (save-excursion + (set-buffer gnus-summary-buffer) + (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) + (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer)) + (with-current-buffer gnus-article-buffer + (mm-enable-multibyte-mule4))) + (if (equal gnus-newsgroup-name "nndraft:drafts") + (setq raw t)) + (gnus-article-edit-article + (if raw 'ignore + `(lambda () + (let ((mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (mime-to-mml ,'current-handles) + (make-local-hook 'kill-buffer-hook) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))) + `(lambda (no-highlight) + (let ((mail-parse-charset ',gnus-newsgroup-charset) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + ,(if (not raw) '(progn + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + 'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list))) + (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) @@ -7749,10 +8066,31 @@ groups." no-highlight) "Make edits to the current article permanent." (interactive) + (save-excursion + ;; The buffer restriction contains the entire article if it exists. + (when (article-goto-body) + (let ((lines (count-lines (point) (point-max))) + (length (- (point-max) (point))) + (case-fold-search t) + (body (copy-marker (point)))) + (goto-char (point-min)) + (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string length))) + (goto-char (point-min)) + (when (re-search-forward + "^x-content-length:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string length))) + (goto-char (point-min)) + (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string lines)))))) ;; Replace the article. (let ((buf (current-buffer))) (with-temp-buffer (insert-buffer-substring buf) + (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) @@ -8501,6 +8839,37 @@ read." (gnus-summary-catchup all)) (gnus-summary-next-group)) +;;; +;;; 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)) + ;; Thread-based commands. (defun gnus-summary-articles-in-thread (&optional article) @@ -8579,14 +8948,16 @@ is non-nil or the Subject: of both articles are the same." (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) (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"))) + (save-restriction + (goto-char (point-min)) + (message-narrow-to-head) + (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) @@ -8793,14 +9164,14 @@ Argument REVERSE means reverse order." (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. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'subject reverse)) @@ -8827,7 +9198,7 @@ Argument REVERSE means reverse order." "Sort the summary buffer by article length. Argument REVERSE means reverse order." (interactive "P") - (gnus-summary-sort 'chars reverse)) + (gnus-summary-sort 'chars reverse)) (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." @@ -8838,6 +9209,8 @@ Argument REVERSE means reverse order." thread `(lambda (t1 t2) (,thread t2 t1)))) + (gnus-sort-gathered-threads-function + gnus-thread-sort-functions) (gnus-article-sort-functions (if (not reverse) article @@ -8917,7 +9290,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") - (let ((gnus-default-article-saver 'rmail-output-to-rmail-file)) + (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-file (&optional arg) @@ -8971,7 +9344,7 @@ save those articles instead." (set-buffer gnus-original-article-buffer) (save-restriction (nnheader-narrow-to-headers) - (while methods + (while (and methods (not split-name)) (goto-char (point-min)) (setq method (pop methods)) (setq match (car method)) @@ -8990,7 +9363,7 @@ save those articles instead." (save-restriction (widen) (setq result (eval match))))) - (setq split-name (append (cdr method) split-name)) + (setq split-name (cdr method)) (cond ((stringp result) (push (expand-file-name result gnus-article-save-directory) @@ -9059,8 +9432,14 @@ save those articles instead." "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: " nil nil t) + (list (read-string "Save parts of type: " + (or (car gnus-summary-save-parts-type-history) + gnus-summary-save-parts-default-mime) + 'gnus-summary-save-parts-type-history) + (setq gnus-summary-save-parts-last-directory + (read-file-name "Save to directory: " + gnus-summary-save-parts-last-directory + nil t)) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) @@ -9068,10 +9447,12 @@ If REVERSE, save parts that do not match TYPE." (gnus-summary-select-article)) (save-excursion (set-buffer gnus-article-buffer) - (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (let ((handles (or gnus-article-mime-handles + (mm-dissect-buffer) (mm-uu-dissect)))) (when handles (gnus-summary-save-parts-1 type dir handles reverse) - (mm-destroy-parts handles)))))) + (unless gnus-article-mime-handles ;; Don't destroy this case. + (mm-destroy-parts handles))))))) (defun gnus-summary-save-parts-1 (type dir handle reverse) (if (stringp (car handle)) @@ -9085,7 +9466,9 @@ If REVERSE, save parts that do not match TYPE." (or (mail-content-type-get (mm-handle-disposition handle) 'filename) - (concat gnus-newsgroup-name "." gnus-current-article))) + (concat gnus-newsgroup-name + "." (number-to-string + (cdr gnus-article-current))))) dir))) (unless (file-exists-p file) (mm-save-part-to-file handle file)))))) @@ -9279,8 +9662,8 @@ If REVERSE, save parts that do not match TYPE." ;;; (defun gnus-highlight-selected-summary () + "Highlight selected article in summary buffer." ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer (when gnus-summary-selected-face (save-excursion (let* ((beg (progn (beginning-of-line) (point))) @@ -9375,23 +9758,32 @@ If REVERSE, save parts that do not match TYPE." (if compute read (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (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))))))))) + (let (setmarkundo) + ;; Propagate the read marks to the backend. + (when (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)))))) + (setq setmarkundo + `(gnus-request-set-mark + ,group + ',(delq nil (list + (if del (list del 'add '(read))) + (if add (list add 'del '(read)))))))))) + (set-buffer gnus-group-buffer) + (gnus-undo-register + `(progn + (gnus-info-set-marks ',info ',(gnus-info-marks info) t) + (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) + ,setmarkundo)))) ;; Enter this list into the group info. (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. @@ -9432,7 +9824,7 @@ If REVERSE, save parts that do not match TYPE." (setq gnus-newsgroup-charset nil) (let* ((name (and gnus-newsgroup-name (gnus-group-real-name gnus-newsgroup-name))) - (ignored-charsets + (ignored-charsets (or gnus-newsgroup-ephemeral-ignored-charsets (append (and gnus-newsgroup-name @@ -9460,7 +9852,7 @@ If REVERSE, save parts that do not match TYPE." charset (cadr elem)))) charset))) gnus-default-charset)) - (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) ignored-charsets)))) ;;; @@ -9482,17 +9874,17 @@ treated as multipart/mixed." (interactive (list (gnus-summary-article-number))) (gnus-with-article article (message-narrow-to-head) + (message-remove-header "Mime-Version") (goto-char (point-max)) + (insert "Mime-Version: 1.0\n") (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))) @@ -9507,37 +9899,6 @@ treated as multipart/mixed." (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 ;;; @@ -9571,7 +9932,7 @@ Then replace the article with the result." (setq func (eval func)) (define-key map (nth 4 lway) func))))) -(defun gnus-summary-make-marking-command-1 (mark way lway name) +(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)