X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=cf346a1e72d68bcb7c9043f9259470fa00ebd334;hb=b14ba71ca00ad909b738bad1898f1908c0e6d2eb;hp=0a20c925031c69a0e512d920349130273b408416;hpb=7483433ffe08305cec0c4b369b1300cbbf616750;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 0a20c92..cf346a1 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -34,6 +34,7 @@ (require 'gnus-range) (require 'gnus-int) (require 'gnus-undo) +(require 'gnus-util) (require 'mime-view) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) @@ -221,10 +222,10 @@ to expose hidden threads." :group 'gnus-thread :type 'boolean) -(defcustom gnus-thread-ignore-subject nil - "*If non-nil, ignore subjects and do all threading based on the Reference header. -If nil, which is the default, articles that have different subjects -from their parents will start separate threads." +(defcustom gnus-thread-ignore-subject t + "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header. +If nil, articles that have different subjects from their parents will +start separate threads." :group 'gnus-thread :type 'boolean) @@ -255,8 +256,12 @@ equal will be included." (defcustom gnus-auto-select-first t "*If nil, don't select the first unread article when entering a group. If this variable is `best', select the highest-scored unread article -in the group. If neither nil nor `best', select the first 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 +`gnus-summary-best-unread-article'. If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in @@ -264,7 +269,10 @@ in some newsgroups, set the variable to nil in :group 'gnus-group-select :type '(choice (const :tag "none" nil) (const best) - (sexp :menu-tag "first" t))) + (sexp :menu-tag "first" t) + (function-item gnus-summary-first-unread-subject) + (function-item gnus-summary-first-unread-article) + (function-item gnus-summary-best-unread-article))) (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. @@ -285,7 +293,9 @@ will go to the next group without confirmation." (sexp :menu-tag "on" t))) (defcustom gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject." + "*If non-nil, select the next article with the same subject. +If there are no more articles with the same subject, go to +the first unread article." :group 'gnus-summary-maneuvering :type 'boolean) @@ -315,7 +325,7 @@ and non-`vertical', do both horizontal and vertical recentering." "*If non-nil, ignore articles with identical Message-ID headers." :group 'gnus-summary :type 'boolean) - + (defcustom gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." @@ -332,7 +342,7 @@ variable." (defcustom gnus-show-mime t "*If non-nil, do mime processing of articles. The articles will simply be fed to the function given by -`gnus-show-mime-method'." +`gnus-article-display-method-for-mime'." :group 'gnus-article-mime :type 'boolean) @@ -505,7 +515,7 @@ with some simple extensions. :group 'gnus-threading :type 'string) -(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" +(defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z" "*The format specification for the summary mode line. It works along the same lines as a normal formatting string, with some simple extensions: @@ -1007,6 +1017,25 @@ variable (string, integer, character, etc).") ;; Byte-compiler warning. (defvar gnus-article-mode-map) +;; MIME stuff. + +(defvar gnus-encoded-word-method-alist + '(("chinese" mail-decode-encoded-word-string rfc1843-decode-string) + (".*" mail-decode-encoded-word-string)) + "Alist of regexps (to match group names) and lists of functions to be applied.") + +(defun gnus-multi-decode-encoded-word-string (string) + "Apply the functions from `gnus-encoded-word-method-alist' that match." + (let ((alist gnus-encoded-word-method-alist) + elem) + (while (setq elem (pop alist)) + (when (string-match (car elem) gnus-newsgroup-name) + (pop elem) + (while elem + (setq string (funcall (pop elem) string))) + (setq alist nil))) + string)) + ;; Subject simplification. (defun gnus-simplify-whitespace (str) @@ -1149,7 +1178,7 @@ increase the score of each group you read." [delete] gnus-summary-prev-page [backspace] gnus-summary-prev-page "\r" gnus-summary-scroll-up - "\e\r" gnus-summary-scroll-down + "\M-\r" gnus-summary-scroll-down "n" gnus-summary-next-unread-article "p" gnus-summary-prev-unread-article "N" gnus-summary-next-article @@ -1245,6 +1274,7 @@ 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 "V" gnus-summary-score-map "X" gnus-uu-extract-map @@ -1356,6 +1386,7 @@ increase the score of each group you read." [delete] gnus-summary-prev-page "p" gnus-summary-prev-page "\r" gnus-summary-scroll-up + "\M-\r" gnus-summary-scroll-down "<" gnus-summary-beginning-of-article ">" gnus-summary-end-of-article "b" gnus-summary-beginning-of-article @@ -1390,6 +1421,7 @@ increase the score of each group you read." "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation + "C" gnus-article-hide-citation-in-followups "p" gnus-article-hide-pgp "P" gnus-article-hide-pem "\C-c" gnus-article-hide-citation-maybe) @@ -1435,6 +1467,7 @@ increase the score of each group you read." "c" gnus-summary-copy-article "B" gnus-summary-crosspost-article "q" gnus-summary-respool-query + "t" gnus-summary-respool-trace "i" gnus-summary-import-article "p" gnus-summary-article-posted-p) @@ -1556,6 +1589,7 @@ increase the score of each group you read." (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)] ["Query respool" gnus-summary-respool-query t] + ["Trace respool" gnus-summary-respool-trace t] ["Delete expirable articles" gnus-summary-expire-articles-now (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)]) @@ -1621,8 +1655,8 @@ increase the score of each group you read." ["Wide reply and yank" gnus-summary-wide-reply-with-original t] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] + ["Digest and mail" gnus-summary-mail-digest t] + ["Digest and post" gnus-summary-post-digest t] ["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] @@ -1739,9 +1773,10 @@ increase the score of each group you read." ["Edit local kill file" gnus-summary-edit-local-kill t] ["Edit main kill file" gnus-summary-edit-global-kill t] ["Edit group parameters" gnus-summary-edit-parameters t] + ["Send a bug report" gnus-bug t] ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] - ["Catchup all and exit" gnus-summary-catchup-and-exit t] + ["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 without updating" gnus-summary-exit-no-update t] @@ -1869,7 +1904,7 @@ The following commands are available: (setq mode-name "Summary") (make-local-variable 'minor-mode-alist) (use-local-map gnus-summary-mode-map) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (setq buffer-read-only t) ;Disable modification (setq truncate-lines t) (setq selective-display t) @@ -1980,21 +2015,26 @@ The following commands are available: (when list (let ((data (and after-article (gnus-data-find-list after-article))) (ilist list)) - (or data (not after-article) (error "No such article: %d" after-article)) - ;; Find the last element in the list to be spliced into the main - ;; list. - (while (cdr list) - (setq list (cdr list))) - (if (not data) - (progn - (setcdr list gnus-newsgroup-data) - (setq gnus-newsgroup-data ilist) + (if (not (or data + after-article)) + (let ((odata gnus-newsgroup-data)) + (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data)) (when offset - (gnus-data-update-list (cdr list) offset))) - (setcdr list (cdr data)) - (setcdr data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) + (gnus-data-update-list odata offset))) + ;; Find the last element in the list to be spliced into the main + ;; list. + (while (cdr list) + (setq list (cdr list))) + (if (not data) + (progn + (setcdr list gnus-newsgroup-data) + (setq gnus-newsgroup-data ilist) + (when offset + (gnus-data-update-list (cdr list) offset))) + (setcdr list (cdr data)) + (setcdr data ilist) + (when offset + (gnus-data-update-list (cdr list) offset)))) (setq gnus-newsgroup-data-reverse nil)))) (defun gnus-data-remove (article &optional offset) @@ -2023,21 +2063,11 @@ The following commands are available: (defun gnus-data-update-list (data offset) "Add OFFSET to the POS of all data entries in DATA." + (setq gnus-newsgroup-data-reverse nil) (while data (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) (setq data (cdr data)))) -(defun gnus-data-compute-positions () - "Compute the positions of all articles." - (let ((data gnus-newsgroup-data) - pos) - (while data - (when (setq pos (text-property-any - (point-min) (point-max) - 'gnus-number (gnus-data-number (car data)))) - (gnus-data-set-pos (car data) (+ pos 3))) - (setq data (cdr data))))) - (defun gnus-summary-article-pseudo-p (article) "Say whether this article is a pseudo article or not." (not (vectorp (gnus-data-header (gnus-data-find article))))) @@ -2205,6 +2235,21 @@ marks of articles." ,@forms) (gnus-restore-hidden-threads-configuration ,config))))) +(defun gnus-data-compute-positions () + "Compute the positions of all articles." + (setq gnus-newsgroup-data-reverse nil) + (let ((data gnus-newsgroup-data)) + (save-excursion + (gnus-save-hidden-threads + (gnus-summary-show-all-threads) + (goto-char (point-min)) + (while data + (while (get-text-property (point) 'gnus-intangible) + (forward-line 1)) + (gnus-data-set-pos (car data) (+ (point) 3)) + (setq data (cdr data)) + (forward-line 1)))))) + (defun gnus-hidden-threads-configuration () "Return the current hidden threads configuration." (save-excursion @@ -2265,8 +2310,7 @@ marks of articles." (setq gnus-summary-buffer (current-buffer)) (not gnus-newsgroup-prepared)) ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) - (gnus-add-current-to-buffer-list) + (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) (gnus-summary-mode group) (when gnus-carpal (gnus-carpal-setup-buffer 'summary)) @@ -2349,7 +2393,7 @@ marks of articles." (gnus-score-over-mark 130) (gnus-download-mark 131) (spec gnus-summary-line-format-spec) - thread gnus-visual pos) + gnus-visual pos) (save-excursion (gnus-set-work-buffer) (let ((gnus-summary-line-format-spec spec) @@ -2425,7 +2469,7 @@ marks of articles." (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property-excluding-characters-with-faces + (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number gnus-tmp-number) @@ -2511,7 +2555,8 @@ the thread are to be displayed." (set (car elem) (eval (nth 1 elem)))))))) (defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display backward) + kill-buffer no-display backward + select-articles) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. @@ -2522,8 +2567,10 @@ If NO-DISPLAY, don't generate a summary buffer." (let ((gnus-auto-select-next nil)) (or (gnus-summary-read-group-1 group show-all no-article - kill-buffer no-display) - (setq show-all nil))))) + kill-buffer no-display + select-articles) + (setq show-all nil + select-articles nil))))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) ;; The entry function called above goes to the next @@ -2537,7 +2584,8 @@ If NO-DISPLAY, don't generate a summary buffer." result)) (defun gnus-summary-read-group-1 (group show-all no-article - kill-buffer no-display) + kill-buffer no-display + &optional select-articles) ;; Killed foreign groups can't be entered. (when (and (not (gnus-group-native-p group)) (not (gnus-gethash group gnus-newsrc-hashtb))) @@ -2545,7 +2593,8 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup group show-all)))) + (did-select (and new-group (gnus-select-newsgroup + group show-all select-articles)))) (cond ;; This summary buffer exists already, so we just select it. ((not new-group) @@ -2660,16 +2709,21 @@ If NO-DISPLAY, don't generate a summary buffer." (not no-display) gnus-newsgroup-unreads gnus-auto-select-first) - (unless (if (eq gnus-auto-select-first 'best) - (gnus-summary-best-unread-article) - (gnus-summary-first-unread-article)) - (gnus-configure-windows 'summary)) + (progn + (gnus-configure-windows 'summary) + (cond + ((eq gnus-auto-select-first 'best) + (gnus-summary-best-unread-article)) + ((eq gnus-auto-select-first t) + (gnus-summary-first-unread-article)) + ((gnus-functionp gnus-auto-select-first) + (funcall gnus-auto-select-first)))) ;; Don't select any articles, just move point to the first ;; article in the group. (goto-char (point-min)) (gnus-summary-position-point) (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary)) + (gnus-set-mode-line 'summary)) (when (get-buffer-window gnus-group-buffer t) ;; Gotta use windows, because recenter does weird stuff if ;; the current buffer ain't the displayed window. @@ -2869,7 +2923,7 @@ If NO-DISPLAY, don't generate a summary buffer." threads)) ;; Build the thread tree. -(defun gnus-dependencies-add-header (header dependencies force-new) +(defsubst gnus-dependencies-add-header (header dependencies force-new) "Enter HEADER into the DEPENDENCIES table if it is not already there. If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even @@ -2948,8 +3002,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) + (gnus-summary-ignore-duplicates t) header references generation relations - cthread subject child end pthread relation new-child date) + subject child end new-child date) ;; First we create an alist of generations/relations, where ;; generations is how much we trust the relation, and the relation ;; is parent/child. @@ -2966,12 +3021,14 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." generation 0) (while (search-backward ">" nil t) (setq end (1+ (point))) - (if (search-backward "<" nil t) - (push (list (incf generation) - child (setq child new-child) - subject date) - relations))) - (push (list (1+ generation) child nil subject) relations) + (when (search-backward "<" nil t) + (setq new-child (buffer-substring (point) end)) + (push (list (incf generation) + child (setq child new-child) + subject date) + relations))) + (when child + (push (list (1+ generation) child nil subject) relations)) (erase-buffer))) (kill-buffer (current-buffer))) ;; Sort over trustworthiness. @@ -2980,7 +3037,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (when (gnus-dependencies-add-header (make-full-mail-header gnus-reffed-article-number - (nth 3 relation) "" (nth 4 relation) + (nth 3 relation) "" (or (nth 4 relation) "") (nth 1 relation) (or (nth 2 relation) "") 0 0 "") gnus-newsgroup-dependencies nil) @@ -3035,7 +3092,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (gnus-point-at-eol)) (buffer (current-buffer)) - header) + header rawtext decoded) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect @@ -3047,10 +3104,22 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header number ; number - (funcall - gnus-unstructured-field-decoder (gnus-nov-field)) ; subject - (funcall - gnus-structured-field-decoder (gnus-nov-field)) ; from + (progn + (setq rawtext (gnus-nov-field) ; subject + decoded (funcall + gnus-unstructured-field-decoder rawtext)) + (if (string= rawtext decoded) + rawtext + (put-text-property 0 (length decoded) 'raw-text rawtext decoded) + decoded)) + (progn + (setq rawtext (gnus-nov-field) ; from + decoded (funcall + gnus-structured-field-decoder rawtext)) + (if (string= rawtext decoded) + rawtext + (put-text-property 0 (length decoded) 'raw-text rawtext decoded) + decoded)) (gnus-nov-field) ; date (or (gnus-nov-field) (nnheader-generate-fake-message-id)) ; id @@ -3105,7 +3174,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." "Read all the headers." (let ((gnus-summary-ignore-duplicates t) (dependencies gnus-newsgroup-dependencies) - found header article) + header article) (save-excursion (set-buffer nntp-server-buffer) (let ((case-fold-search nil)) @@ -3116,14 +3185,16 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header (gnus-nov-parse-line article dependencies))) (when header - (push header gnus-newsgroup-headers) - (if (memq (setq article (mail-header-number header)) - gnus-newsgroup-unselected) - (progn - (push article gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delq article gnus-newsgroup-unselected))) - (push article gnus-newsgroup-ancient)) + (save-excursion + (set-buffer gnus-summary-buffer) + (push header gnus-newsgroup-headers) + (if (memq (setq article (mail-header-number header)) + gnus-newsgroup-unselected) + (progn + (push article gnus-newsgroup-unreads) + (setq gnus-newsgroup-unselected + (delq article gnus-newsgroup-unselected))) + (push article gnus-newsgroup-ancient))) (forward-line 1))))))) (defun gnus-summary-update-article-line (article header) @@ -3171,7 +3242,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." (set-buffer gnus-summary-buffer) - (let* ((header (or iheader (gnus-summary-article-header article))) + (let* ((header (gnus-summary-article-header article)) (id (mail-header-id header)) (data (gnus-data-find article)) (thread (gnus-id-to-thread id)) @@ -3184,16 +3255,13 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." references)) "none"))) (buffer-read-only nil) - (old (car thread)) - (number (mail-header-number header)) - pos) + (old (car thread))) (when thread - ;; !!! Should this be in or not? (unless iheader - (setcar thread nil)) - (when parent - (delq thread parent)) - (if (gnus-summary-insert-subject id header iheader) + (setcar thread nil) + (when parent + (delq thread parent))) + (if (gnus-summary-insert-subject id header) ;; Set the (possibly) new article number in the data structure. (gnus-data-set-number data (gnus-id-to-article id)) (setcar thread old) @@ -3245,10 +3313,11 @@ If LINE, insert the rebuilt thread starting on line LINE." ;;!!! then we want to insert at the beginning of the buffer. ;;!!! That happens to be true with Gnus now, but that may ;;!!! change in the future. Perhaps. - (gnus-data-enter-list (if line nil current) data (- (point) old-pos)) - (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)) - (when line - (gnus-data-compute-positions))))) + (gnus-data-enter-list + (if line nil current) data (- (point) old-pos)) + (setq gnus-newsgroup-threads + (nconc threads gnus-newsgroup-threads)) + (gnus-data-compute-positions)))) (defun gnus-number-to-header (number) "Return the header for article NUMBER." @@ -3324,9 +3393,8 @@ If LINE, insert the rebuilt thread starting on line LINE." "Remove the thread that has ID in it." (let (headers thread last-id) ;; First go up in this thread until we find the root. - (setq last-id (gnus-root-id id)) - (setq headers (list (car (gnus-id-to-thread last-id)) - (caadr (gnus-id-to-thread last-id)))) + (setq last-id (gnus-root-id id) + headers (message-flatten-list (gnus-id-to-thread last-id))) ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. @@ -3376,6 +3444,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (while thread (gnus-remove-thread-1 (car thread)) (setq thread (cdr thread)))) + (gnus-summary-show-all-threads) (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) @@ -3398,10 +3467,10 @@ If LINE, insert the rebuilt thread starting on line LINE." "Sort THREADS." (if (not gnus-thread-sort-functions) threads - (gnus-message 7 "Sorting threads...") + (gnus-message 8 "Sorting threads...") (prog1 (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) - (gnus-message 7 "Sorting threads...done")))) + (gnus-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) "Sort ARTICLES." @@ -3473,7 +3542,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-date (h1 h2) "Sort articles by root article date." - (gnus-time-less + (time-less-p (gnus-date-get-time (mail-header-date h1)) (gnus-date-get-time (mail-header-date h2)))) @@ -3761,7 +3830,7 @@ or a straight list of headers." (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property-excluding-characters-with-faces + (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number number) @@ -3815,13 +3884,14 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) -(defun gnus-select-newsgroup (group &optional read-all) +(defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. -If READ-ALL is non-nil, all articles in the group are selected." +If READ-ALL is non-nil, all articles in the group are selected. +If SELECT-ARTICLES, only select those articles from GROUP." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) ;;!!! Dirty hack; should be removed. (gnus-summary-ignore-duplicates - (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) + (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) t gnus-summary-ignore-duplicates)) (info (nth 2 entry)) @@ -3866,10 +3936,13 @@ If READ-ALL is non-nil, all articles in the group are selected." (setq gnus-newsgroup-processable nil) (gnus-update-read-articles group gnus-newsgroup-unreads) - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group)) - (setq articles (gnus-articles-to-read group read-all)) + (if (setq articles select-articles) + (setq gnus-newsgroup-unselected + (gnus-sorted-intersection + gnus-newsgroup-unreads + (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (setq articles (gnus-articles-to-read group read-all))) (cond ((null articles) @@ -3880,6 +3953,7 @@ If READ-ALL is non-nil, all articles in the group are selected." ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) + (gnus-set-global-variables) ;; Retrieve the headers and read them in. (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) (setq gnus-newsgroup-headers @@ -3919,15 +3993,15 @@ If READ-ALL is non-nil, all articles in the group are selected." ;; Removed marked articles that do not exist. (gnus-update-missing-marks (gnus-sorted-complement fetched-articles articles)) - ;; Let the Gnus agent mark articles as read. - (when gnus-agent - (gnus-agent-get-undownloaded-list)) ;; We might want to build some more threads first. (when (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)) (if (eq gnus-fetch-old-headers 'invisible) (gnus-build-all-threads) (gnus-build-old-threads))) + ;; Let the Gnus agent mark articles as read. + (when gnus-agent + (gnus-agent-get-undownloaded-list)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) @@ -4295,7 +4369,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Then we add the read articles to the range. (gnus-add-to-range ninfo (setq articles (sort articles '<)))))) - + (defun gnus-group-make-articles-read (group articles) "Update the info of GROUP to say that ARTICLES are read." (let* ((num 0) @@ -4353,13 +4427,14 @@ 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 id-dep ref-dep end ref) + headers id end ref) (save-excursion (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. (subst-char-in-region (point-min) (point-max) ?\t ? t) (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) + rawtext decoded in-reply-to header p lines chars) (goto-char (point-min)) ;; Search to the beginning of the next header. Error messages @@ -4389,15 +4464,27 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (funcall - gnus-unstructured-field-decoder (nnheader-header-value)) + (progn + (setq rawtext (nnheader-header-value) + decoded (funcall + gnus-unstructured-field-decoder rawtext)) + (if (string-equal rawtext decoded) + rawtext + (put-text-property 0 (length decoded) 'raw-text rawtext decoded) + decoded)) "(none)")) ;; From. (progn (goto-char p) (if (search-forward "\nfrom: " nil t) - (funcall - gnus-structured-field-decoder (nnheader-header-value)) + (progn + (setq rawtext (nnheader-header-value) + decoded (funcall + gnus-structured-field-decoder rawtext)) + (if (string-equal rawtext decoded) + rawtext + (put-text-property 0 (length decoded) 'raw-text rawtext decoded) + decoded)) "(nobody)")) ;; Date. (progn @@ -4446,7 +4533,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ref2 (substring in-reply-to (match-beginning 0) (match-end 0))) (when (> (length ref2) (length ref)) - (setq ref ref2)))) + (setq ref ref2))) + ref) (setq ref nil)))) ;; Chars. (progn @@ -4572,7 +4660,7 @@ the subject line on." (t (gnus-read-header id)))) (number (and (numberp id) id)) - pos d) + d) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. @@ -4659,6 +4747,19 @@ current article will be taken into consideration." ;; Just return the current article. (list (gnus-summary-article-number)))))) +(defmacro gnus-summary-iterate (arg &rest forms) + "Iterate over the process/prefixed articles and do FORMS. +ARG is the interactive prefix given to the command. FORMS will be +executed with point over the summary line of the articles." + (let ((articles (make-symbol "gnus-summary-iterate-articles"))) + `(let ((,articles (gnus-summary-work-articles ,arg))) + (while ,articles + (gnus-summary-goto-subject (car ,articles)) + ,@forms)))) + +(put 'gnus-summary-iterate 'lisp-indent-function 1) +(put 'gnus-summary-iterate 'edebug-form-spec '(form body)) + (defun gnus-summary-save-process-mark () "Push the current set of process marked articles on the stack." (interactive) @@ -4857,12 +4958,12 @@ displayed, no centering will be performed." ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? (if (not (listp (cdr read))) - (setq first (1+ (cdr read))) + (setq first (max (car active) (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) (caar read))) 1) - (setq first 1)) + (setq first (car active))) (while read (when first (while (< first nlast) @@ -4983,7 +5084,7 @@ The prefix argument ALL means to select all articles." (gnus-update-read-articles group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) ;; Set the current article marks. - (let ((gnus-newsgroup-scored + (let ((gnus-newsgroup-scored (if (and (not gnus-save-score) (not non-destructive)) nil @@ -5082,12 +5183,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) - ;; Clear the current group name. (if (not quit-config) (progn (goto-char group-point) (gnus-configure-windows 'group 'force)) (gnus-handle-ephemeral-exit quit-config)) + ;; Clear the current group name. (unless quit-config (setq gnus-newsgroup-name nil))))) @@ -5174,12 +5275,6 @@ The state which existed when entering the ephemeral is reset." (select-window (get-buffer-window gnus-article-buffer)) ) -(defun gnus-summary-scroll-down () - "Scroll down one line current article." - (interactive) - (gnus-summary-scroll-up -1) - ) - ;;; Dead summaries. (defvar gnus-dead-summary-mode-map nil) @@ -5749,6 +5844,12 @@ Argument LINES specifies lines to be scrolled up (or down if negative)." (gnus-summary-recenter) (gnus-summary-position-point)) +(defun gnus-summary-scroll-down (lines) + "Scroll down (or up) one line current article. +Argument LINES specifies lines to be scrolled down (or up if negative)." + (interactive "p") + (gnus-summary-scroll-up (- lines))) + (defun gnus-summary-next-same-subject () "Select next article which has the same subject as current one." (interactive) @@ -5780,6 +5881,16 @@ Return nil if there are no unread articles." (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) +(defun gnus-summary-first-unread-subject () + "Place the point on the subject line of the first unread article. +Return nil if there are no unread articles." + (interactive) + (prog1 + (when (gnus-summary-first-subject t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t)) + (gnus-summary-position-point))) + (defun gnus-summary-first-article () "Select the first article. Return nil if there are no articles." @@ -5913,13 +6024,13 @@ articles that are younger than AGE days." (interactive "nTime in days: \nP") (prog1 (let ((data gnus-newsgroup-data) - (cutoff (nnmail-days-to-time age)) + (cutoff (days-to-time age)) articles d date is-younger) (while (setq d (pop data)) (when (and (vectorp (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) - (setq is-younger (nnmail-time-less - (nnmail-time-since (nnmail-date-to-time date)) + (setq is-younger (time-less-p + (time-since (date-to-time date)) cutoff)) (when (if younger-p is-younger @@ -6059,7 +6170,8 @@ If ALL, mark even excluded ticked and dormants as read." '<) (sort gnus-newsgroup-limit '<))) article) - (setq gnus-newsgroup-unreads gnus-newsgroup-limit) + (setq gnus-newsgroup-unreads + (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit)) (if all (setq gnus-newsgroup-dormant nil gnus-newsgroup-marked nil @@ -6107,6 +6219,7 @@ If ALL, mark even excluded ticked and dormants as read." ;; after the current one. (goto-char (point-max)) (gnus-summary-find-prev)) + (gnus-set-mode-line 'summary) ;; We return how many articles were removed from the summary ;; buffer as a result of the new limit. (- total (length gnus-newsgroup-data)))) @@ -6122,7 +6235,7 @@ If ALL, mark even excluded ticked and dormants as read." (defsubst gnus-cut-thread (thread) "Go forwards in the thread until we find an article that we want to display." (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-fetch-old-headers 'invisible) + (eq gnus-fetch-old-headers 'invisible) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) ;; Deal with old-fetched headers and sparse threads. @@ -6356,8 +6469,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." (interactive "P") (let ((id (mail-header-id (gnus-summary-article-header))) (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit)) - fmethod root) + gnus-refer-thread-limit))) ;; We want to fetch LIMIT *old* headers, but we also have to ;; re-fetch all the headers in the current buffer, because many of ;; them may be undisplayed. So we adjust LIMIT. @@ -6392,8 +6504,7 @@ or `gnus-select-method', no matter what backend the article comes from." (gnus-summary-article-sparse-p (mail-header-number header)) (memq (mail-header-number header) - gnus-newsgroup-limit))) - h) + gnus-newsgroup-limit)))) (cond ;; If the article is present in the buffer we just go to it. ((and header @@ -6492,7 +6603,7 @@ Obeys the standard process/prefix convention." (gnus-summary-remove-process-mark article) (when (gnus-summary-display-article article) (save-excursion - (nnheader-temp-write nil + (with-temp-buffer (insert-buffer-substring gnus-original-article-buffer) ;; Remove some headers that may lead nndoc to make ;; the wrong guess. @@ -6726,14 +6837,14 @@ to save in." (set-buffer buffer) (gnus-article-delete-invisible-text) (let ((ps-left-header - (list + (list (concat "(" (mail-header-subject gnus-current-headers) ")") (concat "(" (mail-header-from gnus-current-headers) ")"))) - (ps-right-header - (list - "/pagenumberstring load" + (ps-right-header + (list + "/pagenumberstring load" (concat "(" (mail-header-date gnus-current-headers) ")")))) (gnus-run-hooks 'gnus-ps-print-hook) @@ -6753,6 +6864,7 @@ article massaging functions being run." (let ((gnus-have-all-headers t) gnus-article-display-hook gnus-article-prepare-hook + gnus-article-decode-hook gnus-break-pages gnus-show-mime gnus-visual) @@ -6925,7 +7037,7 @@ and `request-accept' functions." (set-buffer copy-buf) (when (gnus-request-article-this-buffer article gnus-newsgroup-name) (gnus-request-accept-article - to-newsgroup select-method (not articles))))) + to-newsgroup select-method (not articles) t)))) ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (message-tokenize-header @@ -6965,15 +7077,10 @@ and `request-accept' functions." (gnus-summary-mark-article article gnus-canceled-mark) (gnus-message 4 "Deleted article %s" article)) (t - (let* ((entry - (or - (gnus-gethash (car art-group) gnus-newsrc-hashtb) - (gnus-gethash - (gnus-group-prefixed-name - (car art-group) - (or select-method - (gnus-find-method-for-group to-newsgroup))) - gnus-newsrc-hashtb))) + (let* ((pto-group (gnus-group-prefixed-name + (car art-group) to-method)) + (entry + (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) (to-group (gnus-info-group info))) ;; Update the group that has been moved to. @@ -7044,7 +7151,7 @@ and `request-accept' functions." ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) @@ -7077,7 +7184,7 @@ re-spool using this method." (defcustom gnus-summary-respool-default-method nil "Default method for respooling an article. If nil, use to the current newsgroup method." - :type `(choice (gnus-select-method :value (nnml "")) + :type '(choice (gnus-select-method :value (nnml "")) (const nil)) :group 'gnus-summary-mail) @@ -7137,8 +7244,7 @@ latter case, they will be copied into the relevant groups." (not (file-regular-p file)) (error "Can't read %s" file)) (save-excursion - (set-buffer (get-buffer-create " *import file*")) - (buffer-disable-undo (current-buffer)) + (set-buffer (gnus-get-buffer-create " *import file*")) (erase-buffer) (nnheader-insert-file-contents file) (goto-char (point-min)) @@ -7148,10 +7254,7 @@ latter case, they will be copied into the relevant groups." lines (count-lines (point-min) (point-max))) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" - "Date: " (timezone-make-date-arpa-standard - (current-time-string (nth 5 atts)) - (current-time-zone now) - (current-time-zone now)) + "Date: " (message-make-date (nth 5 atts)) "\n" "Message-ID: " (message-make-message-id) "\n" "Lines: " (int-to-string lines) "\n" @@ -7302,12 +7405,13 @@ groups." (interactive) ;; Replace the article. (let ((buf (current-buffer))) - (nnheader-temp-write nil + (with-temp-buffer (insert-buffer buf) (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) - (current-buffer)))) + (current-buffer) + (not gnus-article-decoded-p)))) (error "Couldn't replace article") ;; Update the summary buffer. (if (and references @@ -7320,7 +7424,7 @@ groups." (message-narrow-to-head) (let ((head (buffer-string)) header) - (nnheader-temp-write nil + (with-temp-buffer (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) @@ -7368,7 +7472,7 @@ groups." ;;; Respooling -(defun gnus-summary-respool-query (&optional silent) +(defun gnus-summary-respool-query (&optional silent trace) "Query where the respool algorithm would put this article." (interactive) (let (gnus-mark-article-hook) @@ -7377,7 +7481,7 @@ groups." (set-buffer gnus-original-article-buffer) (save-restriction (message-narrow-to-head) - (let ((groups (nnmail-article-group 'identity))) + (let ((groups (nnmail-article-group 'identity trace))) (unless silent (if groups (message "This message would go to %s" @@ -7385,6 +7489,12 @@ groups." (message "This message would go to no groups")) groups)))))) +(defun gnus-summary-respool-trace () + "Trace where the respool algorithm would put this article. +Display a buffer showing all fancy splitting patterns which matched." + (interactive) + (gnus-summary-respool-query nil t)) + ;; Summary marking commands. (defun gnus-summary-kill-same-subject-and-select (&optional unmark) @@ -7502,7 +7612,7 @@ the actual number of articles marked is returned." "Mark ARTICLE replied and update the summary line." (push article gnus-newsgroup-replied) (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article) + (when (gnus-summary-goto-subject article nil t) (gnus-summary-update-secondary-mark article)))) (defun gnus-summary-set-bookmark (article) @@ -7561,6 +7671,7 @@ the actual number of articles marked is returned." (delq article gnus-newsgroup-processable))) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) + (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) (defun gnus-summary-remove-process-mark (article) @@ -7568,6 +7679,7 @@ the actual number of articles marked is returned." (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) + (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) (defun gnus-summary-set-saved-mark (article) @@ -7625,6 +7737,8 @@ returned." (= mark gnus-read-mark) (= mark gnus-souped-mark) (= mark gnus-duplicate-mark))) (setq mark gnus-expirable-mark) + ;; Let the backend know about the mark change. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (push article gnus-newsgroup-expirable)) ;; Set the mark in the buffer. (gnus-summary-update-mark mark 'unread) @@ -7634,6 +7748,8 @@ returned." "Mark the current article quickly as unread with MARK." (let* ((article (gnus-summary-article-number)) (old-mark (gnus-summary-article-mark article))) + ;; Allow the backend to change the mark. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (if (eq mark old-mark) t (if (<= article 0) @@ -7689,6 +7805,8 @@ marked." (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number))) (old-mark (gnus-summary-article-mark article))) + ;; Allow the backend to change the mark. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (if (eq mark old-mark) t (unless article @@ -8126,7 +8244,7 @@ is non-nil or the Subject: of both articles are the same." (gnus-summary-select-article t t nil current-article)) (set-buffer gnus-original-article-buffer) (let ((buf (format "%s" (buffer-string)))) - (nnheader-temp-write nil + (with-temp-buffer (insert buf) (goto-char (point-min)) (if (re-search-forward "^References: " nil t) @@ -8469,7 +8587,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 'gnus-summary-save-in-rmail)) + (let ((gnus-default-article-saver 'rmail-output-to-rmail-file)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-file (&optional arg) @@ -8506,8 +8624,7 @@ save those articles instead." "Pipe the current article through PROGRAM." (interactive "sProgram: ") (gnus-summary-select-article) - (let ((mail-header-separator "") - (art-buf (get-buffer gnus-article-buffer))) + (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen)