aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/gnus/ChangeLog5
-rw-r--r--lisp/gnus/gnus-sum.el393
2 files changed, 205 insertions, 193 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index c7eb25b3ba7..66d9a6725ed 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
12010-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-sum.el (gnus-summary-move-article): Fix `while' loop to make it
4 work for two or more articles.
5
12010-11-12 Katsumi Yamaoka <yamaoka@jpl.org> 62010-11-12 Katsumi Yamaoka <yamaoka@jpl.org>
2 7
3 * gnus-art.el (article-treat-non-ascii): Keep text properties not to 8 * gnus-art.el (article-treat-non-ascii): Keep text properties not to
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 9729480d902..f936127f0de 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9709,199 +9709,206 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9709 (gnus-article-original-subject 9709 (gnus-article-original-subject
9710 (mail-header-subject 9710 (mail-header-subject
9711 (gnus-data-header (assoc article (gnus-data-list nil)))))) 9711 (gnus-data-header (assoc article (gnus-data-list nil))))))
9712 (setq 9712 (setq
9713 art-group 9713 art-group
9714 (cond 9714 (cond
9715 ;; Move the article. 9715 ;; Move the article.
9716 ((eq action 'move) 9716 ((eq action 'move)
9717 ;; Remove this article from future suppression. 9717 ;; Remove this article from future suppression.
9718 (gnus-dup-unsuppress-article article) 9718 (gnus-dup-unsuppress-article article)
9719 (let* ((from-method (gnus-find-method-for-group 9719 (let* ((from-method (gnus-find-method-for-group
9720 gnus-newsgroup-name)) 9720 gnus-newsgroup-name))
9721 (to-method (or select-method 9721 (to-method (or select-method
9722 (gnus-find-method-for-group to-newsgroup))) 9722 (gnus-find-method-for-group to-newsgroup)))
9723 (move-is-internal (gnus-server-equal from-method to-method))) 9723 (move-is-internal (gnus-server-equal from-method to-method)))
9724 (gnus-request-move-article 9724 (gnus-request-move-article
9725 article ; Article to move 9725 article ; Article to move
9726 gnus-newsgroup-name ; From newsgroup 9726 gnus-newsgroup-name ; From newsgroup
9727 (nth 1 (gnus-find-method-for-group 9727 (nth 1 (gnus-find-method-for-group
9728 gnus-newsgroup-name)) ; Server 9728 gnus-newsgroup-name)) ; Server
9729 (list 'gnus-request-accept-article 9729 (list 'gnus-request-accept-article
9730 to-newsgroup (list 'quote select-method) 9730 to-newsgroup (list 'quote select-method)
9731 (not articles) t) ; Accept form 9731 (not articles) t) ; Accept form
9732 (not articles) ; Only save nov last time 9732 (not articles) ; Only save nov last time
9733 (and move-is-internal 9733 (and move-is-internal
9734 to-newsgroup ; Not respooling 9734 to-newsgroup ; Not respooling
9735 (gnus-group-real-name to-newsgroup))))) ; Is this move internal? 9735 ; Is this move internal?
9736 ;; Copy the article. 9736 (gnus-group-real-name to-newsgroup)))))
9737 ((eq action 'copy) 9737 ;; Copy the article.
9738 (with-current-buffer copy-buf 9738 ((eq action 'copy)
9739 (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
9740 (save-restriction
9741 (nnheader-narrow-to-headers)
9742 (dolist (hdr gnus-copy-article-ignored-headers)
9743 (message-remove-header hdr t)))
9744 (gnus-request-accept-article
9745 to-newsgroup select-method (not articles) t))))
9746 ;; Crosspost the article.
9747 ((eq action 'crosspost)
9748 (let ((xref (message-tokenize-header
9749 (mail-header-xref (gnus-summary-article-header article))
9750 " ")))
9751 (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
9752 ":" (number-to-string article)))
9753 (unless xref
9754 (setq xref (list (system-name))))
9755 (setq new-xref
9756 (concat
9757 (mapconcat 'identity
9758 (delete "Xref:" (delete new-xref xref))
9759 " ")
9760 " " new-xref))
9761 (with-current-buffer copy-buf 9739 (with-current-buffer copy-buf
9762 ;; First put the article in the destination group. 9740 (when (gnus-request-article-this-buffer article
9763 (gnus-request-article-this-buffer article gnus-newsgroup-name) 9741 gnus-newsgroup-name)
9764 (when (consp (setq art-group 9742 (save-restriction
9765 (gnus-request-accept-article 9743 (nnheader-narrow-to-headers)
9766 to-newsgroup select-method (not articles) t))) 9744 (dolist (hdr gnus-copy-article-ignored-headers)
9767 (setq new-xref (concat new-xref " " (car art-group) 9745 (message-remove-header hdr t)))
9768 ":" 9746 (gnus-request-accept-article
9769 (number-to-string (cdr art-group)))) 9747 to-newsgroup select-method (not articles) t))))
9770 ;; Now we have the new Xrefs header, so we insert 9748 ;; Crosspost the article.
9771 ;; it and replace the new article. 9749 ((eq action 'crosspost)
9772 (nnheader-replace-header "Xref" new-xref) 9750 (let ((xref (message-tokenize-header
9773 (gnus-request-replace-article 9751 (mail-header-xref (gnus-summary-article-header
9774 (cdr art-group) to-newsgroup (current-buffer) t) 9752 article))
9775 art-group)))))) 9753 " ")))
9776 (cond 9754 (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
9777 ((not art-group) 9755 ":" (number-to-string article)))
9778 (gnus-message 1 "Couldn't %s article %s: %s" 9756 (unless xref
9779 (cadr (assq action names)) article 9757 (setq xref (list (system-name))))
9780 (nnheader-get-report (car to-method)))) 9758 (setq new-xref
9781 ((eq art-group 'junk) 9759 (concat
9782 (when (eq action 'move) 9760 (mapconcat 'identity
9783 (gnus-summary-mark-article article gnus-canceled-mark) 9761 (delete "Xref:" (delete new-xref xref))
9784 (gnus-message 4 "Deleted article %s" article) 9762 " ")
9785 ;; run the delete hook 9763 " " new-xref))
9786 (run-hook-with-args 'gnus-summary-article-delete-hook 9764 (with-current-buffer copy-buf
9787 action 9765 ;; First put the article in the destination group.
9788 (gnus-data-header 9766 (gnus-request-article-this-buffer article gnus-newsgroup-name)
9789 (assoc article (gnus-data-list nil))) 9767 (when (consp (setq art-group
9790 gnus-newsgroup-original-name nil 9768 (gnus-request-accept-article
9791 select-method))) 9769 to-newsgroup select-method (not articles)
9792 (t 9770 t)))
9793 (let* ((pto-group (gnus-group-prefixed-name 9771 (setq new-xref (concat new-xref " " (car art-group)
9794 (car art-group) to-method)) 9772 ":"
9795 (info (gnus-get-info pto-group)) 9773 (number-to-string (cdr art-group))))
9796 (to-group (gnus-info-group info)) 9774 ;; Now we have the new Xrefs header, so we insert
9797 to-marks) 9775 ;; it and replace the new article.
9798 ;; Update the group that has been moved to. 9776 (nnheader-replace-header "Xref" new-xref)
9799 (when (and info 9777 (gnus-request-replace-article
9800 (memq action '(move copy))) 9778 (cdr art-group) to-newsgroup (current-buffer) t)
9801 (unless (member to-group to-groups) 9779 art-group))))))
9802 (push to-group to-groups)) 9780 (cond
9803 9781 ((not art-group)
9804 (unless (memq article gnus-newsgroup-unreads) 9782 (gnus-message 1 "Couldn't %s article %s: %s"
9805 (push 'read to-marks) 9783 (cadr (assq action names)) article
9806 (gnus-info-set-read 9784 (nnheader-get-report (car to-method))))
9807 info (gnus-add-to-range (gnus-info-read info) 9785 ((eq art-group 'junk)
9808 (list (cdr art-group))))) 9786 (when (eq action 'move)
9809 9787 (gnus-summary-mark-article article gnus-canceled-mark)
9810 ;; See whether the article is to be put in the cache. 9788 (gnus-message 4 "Deleted article %s" article)
9811 (let* ((expirable (gnus-group-auto-expirable-p to-group)) 9789 ;; run the delete hook
9812 (marks (if expirable 9790 (run-hook-with-args 'gnus-summary-article-delete-hook
9813 gnus-article-mark-lists 9791 action
9814 (delete '(expirable . expire) 9792 (gnus-data-header
9815 (copy-sequence gnus-article-mark-lists)))) 9793 (assoc article (gnus-data-list nil)))
9816 (to-article (cdr art-group))) 9794 gnus-newsgroup-original-name nil
9817 9795 select-method)))
9818 ;; Enter the article into the cache in the new group, 9796 (t
9819 ;; if that is required. 9797 (let* ((pto-group (gnus-group-prefixed-name
9820 (when gnus-use-cache 9798 (car art-group) to-method))
9821 (gnus-cache-possibly-enter-article 9799 (info (gnus-get-info pto-group))
9822 to-group to-article 9800 (to-group (gnus-info-group info))
9823 (memq article gnus-newsgroup-marked) 9801 to-marks)
9824 (memq article gnus-newsgroup-dormant) 9802 ;; Update the group that has been moved to.
9825 (memq article gnus-newsgroup-unreads))) 9803 (when (and info
9826 9804 (memq action '(move copy)))
9827 (when gnus-preserve-marks 9805 (unless (member to-group to-groups)
9828 ;; Copy any marks over to the new group. 9806 (push to-group to-groups))
9829 (when (and (equal to-group gnus-newsgroup-name) 9807
9830 (not (memq article gnus-newsgroup-unreads))) 9808 (unless (memq article gnus-newsgroup-unreads)
9831 ;; Mark this article as read in this group. 9809 (push 'read to-marks)
9832 (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) 9810 (gnus-info-set-read
9833 ;; Increase the active status of this group. 9811 info (gnus-add-to-range (gnus-info-read info)
9834 (setcdr (gnus-active to-group) to-article) 9812 (list (cdr art-group)))))
9835 (setcdr gnus-newsgroup-active to-article)) 9813
9836 9814 ;; See whether the article is to be put in the cache.
9837 (while marks 9815 (let* ((expirable (gnus-group-auto-expirable-p to-group))
9838 (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) 9816 (marks (if expirable
9839 (when (memq article (symbol-value 9817 gnus-article-mark-lists
9840 (intern (format "gnus-newsgroup-%s" 9818 (delete '(expirable . expire)
9841 (caar marks))))) 9819 (copy-sequence
9842 (push (cdar marks) to-marks) 9820 gnus-article-mark-lists))))
9843 ;; If the other group is the same as this group, 9821 (to-article (cdr art-group)))
9844 ;; then we have to add the mark to the list. 9822
9845 (when (equal to-group gnus-newsgroup-name) 9823 ;; Enter the article into the cache in the new group,
9846 (set (intern (format "gnus-newsgroup-%s" (caar marks))) 9824 ;; if that is required.
9847 (cons to-article 9825 (when gnus-use-cache
9848 (symbol-value 9826 (gnus-cache-possibly-enter-article
9849 (intern (format "gnus-newsgroup-%s" 9827 to-group to-article
9850 (caar marks))))))) 9828 (memq article gnus-newsgroup-marked)
9851 ;; Copy the marks to other group. 9829 (memq article gnus-newsgroup-dormant)
9852 (gnus-add-marked-articles 9830 (memq article gnus-newsgroup-unreads)))
9853 to-group (cdar marks) (list to-article) info))) 9831
9854 (setq marks (cdr marks))) 9832 (when gnus-preserve-marks
9855 9833 ;; Copy any marks over to the new group.
9856 (when (and expirable 9834 (when (and (equal to-group gnus-newsgroup-name)
9857 gnus-mark-copied-or-moved-articles-as-expirable 9835 (not (memq article gnus-newsgroup-unreads)))
9858 (not (memq 'expire to-marks))) 9836 ;; Mark this article as read in this group.
9859 ;; Mark this article as expirable. 9837 (push (cons to-article gnus-read-mark)
9860 (push 'expire to-marks) 9838 gnus-newsgroup-reads)
9861 (when (equal to-group gnus-newsgroup-name) 9839 ;; Increase the active status of this group.
9862 (push to-article gnus-newsgroup-expirable)) 9840 (setcdr (gnus-active to-group) to-article)
9863 ;; Copy the expirable mark to other group. 9841 (setcdr gnus-newsgroup-active to-article))
9864 (gnus-add-marked-articles 9842
9865 to-group 'expire (list to-article) info)) 9843 (while marks
9866 9844 (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
9867 (when to-marks 9845 (when (memq article (symbol-value
9868 (gnus-request-set-mark 9846 (intern (format "gnus-newsgroup-%s"
9869 to-group (list (list (list to-article) 'add to-marks))))) 9847 (caar marks)))))
9870 9848 (push (cdar marks) to-marks)
9871 (gnus-dribble-enter 9849 ;; If the other group is the same as this group,
9872 (concat "(gnus-group-set-info '" 9850 ;; then we have to add the mark to the list.
9873 (gnus-prin1-to-string (gnus-get-info to-group)) 9851 (when (equal to-group gnus-newsgroup-name)
9874 ")")))) 9852 (set (intern (format "gnus-newsgroup-%s"
9875 9853 (caar marks)))
9876 ;; Update the Xref header in this article to point to 9854 (cons to-article
9877 ;; the new crossposted article we have just created. 9855 (symbol-value
9878 (when (eq action 'crosspost) 9856 (intern (format "gnus-newsgroup-%s"
9879 (with-current-buffer copy-buf 9857 (caar marks)))))))
9880 (gnus-request-article-this-buffer article gnus-newsgroup-name) 9858 ;; Copy the marks to other group.
9881 (nnheader-replace-header "Xref" new-xref) 9859 (gnus-add-marked-articles
9882 (gnus-request-replace-article 9860 to-group (cdar marks) (list to-article) info)))
9883 article gnus-newsgroup-name (current-buffer) t))) 9861 (setq marks (cdr marks)))
9884 9862
9885 ;; run the move/copy/crosspost/respool hook 9863 (when (and expirable
9886 (let ((header (gnus-data-header 9864 gnus-mark-copied-or-moved-articles-as-expirable
9887 (assoc article (gnus-data-list nil))))) 9865 (not (memq 'expire to-marks)))
9888 (mail-header-set-subject header gnus-article-original-subject) 9866 ;; Mark this article as expirable.
9889 (run-hook-with-args 'gnus-summary-article-move-hook 9867 (push 'expire to-marks)
9890 action 9868 (when (equal to-group gnus-newsgroup-name)
9891 (gnus-data-header 9869 (push to-article gnus-newsgroup-expirable))
9892 (assoc article (gnus-data-list nil))) 9870 ;; Copy the expirable mark to other group.
9893 gnus-newsgroup-original-name 9871 (gnus-add-marked-articles
9894 to-newsgroup 9872 to-group 'expire (list to-article) info))
9895 select-method))) 9873
9896 9874 (when to-marks
9897 ;;;!!!Why is this necessary? 9875 (gnus-request-set-mark
9898 (set-buffer gnus-summary-buffer) 9876 to-group (list (list (list to-article) 'add to-marks)))))
9899 9877
9900 (when (eq action 'move) 9878 (gnus-dribble-enter
9901 (save-excursion 9879 (concat "(gnus-group-set-info '"
9902 (gnus-summary-goto-subject article) 9880 (gnus-prin1-to-string (gnus-get-info to-group))
9903 (gnus-summary-mark-article article gnus-canceled-mark))))) 9881 ")"))))
9904 (push article articles-to-update-marks)) 9882
9883 ;; Update the Xref header in this article to point to
9884 ;; the new crossposted article we have just created.
9885 (when (eq action 'crosspost)
9886 (with-current-buffer copy-buf
9887 (gnus-request-article-this-buffer article gnus-newsgroup-name)
9888 (nnheader-replace-header "Xref" new-xref)
9889 (gnus-request-replace-article
9890 article gnus-newsgroup-name (current-buffer) t)))
9891
9892 ;; run the move/copy/crosspost/respool hook
9893 (let ((header (gnus-data-header
9894 (assoc article (gnus-data-list nil)))))
9895 (mail-header-set-subject header gnus-article-original-subject)
9896 (run-hook-with-args 'gnus-summary-article-move-hook
9897 action
9898 (gnus-data-header
9899 (assoc article (gnus-data-list nil)))
9900 gnus-newsgroup-original-name
9901 to-newsgroup
9902 select-method)))
9903
9904 ;;;!!!Why is this necessary?
9905 (set-buffer gnus-summary-buffer)
9906
9907 (when (eq action 'move)
9908 (save-excursion
9909 (gnus-summary-goto-subject article)
9910 (gnus-summary-mark-article article gnus-canceled-mark)))))
9911 (push article articles-to-update-marks)))
9905 9912
9906 (save-excursion 9913 (save-excursion
9907 (apply 'gnus-summary-remove-process-mark articles-to-update-marks)) 9914 (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
@@ -9912,7 +9919,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9912 9919
9913 (gnus-kill-buffer copy-buf) 9920 (gnus-kill-buffer copy-buf)
9914 (gnus-summary-position-point) 9921 (gnus-summary-position-point)
9915 (gnus-set-mode-line 'summary)))) 9922 (gnus-set-mode-line 'summary)))
9916 9923
9917(defun gnus-summary-copy-article (&optional n to-newsgroup select-method) 9924(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
9918 "Copy the current article to some other group. 9925 "Copy the current article to some other group.