X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=789308c4ab90b70e861ffeb36bd9749b77f38e5f;hb=d7925de009d5e3047e07e52657d7312d9f97979c;hp=2eedc07d10f708fdf9cffba98fce32d846cbf86a;hpb=faec08456dd7189d2522cb025b4c55aeecc13a97;p=gnus diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 2eedc07d1..789308c4a 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,7 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996-2011 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -60,6 +59,8 @@ (autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t) (autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t) (autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t) +(autoload 'nnir-article-rsv "nnir" nil nil 'macro) +(autoload 'nnir-article-group "nnir" nil nil 'macro) (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -358,7 +359,7 @@ first subject), `unread' (place point on the subject line of the first unread article), `best' (place point on the subject line of the higest-scored article), `unseen' (place point on the subject line of the first unseen article), `unseen-or-unread' (place point on the subject -line of the first unseen article or, if all article have been seen, on the +line of the first unseen article or, if all articles have been seen, on the subject line of the first unread article), or a function to be called to place point on some subject line." :version "24.1" @@ -1234,8 +1235,9 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :group 'gnus-summary-marks) (defcustom gnus-propagate-marks t - "If non-nil, do not propagate marks to the backends." - :version "23.1" ;; No Gnus + "If non-nil, Gnus will store and retrieve marks from the backends. +This means that marks will be stored both in .newsrc.eld and in +the backend, and will slow operation down somewhat." :type 'boolean :group 'gnus-summary-marks) @@ -1361,6 +1363,16 @@ the normal Gnus MIME machinery." (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) (?L gnus-tmp-lines ?s) + (?Z (or ,(gnus-macroexpand-all + '(nnir-article-rsv (mail-header-number gnus-tmp-header))) + 0) ?d) + (?G (or ,(gnus-macroexpand-all + '(nnir-article-group (mail-header-number gnus-tmp-header))) + "") ?s) + (?g (or ,(gnus-macroexpand-all + '(gnus-group-short-name + (nnir-article-group (mail-header-number gnus-tmp-header)))) + "") ?s) (?O gnus-tmp-downloaded ?c) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) @@ -1581,6 +1593,8 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") gnus-newsgroup-prepared gnus-summary-highlight-line-function gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook + (gnus-summary-article-delete-hook . global) + (gnus-summary-article-move-hook . global) gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers gnus-thread-expunge-below @@ -1901,6 +1915,7 @@ increase the score of each group you read." "a" gnus-summary-post-news "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article + [tab] gnus-summary-widget-forward "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article @@ -2061,8 +2076,10 @@ increase the score of each group you read." "D" gnus-summary-enter-digest-group "R" gnus-summary-refer-references "T" gnus-summary-refer-thread + "W" gnus-warp-to-article "g" gnus-summary-show-article "s" gnus-summary-isearch-article + [tab] gnus-summary-widget-forward "P" gnus-summary-print-article "S" gnus-sticky-article "M" gnus-mailing-list-insinuate @@ -2095,6 +2112,7 @@ increase the score of each group you read." "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive "p" gnus-article-verify-x-pgp-sig "d" gnus-article-treat-dumbquotes + "U" gnus-article-treat-non-ascii "i" gnus-summary-idna-message) (gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) @@ -2132,7 +2150,7 @@ increase the score of each group you read." "d" gnus-article-display-face "s" gnus-treat-smiley "D" gnus-article-remove-images - "W" gnus-html-show-images + "W" gnus-article-show-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon "n" gnus-treat-newsgroups-picon @@ -2419,6 +2437,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) gnus-article-remove-leading-whitespace t]) ["Overstrike" gnus-article-treat-overstrike t] ["Dumb quotes" gnus-article-treat-dumbquotes t] + ["Non-ASCII" gnus-article-treat-non-ascii t] ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] ["Fill long lines" gnus-article-fill-long-lines t] @@ -3834,6 +3853,56 @@ This function is intended to be used in ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024)))) (t (format "%dM" (/ c (* 1024.0 1024))))))) +(defcustom gnus-summary-user-date-format-alist + '(((gnus-seconds-today) . "Today, %H:%M") + ((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M") + (604800 . "%A %H:%M") ; That's one week + ((gnus-seconds-month) . "%A %d") + ((gnus-seconds-year) . "%B %d") + (t . "%b %d %Y")) ; This one is used when no other + ; does match + "Specifies date format depending on age of article. +This is an alist of items (AGE . FORMAT). AGE can be a number (of +seconds) or a Lisp expression evaluating to a number. When the age of +the article is less than this number, then use `format-time-string' +with the corresponding FORMAT for displaying the date of the article. +If AGE is not a number or a Lisp expression evaluating to a +non-number, then the corresponding FORMAT is used as a default value. + +Note that the list is processed from the beginning, so it should be +sorted by ascending AGE. Also note that items following the first +non-number AGE will be ignored. + +You can use the functions `gnus-seconds-today', `gnus-seconds-month' +and `gnus-seconds-year' in the AGE spec. They return the number of +seconds passed since the start of today, of this month, of this year, +respectively." + :version "24.1" + :group 'gnus-summary-format + :type '(alist :key-type sexp :value-type string)) +(make-obsolete-variable 'gnus-user-date-format-alist + 'gnus-summary-user-date-format-alist "24.1") + +(defun gnus-user-date (messy-date) + "Format the messy-date according to `gnus-summary-user-date-format-alist'. +Returns \" ? \" if there's bad input or if another error occurs. +Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." + (condition-case () + (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date))) + (now (gnus-float-time)) + ;;If we don't find something suitable we'll use this one + (my-format "%b %d '%y")) + (let* ((difference (- now messy-date)) + (templist gnus-summary-user-date-format-alist) + (top (eval (caar templist)))) + (while (if (numberp top) (< top difference) (not top)) + (progn + (setq templist (cdr templist)) + (setq top (eval (caar templist))))) + (if (stringp (cdr (car templist))) + (setq my-format (cdr (car templist))))) + (format-time-string (eval my-format) (seconds-to-time messy-date))) + (error " ? "))) (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." @@ -3921,11 +3990,9 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1)) (gnus-handle-ephemeral-exit quit-config))) - (let ((grpinfo (gnus-get-info group))) - (if (null (gnus-info-read grpinfo)) - (gnus-message 3 "Group %s contains no messages" - (gnus-group-decoded-name group)) - (gnus-message 3 "Can't select group"))) + (if (null (gnus-list-of-unread-articles group)) + (gnus-message 3 "Group %s contains no messages" group) + (gnus-message 3 "Can't select group")) nil) ;; The user did a `C-g' while prompting for number of articles, ;; so we exit this group. @@ -4001,6 +4068,7 @@ If NO-DISPLAY, don't generate a summary buffer." ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. (gnus-summary-maybe-hide-threads) + (gnus-configure-windows 'summary) (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) (gnus-summary-auto-select-subject) @@ -4010,7 +4078,6 @@ If NO-DISPLAY, don't generate a summary buffer." gnus-newsgroup-unreads gnus-auto-select-first) (progn - (gnus-configure-windows 'summary) (let ((art (gnus-summary-article-number))) (unless (and (not gnus-plugged) (or (memq art gnus-newsgroup-undownloaded) @@ -5468,7 +5535,7 @@ or a straight list of headers." (substring subject (match-end 1))))) (mail-header-set-subject header subject)))))) -(defun gnus-fetch-headers (articles) +(defun gnus-fetch-headers (articles &optional limit force-new dependencies) "Fetch headers of ARTICLES." (let ((name (gnus-group-decoded-name gnus-newsgroup-name))) (gnus-message 5 "Fetching headers for %s..." name) @@ -5477,16 +5544,17 @@ or a straight list of headers." (setq gnus-headers-retrieved-by (gnus-retrieve-headers articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers)))) + (or limit + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and + (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers))))) (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers)) + articles force-new dependencies gnus-newsgroup-name t) + (gnus-get-newsgroup-headers dependencies force-new)) (gnus-message 5 "Fetching headers for %s...done" name)))) (defun gnus-select-newsgroup (group &optional read-all select-articles) @@ -5525,7 +5593,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (mm-decode-coding-string group charset) (mm-decode-coding-string (gnus-status-message group) charset))) - (when gnus-agent + (when (and gnus-agent + (gnus-active group)) (gnus-agent-possibly-alter-active group (gnus-active group) info) (setq gnus-summary-use-undownloaded-faces @@ -5583,7 +5652,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-processable nil) - (gnus-update-read-articles group gnus-newsgroup-unreads) + (gnus-update-read-articles group gnus-newsgroup-unreads t) ;; Adjust and set lists of article marks. (when info @@ -7100,6 +7169,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (gnus-group-is-exiting-p t) + (article-buffer gnus-article-buffer) (mode major-mode) (group-point nil) (buf (current-buffer))) @@ -7152,16 +7222,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - ;; Don't kill sticky article buffers - (unless (eq major-mode 'gnus-sticky-article-mode) - (gnus-kill-buffer gnus-article-buffer) - (setq gnus-article-current nil)))) - (gnus-kill-buffer gnus-original-article-buffer)) - (setq gnus-current-select-method gnus-select-method) (set-buffer gnus-group-buffer) (if quit-config @@ -7173,6 +7233,17 @@ If FORCE (the prefix), also save the .newsrc file(s)." (if win (set-window-point win (point)))) (unless leave-hidden (gnus-configure-windows 'group 'force))) + + ;; If we have several article buffers, we kill them at exit. + (unless gnus-single-article-buffer + (when (gnus-buffer-live-p article-buffer) + (with-current-buffer article-buffer + ;; Don't kill sticky article buffers + (unless (eq major-mode 'gnus-sticky-article-mode) + (gnus-kill-buffer article-buffer) + (setq gnus-article-current nil)))) + (gnus-kill-buffer gnus-original-article-buffer)) + ;; Clear the current group name. (unless quit-config (setq gnus-newsgroup-name nil))))) @@ -7201,6 +7272,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer) (setq gnus-article-current nil)) + ;; Return to the group buffer. + (gnus-configure-windows 'group 'force) (if (not gnus-kill-summary-on-exit) (gnus-deaden-summary) (gnus-close-group group) @@ -7212,8 +7285,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-async-prefetch-remove-group group) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) - ;; Return to the group buffer. - (gnus-configure-windows 'group 'force) ;; Clear the current group name. (setq gnus-newsgroup-name nil) (unless (gnus-ephemeral-group-p group) @@ -7663,13 +7734,11 @@ If BACKWARD, the previous article is selected instead of the next." (point (with-current-buffer gnus-group-buffer (point))) + (current-summary (current-buffer)) (group (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) - ;; For some reason, the group window gets selected. We change - ;; it back. - (select-window (get-buffer-window (current-buffer))) ;; Select next unread newsgroup automagically. (cond ((or (not gnus-auto-select-next) @@ -7690,6 +7759,10 @@ If BACKWARD, the previous article is selected instead of the next." (gnus-summary-next-group nil group backward))) (t (when (gnus-key-press-event-p last-input-event) + ;; Somehow or other, we may now have selected a different + ;; window. Make point go back to the summary buffer. + (when (eq current-summary (current-buffer)) + (select-window (get-buffer-window current-summary))) (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward point)))))))) @@ -8494,6 +8567,18 @@ fetched for this group." (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) (gnus-summary-position-point))) +(defun gnus-summary-include-articles (articles) + "Fetch the headers for ARTICLES and then display the summary lines." + (let ((gnus-inhibit-demon t) + (gnus-agent nil) + (gnus-read-all-available-headers t)) + (setq gnus-newsgroup-headers + (gnus-merge + 'list gnus-newsgroup-headers + (gnus-fetch-headers articles nil t) + 'gnus-article-sort-by-number)) + (gnus-summary-limit (append articles gnus-newsgroup-limit)))) + (defun gnus-summary-limit-exclude-dormant () "Hide all dormant articles." (interactive) @@ -8835,46 +8920,36 @@ fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil fetch what's specified by the `gnus-refer-thread-limit' variable." (interactive "P") - (let ((id (mail-header-id (gnus-summary-article-header))) - (subject (gnus-simplify-subject - (mail-header-subject (gnus-summary-article-header)))) - (refs (split-string (or (mail-header-references - (gnus-summary-article-header)) ""))) - (gnus-summary-ignore-duplicates t) - (gnus-inhibit-demon t) - (gnus-read-all-available-headers t) - (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit))) - (if (gnus-check-backend-function 'request-thread gnus-newsgroup-name) - (setq gnus-newsgroup-headers - (gnus-merge 'list - gnus-newsgroup-headers - (gnus-request-thread id) - 'gnus-article-sort-by-number)) - (unless (eq gnus-fetch-old-headers 'invisible) - (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) - ;; Retrieve the headers and read them in. - (if (numberp limit) - (gnus-retrieve-headers - (list (min - (+ (mail-header-number - (gnus-summary-article-header)) - limit) - gnus-newsgroup-end)) - gnus-newsgroup-name (* limit 2)) - ;; gnus-refer-thread-limit is t, i.e. fetch _all_ - ;; headers. - (gnus-retrieve-headers (list gnus-newsgroup-end) - gnus-newsgroup-name limit) - (gnus-message 5 "Fetching headers for %s...done" - gnus-newsgroup-name)))) - (when (eq gnus-headers-retrieved-by 'nov) - ;; might as well restrict the headers to the relevant ones. this - ;; should save time when building threads. - (with-current-buffer nntp-server-buffer - (goto-char (point-min)) - (keep-lines (regexp-opt (append refs (list id subject))))) - (gnus-build-all-threads)) + (gnus-warp-to-article) + (let* ((header (gnus-summary-article-header)) + (id (mail-header-id header)) + (gnus-inhibit-demon t) + (gnus-summary-ignore-duplicates t) + (gnus-read-all-available-headers t) + (limit (if limit (prefix-numeric-value limit) + gnus-refer-thread-limit))) + (setq gnus-newsgroup-headers + (gnus-merge + 'list gnus-newsgroup-headers + (if (gnus-check-backend-function + 'request-thread gnus-newsgroup-name) + (gnus-request-thread header) + (let* ((last (if (numberp limit) + (min (+ (mail-header-number header) + limit) + gnus-newsgroup-highest) + gnus-newsgroup-highest)) + (subject (gnus-simplify-subject + (mail-header-subject header))) + (refs (split-string (or (mail-header-references header) + ""))) + (gnus-parse-headers-hook + (lambda () (goto-char (point-min)) + (keep-lines + (regexp-opt (append refs (list id subject))))))) + (gnus-fetch-headers (list last) (if (numberp limit) + (* 2 limit) limit) t))) + 'gnus-article-sort-by-number)) (gnus-summary-limit-include-thread id))) (defun gnus-summary-refer-article (message-id) @@ -8957,8 +9032,11 @@ variable." (defun gnus-summary-enter-digest-group (&optional force) "Enter an nndoc group based on the current article. -If FORCE, force a digest interpretation. If not, try -to guess what the document format is." +If FORCE, force a digest interpretation. If not, try to guess +what the document format is. + +To control what happens when you exit the group, see the +`gnus-auto-select-on-ephemeral-exit' variable." (interactive "P") (let ((conf gnus-current-window-configuration)) (save-window-excursion @@ -9071,6 +9149,15 @@ Obeys the standard process/prefix convention." (t (error "Couldn't select virtual nndoc group"))))) +(defun gnus-summary-widget-forward (arg) + "Move point to the next field or button in the article. +With optional ARG, move across that many fields." + (interactive "p") + (gnus-summary-select-article) + (gnus-configure-windows 'article) + (select-window (gnus-get-buffer-window gnus-article-buffer)) + (widget-forward arg)) + (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." @@ -9441,6 +9528,9 @@ C-u g', show the raw article." ((or (equal arg '(16)) (eq arg t)) ;; C-u C-u g + (let ((gnus-inhibit-article-treatments t)) + (gnus-summary-select-article nil 'force))) + (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -9458,9 +9548,6 @@ C-u g', show the raw article." ;; 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))) - (t - (let ((gnus-inhibit-article-treatments t)) (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -9706,6 +9793,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." articles) (while articles (setq article (pop articles)) + ;; Set any marks that may have changed in the summary buffer. + (when gnus-preserve-marks + (gnus-summary-push-marks-to-backend article)) (setq art-group (cond @@ -9720,7 +9810,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (move-is-internal (gnus-server-equal from-method to-method))) (gnus-request-move-article article ; Article to move - gnus-newsgroup-name ; From newsgroup + gnus-newsgroup-name ; From newsgroup (nth 1 (gnus-find-method-for-group gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article @@ -9729,11 +9819,13 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (not articles) ; Only save nov last time (and move-is-internal to-newsgroup ; Not respooling - (gnus-group-real-name to-newsgroup))))) ; Is this move internal? + ; Is this move internal? + (gnus-group-real-name to-newsgroup))))) ;; Copy the article. ((eq action 'copy) (with-current-buffer copy-buf - (when (gnus-request-article-this-buffer article gnus-newsgroup-name) + (when (gnus-request-article-this-buffer article + gnus-newsgroup-name) (save-restriction (nnheader-narrow-to-headers) (dolist (hdr gnus-copy-article-ignored-headers) @@ -9743,7 +9835,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (message-tokenize-header - (mail-header-xref (gnus-summary-article-header article)) + (mail-header-xref (gnus-summary-article-header + article)) " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) ":" (number-to-string article))) @@ -9760,7 +9853,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-request-article-this-buffer article gnus-newsgroup-name) (when (consp (setq art-group (gnus-request-accept-article - to-newsgroup select-method (not articles) t))) + to-newsgroup select-method (not articles) + t))) (setq new-xref (concat new-xref " " (car art-group) ":" (number-to-string (cdr art-group)))) @@ -9798,7 +9892,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (unless (member to-group to-groups) (push to-group to-groups)) - (unless (memq article gnus-newsgroup-unreads) + (when (and (not (memq article gnus-newsgroup-unreads)) + (cdr art-group)) (push 'read to-marks) (gnus-info-set-read info (gnus-add-to-range (gnus-info-read info) @@ -9809,27 +9904,31 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (marks (if expirable gnus-article-mark-lists (delete '(expirable . expire) - (copy-sequence gnus-article-mark-lists)))) + (copy-sequence + gnus-article-mark-lists)))) (to-article (cdr art-group))) ;; Enter the article into the cache in the new group, ;; if that is required. - (when gnus-use-cache + (when (and to-article + gnus-use-cache) (gnus-cache-possibly-enter-article to-group to-article (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when gnus-preserve-marks + (when (and gnus-preserve-marks + to-article) ;; Copy any marks over to the new group. (when (and (equal to-group gnus-newsgroup-name) (not (memq article gnus-newsgroup-unreads))) ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) + (push (cons to-article gnus-read-mark) + gnus-newsgroup-reads) ;; Increase the active status of this group. (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) + (setcdr gnus-newsgroup-active to-article)) (while marks (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) @@ -9840,7 +9939,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; If the other group is the same as this group, ;; then we have to add the mark to the list. (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) + (set (intern (format "gnus-newsgroup-%s" + (caar marks))) (cons to-article (symbol-value (intern (format "gnus-newsgroup-%s" @@ -9888,7 +9988,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-newsgroup select-method)) - ;;;!!!Why is this necessary? + ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) (when (eq action 'move) @@ -9908,6 +10008,20 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-summary-position-point) (gnus-set-mode-line 'summary))) +(defun gnus-summary-push-marks-to-backend (article) + (let ((set nil) + (marks gnus-article-mark-lists)) + (unless (memq article gnus-newsgroup-unreads) + (push 'read set)) + (while marks + (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks)))))) + (push (cdar marks) set)) + (pop marks)) + (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set))))) + (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to. @@ -9946,7 +10060,7 @@ current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." (interactive (list current-prefix-arg - (let* ((methods (gnus-methods-using 'respool)) + (let* ((methods (mapcar #'car (gnus-methods-using 'respool))) (methname (symbol-name (or gnus-summary-respool-default-method (car (gnus-find-method-for-group @@ -10160,13 +10274,13 @@ confirmation before the articles are deleted." ;; The backend might not have been able to delete the article ;; after all. (unless (memq (car articles) not-deleted) - (gnus-summary-mark-article (car articles) gnus-canceled-mark)) - (let* ((article (car articles)) - (ghead (gnus-data-header - (assoc article (gnus-data-list nil))))) - (run-hook-with-args 'gnus-summary-article-delete-hook - 'delete ghead gnus-newsgroup-name nil - nil)) + (gnus-summary-mark-article (car articles) gnus-canceled-mark) + (let* ((article (car articles)) + (ghead (gnus-data-header + (assoc article (gnus-data-list nil))))) + (run-hook-with-args 'gnus-summary-article-delete-hook + 'delete ghead gnus-newsgroup-name nil + nil))) (setq articles (cdr articles)))) (when not-deleted (gnus-message 4 "Couldn't delete articles %s" not-deleted))) @@ -11219,6 +11333,7 @@ with that article." (mail-header-subject (gnus-data-header (car data))))) (t nil))) (end-point (save-excursion + (goto-char (gnus-data-pos (car data))) (if (gnus-summary-go-to-next-thread) (point) (point-max)))) articles) @@ -11980,9 +12095,9 @@ If REVERSE, save parts that do not match TYPE." 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)) + (read-directory-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)