;;; Code:
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
:group 'gnus-article-various
:type 'boolean)
+(defcustom gnus-widen-article-window nil
+ "If non-nil, selecting the article buffer will display only the article buffer."
+ :version "24.1"
+ :group 'gnus-article-various
+ :type 'boolean)
+
(defcustom gnus-break-pages t
"*If non-nil, do page breaking on articles.
The page delimiter is specified by the `gnus-page-delimiter'
(defvar gnus-article-decoded-p nil)
(defvar gnus-article-charset nil)
(defvar gnus-article-ignored-charsets nil)
+(defvar gnus-article-original-subject nil)
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
(defvar gnus-current-copy-group nil)
(defvar gnus-current-crosspost-group nil)
(defvar gnus-newsgroup-display nil)
+(defvar gnus-newsgroup-original-name nil)
(defvar gnus-newsgroup-dependencies nil)
(defvar gnus-newsgroup-adaptive nil)
"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
"P" gnus-summary-print-article
"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)
"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
"v" gnus-version
"d" gnus-summary-describe-group
"h" gnus-summary-describe-briefly
- "i" gnus-info-find-node
- "C" gnus-group-fetch-control)
+ "i" gnus-info-find-node)
(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
"e" gnus-summary-expire-articles
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]
["Original sort" gnus-summary-sort-by-original t])
("Help"
["Describe group" gnus-summary-describe-group t]
- ["Fetch control message" gnus-group-fetch-control
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the archived control message for the current group"))]
["Read manual" gnus-info-find-node t])
("Modes"
["Pick and read" gnus-pick-mode t]
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
(setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
(gnus-summary-mode group)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'summary))
(when (gnus-group-quit-config group)
(set (make-local-variable 'gnus-single-article-buffer) nil))
(make-local-variable 'gnus-article-buffer)
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
- (let ((vars '(quit-config))) ; Ignore quit-config.
+ (let ((vars '(quit-config active))) ; Ignore things that aren't
+ ; really variables.
(dolist (elem (gnus-group-find-parameter group))
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(while (not (eobp))
(ignore-errors
(setq article (read (current-buffer))
- header (gnus-nov-parse-line article dependencies)))
+ header (gnus-nov-parse-line article dependencies t)))
(when header
(with-current-buffer gnus-summary-buffer
(push header gnus-newsgroup-headers)
(t
(gnus-thread-total-score-1 (list thread)))))
+(defun gnus-article-sort-by-most-recent-number (h1 h2)
+ "Sort articles by number."
+ (gnus-article-sort-by-number h1 h2))
+
(defun gnus-thread-sort-by-most-recent-number (h1 h2)
"Sort threads such that the thread with the most recently arrived article comes first."
(> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
(mail-header-number header))
(message-flatten-list thread))))
+(defun gnus-article-sort-by-most-recent-date (h1 h2)
+ "Sort articles by number."
+ (gnus-article-sort-by-date h1 h2))
+
(defun gnus-thread-sort-by-most-recent-date (h1 h2)
"Sort threads such that the thread with the most recently dated article comes first."
(> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
(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)
(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)
(unseen . unseen))
gnus-article-mark-lists))
(push (cons (cdr elem)
- (gnus-byte-compile
+ (gnus-byte-compile ;Why bother?
`(lambda () (gnus-article-marked-p ',(cdr elem)))))
gnus-summary-display-cache)))
(let ((gnus-category-predicate-alist gnus-summary-display-cache)
(gnus-category-predicate-cache gnus-summary-display-cache))
(gnus-get-predicate display)))
-;; Uses the dynamically bound `number' variable.
-(defvar number)
+;; Uses the dynamically bound `gnus-number' variable.
+(defvar gnus-number)
(defun gnus-article-marked-p (type &optional article)
- (let ((article (or article number)))
+ (let ((article (or article gnus-number)))
(cond
((eq type 'tick)
(memq article gnus-newsgroup-marked))
(info (nth 2 entry))
(active (gnus-active group))
range)
- (when entry
+ (if (not entry)
+ ;; Group that Gnus doesn't know exists, but still allow the
+ ;; backend to set marks.
+ (gnus-request-set-mark
+ group (list (list (gnus-compress-sequence (sort articles #'<))
+ 'add '(read))))
+ ;; Normal, subscribed groups.
(setq range (gnus-compute-read-articles group articles))
(with-current-buffer gnus-group-buffer
(gnus-undo-register
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
- "Reconfigure windows to show the article buffer."
+ "Reconfigure windows to show the article buffer.
+If `gnus-widen-article-buffer' is set, show only the article
+buffer."
(interactive)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(error "There is no article buffer for this summary buffer")
- (select-window (get-buffer-window gnus-article-buffer))
- (gnus-configure-windows 'only-article t)))
+ (unless (get-buffer-window gnus-article-buffer)
+ (gnus-summary-show-article))
+ (gnus-configure-windows
+ (if gnus-widen-article-window
+ 'only-article
+ 'article)
+ t)
+ (select-window (get-buffer-window gnus-article-buffer))))
(defun gnus-summary-universal-argument (arg)
"Perform any operation on all articles that are process/prefixed."
(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
(interactive "P")
- (gnus-summary-reselect-current-group all t))
+ (let ((config gnus-current-window-configuration))
+ (gnus-summary-reselect-current-group all t)
+ (gnus-configure-windows config)
+ (when (eq config 'article)
+ (gnus-summary-select-article))))
(defun gnus-summary-update-info (&optional non-destructive)
(save-excursion
(null (get-buffer gnus-article-buffer))
(not (eq article (cdr gnus-article-current)))
(not (equal (car gnus-article-current)
- gnus-newsgroup-name))))
+ gnus-newsgroup-name))
+ (not (get-buffer gnus-original-article-buffer))))
(and (not gnus-single-article-buffer)
(or (null gnus-current-article)
+ (not (get-buffer gnus-original-article-buffer))
(not (eq gnus-current-article article))))
force)
;; The requested article is different from the current article.
(unless gnus-newsgroup-display
(error "There is no `display' group parameter"))
(let (articles)
- (dolist (number gnus-newsgroup-articles)
+ (dolist (gnus-number gnus-newsgroup-articles)
(when (funcall gnus-newsgroup-display)
- (push number articles)))
+ (push gnus-number articles)))
(gnus-summary-limit articles))
(gnus-summary-position-point))
-(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
-(make-obsolete
- 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4")
-
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
If ALL is non-nil, limit strictly to unread articles."
(gnus-summary-limit gnus-newsgroup-replied))
(gnus-summary-position-point))
-(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
-(make-obsolete 'gnus-summary-delete-marked-with
- 'gnus-summary-limit-exclude-marks "Emacs 20.4")
-
(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
"Exclude articles that are marked with MARKS (e.g. \"DK\").
If REVERSE, limit the summary buffer to articles that are marked
article."
(interactive (list (mail-header-id (gnus-summary-article-header))))
(let ((articles (gnus-articles-in-thread
- (gnus-id-to-thread (gnus-root-id id)))))
+ (gnus-id-to-thread (gnus-root-id id))))
+ ;;we REALLY want the whole thread---this prevents cut-threads
+ ;;from removing the thread we want to include.
+ (gnus-fetch-old-headers nil)
+ (gnus-build-sparse-threads nil))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
(gnus-summary-limit-include-matching-articles
(apply '+ (mapcar 'gnus-summary-limit-children
(cdr thread)))
0))
- (number (mail-header-number (car thread)))
- score)
+ (number (mail-header-number (car thread)))
+ score)
(if (and
(not (memq number gnus-newsgroup-marked))
(or
t)
;; Do the `display' group parameter.
(and gnus-newsgroup-display
- (not (funcall gnus-newsgroup-display)))))
+ (let ((gnus-number number))
+ (not (funcall gnus-newsgroup-display))))))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
(defun gnus-summary-refer-thread (&optional limit)
"Fetch all articles in the current thread.
-If LIMIT (the numerical prefix), fetch that many old headers instead
-of what's specified by the `gnus-refer-thread-limit' variable."
+If no backend-specific 'request-thread function is available
+fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil
+fetch what's specified by the `gnus-refer-thread-limit'
+variable."
(interactive "P")
+ (gnus-warp-to-article)
(let ((id (mail-header-id (gnus-summary-article-header)))
+ (gnus-inhibit-demon t)
+ (gnus-agent nil)
+ (gnus-summary-ignore-duplicates t)
+ (gnus-read-all-available-headers t)
(limit (if limit (prefix-numeric-value limit)
gnus-refer-thread-limit)))
- (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 (eq (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))
- 'nov)
- (gnus-build-all-threads)
- (error "Can't fetch thread from back ends that don't support NOV"))
- (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
+ (setq gnus-newsgroup-headers
+ (gnus-merge
+ 'list gnus-newsgroup-headers
+ (if (gnus-check-backend-function
+ 'request-thread gnus-newsgroup-name)
+ (gnus-request-thread id)
+ (let* ((last (if (numberp limit)
+ (min (+ (mail-header-number
+ (gnus-summary-article-header))
+ limit)
+ gnus-newsgroup-highest)
+ gnus-newsgroup-highest))
+ (subject (gnus-simplify-subject
+ (mail-header-subject
+ (gnus-summary-article-header))))
+ (refs (split-string (or (mail-header-references
+ (gnus-summary-article-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)
(ps-despool filename))
(defun gnus-print-buffer ()
- (let ((buffer (generate-new-buffer " *print*")))
- (unwind-protect
- (progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-remove-text-with-property 'gnus-decoration)
- (when (gnus-visual-p 'article-highlight 'highlight)
- ;; Copy-to-buffer doesn't copy overlay. So redo
- ;; highlight.
- (let ((gnus-article-buffer buffer))
- (gnus-article-highlight-citation t)
- (gnus-article-highlight-signature)
- (gnus-article-emphasize)
- (gnus-article-delete-invisible-text)))
- (let ((ps-left-header
- (list
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-subject gnus-current-headers)
- 66) ")")
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-from gnus-current-headers)
- 45) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
- (concat "("
- (mail-header-date gnus-current-headers) ")"))))
- (gnus-run-hooks 'gnus-ps-print-hook)
- (save-excursion
- (if ps-print-color-p
- (ps-spool-buffer-with-faces)
- (ps-spool-buffer)))))
- (kill-buffer buffer))))
+ (let ((ps-left-header
+ (list
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-subject gnus-current-headers)
+ 66) ")")
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-from gnus-current-headers)
+ 45) ")")))
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
+ (concat "("
+ (mail-header-date gnus-current-headers) ")"))))
+ (gnus-run-hooks 'gnus-ps-print-hook)
+ (save-excursion
+ (if ps-print-color-p
+ (ps-spool-buffer-with-faces)
+ (ps-spool-buffer)))))
(defun gnus-summary-show-complete-article ()
"Show a complete version of the current article.
If ARG (the prefix) is a number, show the article with the charset
defined in `gnus-summary-show-article-charset-alist', or the charset
input.
-If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run. Normally, the key
-strokes are `C-u g'."
+If ARG (the prefix) is non-nil and not a number, show the article,
+but without running any of the article treatment functions
+article. Normally, the keystroke is `C-u g'. When using `C-u
+C-u g', show the raw article."
(interactive "P")
(cond
((numberp arg)
((not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force))
- (t
+ ((or (equal arg '(16))
+ (eq arg t))
+ ;; C-u C-u g
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
(require 'gnus-async)
;; 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))
articles)
(while articles
(setq article (pop articles))
- (setq
- art-group
- (cond
- ;; Move the article.
- ((eq action 'move)
- ;; Remove this article from future suppression.
- (gnus-dup-unsuppress-article article)
- (let* ((from-method (gnus-find-method-for-group
- gnus-newsgroup-name))
- (to-method (or select-method
- (gnus-find-method-for-group to-newsgroup)))
- (move-is-internal (gnus-server-equal from-method to-method)))
- (gnus-request-move-article
- article ; Article to move
- gnus-newsgroup-name ; From newsgroup
- (nth 1 (gnus-find-method-for-group
- gnus-newsgroup-name)) ; Server
- (list 'gnus-request-accept-article
- to-newsgroup (list 'quote select-method)
- (not articles) t) ; Accept form
- (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?
- ;; Copy the article.
- ((eq action 'copy)
- (with-current-buffer copy-buf
- (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
- (save-restriction
- (nnheader-narrow-to-headers)
- (dolist (hdr gnus-copy-article-ignored-headers)
- (message-remove-header hdr t)))
- (gnus-request-accept-article
- to-newsgroup select-method (not articles) t))))
- ;; Crosspost the article.
- ((eq action 'crosspost)
- (let ((xref (message-tokenize-header
- (mail-header-xref (gnus-summary-article-header article))
- " ")))
- (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
- ":" (number-to-string article)))
- (unless xref
- (setq xref (list (system-name))))
- (setq new-xref
- (concat
- (mapconcat 'identity
- (delete "Xref:" (delete new-xref xref))
- " ")
- " " new-xref))
+ (let ((gnus-newsgroup-original-name gnus-newsgroup-name)
+ (gnus-article-original-subject
+ (mail-header-subject
+ (gnus-data-header (assoc article (gnus-data-list nil))))))
+ (setq
+ art-group
+ (cond
+ ;; Move the article.
+ ((eq action 'move)
+ ;; Remove this article from future suppression.
+ (gnus-dup-unsuppress-article article)
+ (let* ((from-method (gnus-find-method-for-group
+ gnus-newsgroup-name))
+ (to-method (or select-method
+ (gnus-find-method-for-group to-newsgroup)))
+ (move-is-internal (gnus-server-equal from-method to-method)))
+ (gnus-request-move-article
+ article ; Article to move
+ gnus-newsgroup-name ; From newsgroup
+ (nth 1 (gnus-find-method-for-group
+ gnus-newsgroup-name)) ; Server
+ (list 'gnus-request-accept-article
+ to-newsgroup (list 'quote select-method)
+ (not articles) t) ; Accept form
+ (not articles) ; Only save nov last time
+ (and move-is-internal
+ to-newsgroup ; Not respooling
+ ; Is this move internal?
+ (gnus-group-real-name to-newsgroup)))))
+ ;; Copy the article.
+ ((eq action 'copy)
(with-current-buffer copy-buf
- ;; First put the article in the destination group.
- (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)))
- (setq new-xref (concat new-xref " " (car art-group)
- ":"
- (number-to-string (cdr art-group))))
- ;; Now we have the new Xrefs header, so we insert
- ;; it and replace the new article.
- (nnheader-replace-header "Xref" new-xref)
- (gnus-request-replace-article
- (cdr art-group) to-newsgroup (current-buffer) t)
- art-group))))))
- (cond
- ((not art-group)
- (gnus-message 1 "Couldn't %s article %s: %s"
- (cadr (assq action names)) article
- (nnheader-get-report (car to-method))))
- ((eq art-group 'junk)
- (when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article)
- ;; run the delete hook
- (run-hook-with-args 'gnus-summary-article-delete-hook
- action
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name nil
- select-method)))
- (t
- (let* ((pto-group (gnus-group-prefixed-name
- (car art-group) to-method))
- (info (gnus-get-info pto-group))
- (to-group (gnus-info-group info))
- to-marks)
- ;; Update the group that has been moved to.
- (when (and info
- (memq action '(move copy)))
- (unless (member to-group to-groups)
- (push to-group to-groups))
-
- (unless (memq article gnus-newsgroup-unreads)
- (push 'read to-marks)
- (gnus-info-set-read
- info (gnus-add-to-range (gnus-info-read info)
- (list (cdr art-group)))))
-
- ;; See whether the article is to be put in the cache.
- (let* ((expirable (gnus-group-auto-expirable-p to-group))
- (marks (if expirable
- gnus-article-mark-lists
- (delete '(expirable . expire)
- (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
- (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
- ;; 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)
- ;; Increase the active status of this group.
- (setcdr (gnus-active to-group) to-article)
- (setcdr gnus-newsgroup-active to-article))
-
- (while marks
- (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
- (when (memq article (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))
- (push (cdar marks) to-marks)
- ;; If the other group is the same as this group,
- ;; then we have to add the mark to the list.
- (when (equal to-group gnus-newsgroup-name)
- (set (intern (format "gnus-newsgroup-%s" (caar marks)))
- (cons to-article
- (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))))
- ;; Copy the marks to other group.
- (gnus-add-marked-articles
- to-group (cdar marks) (list to-article) info)))
- (setq marks (cdr marks)))
-
- (when (and expirable
- gnus-mark-copied-or-moved-articles-as-expirable
- (not (memq 'expire to-marks)))
- ;; Mark this article as expirable.
- (push 'expire to-marks)
- (when (equal to-group gnus-newsgroup-name)
- (push to-article gnus-newsgroup-expirable))
- ;; Copy the expirable mark to other group.
- (gnus-add-marked-articles
- to-group 'expire (list to-article) info))
-
- (when to-marks
- (gnus-request-set-mark
- to-group (list (list (list to-article) 'add to-marks)))))
-
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (gnus-get-info to-group))
- ")"))))
-
- ;; Update the Xref header in this article to point to
- ;; the new crossposted article we have just created.
- (when (eq action 'crosspost)
- (with-current-buffer copy-buf
- (gnus-request-article-this-buffer article gnus-newsgroup-name)
- (nnheader-replace-header "Xref" new-xref)
- (gnus-request-replace-article
- article gnus-newsgroup-name (current-buffer) t)))
-
- ;; run the move/copy/crosspost/respool hook
- (run-hook-with-args 'gnus-summary-article-move-hook
- action
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name
- to-newsgroup
- select-method))
-
- ;;;!!!Why is this necessary?
- (set-buffer gnus-summary-buffer)
-
- (when (eq action 'move)
- (save-excursion
- (gnus-summary-goto-subject article)
- (gnus-summary-mark-article article gnus-canceled-mark)))))
- (push article articles-to-update-marks))
+ (when (gnus-request-article-this-buffer article
+ gnus-newsgroup-name)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (dolist (hdr gnus-copy-article-ignored-headers)
+ (message-remove-header hdr t)))
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles) t))))
+ ;; Crosspost the article.
+ ((eq action 'crosspost)
+ (let ((xref (message-tokenize-header
+ (mail-header-xref (gnus-summary-article-header
+ article))
+ " ")))
+ (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
+ ":" (number-to-string article)))
+ (unless xref
+ (setq xref (list (system-name))))
+ (setq new-xref
+ (concat
+ (mapconcat 'identity
+ (delete "Xref:" (delete new-xref xref))
+ " ")
+ " " new-xref))
+ (with-current-buffer copy-buf
+ ;; First put the article in the destination group.
+ (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)))
+ (setq new-xref (concat new-xref " " (car art-group)
+ ":"
+ (number-to-string (cdr art-group))))
+ ;; Now we have the new Xrefs header, so we insert
+ ;; it and replace the new article.
+ (nnheader-replace-header "Xref" new-xref)
+ (gnus-request-replace-article
+ (cdr art-group) to-newsgroup (current-buffer) t)
+ art-group))))))
+ (cond
+ ((not art-group)
+ (gnus-message 1 "Couldn't %s article %s: %s"
+ (cadr (assq action names)) article
+ (nnheader-get-report (car to-method))))
+ ((eq art-group 'junk)
+ (when (eq action 'move)
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article)
+ ;; run the delete hook
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-original-name nil
+ select-method)))
+ (t
+ (let* ((pto-group (gnus-group-prefixed-name
+ (car art-group) to-method))
+ (info (gnus-get-info pto-group))
+ (to-group (gnus-info-group info))
+ to-marks)
+ ;; Update the group that has been moved to.
+ (when (and info
+ (memq action '(move copy)))
+ (unless (member to-group to-groups)
+ (push to-group to-groups))
+
+ (unless (memq article gnus-newsgroup-unreads)
+ (push 'read to-marks)
+ (gnus-info-set-read
+ info (gnus-add-to-range (gnus-info-read info)
+ (list (cdr art-group)))))
+
+ ;; See whether the article is to be put in the cache.
+ (let* ((expirable (gnus-group-auto-expirable-p to-group))
+ (marks (if expirable
+ gnus-article-mark-lists
+ (delete '(expirable . expire)
+ (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
+ (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
+ ;; 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)
+ ;; Increase the active status of this group.
+ (setcdr (gnus-active to-group) to-article)
+ (setcdr gnus-newsgroup-active to-article))
+
+ (while marks
+ (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+ (when (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))
+ (push (cdar marks) to-marks)
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s"
+ (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy the marks to other group.
+ (gnus-add-marked-articles
+ to-group (cdar marks) (list to-article) info)))
+ (setq marks (cdr marks)))
+
+ (when (and expirable
+ gnus-mark-copied-or-moved-articles-as-expirable
+ (not (memq 'expire to-marks)))
+ ;; Mark this article as expirable.
+ (push 'expire to-marks)
+ (when (equal to-group gnus-newsgroup-name)
+ (push to-article gnus-newsgroup-expirable))
+ ;; Copy the expirable mark to other group.
+ (gnus-add-marked-articles
+ to-group 'expire (list to-article) info))
+
+ (when to-marks
+ (gnus-request-set-mark
+ to-group (list (list (list to-article) 'add to-marks)))))
+
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (gnus-get-info to-group))
+ ")"))))
+
+ ;; Update the Xref header in this article to point to
+ ;; the new crossposted article we have just created.
+ (when (eq action 'crosspost)
+ (with-current-buffer copy-buf
+ (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (nnheader-replace-header "Xref" new-xref)
+ (gnus-request-replace-article
+ article gnus-newsgroup-name (current-buffer) t)))
+
+ ;; run the move/copy/crosspost/respool hook
+ (let ((header (gnus-data-header
+ (assoc article (gnus-data-list nil)))))
+ (mail-header-set-subject header gnus-article-original-subject)
+ (run-hook-with-args 'gnus-summary-article-move-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-original-name
+ to-newsgroup
+ select-method)))
+
+ ;;;!!!Why is this necessary?
+ (set-buffer gnus-summary-buffer)
+
+ (when (eq action 'move)
+ (save-excursion
+ (gnus-summary-goto-subject article)
+ (gnus-summary-mark-article article gnus-canceled-mark)))))
+ (push article articles-to-update-marks)))
(save-excursion
(apply 'gnus-summary-remove-process-mark articles-to-update-marks))
"Make edits to the current article permanent."
(interactive)
(save-excursion
- ;; The buffer restriction contains the entire article if it exists.
+ ;; 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)))
(delete-region (match-beginning 1) (match-end 1))
(insert (number-to-string lines))))))
;; Replace the article.
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ (article (cdr gnus-article-current))
+ replace-result)
(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)
- (current-buffer) t)))
+ (not (setq replace-result
+ (gnus-request-replace-article
+ article (car gnus-article-current)
+ (current-buffer) t))))
(error "Couldn't replace article")
+ ;; If we got a number back, then that's the new article number
+ ;; for this article. Otherwise, the article number didn't change.
+ (when (numberp replace-result)
+ (with-current-buffer gnus-summary-buffer
+ (setq gnus-newsgroup-limit (delq article gnus-newsgroup-limit))
+ (gnus-summary-limit gnus-newsgroup-limit)
+ (setq article replace-result)
+ (gnus-summary-goto-subject article t)))
;; Update the summary buffer.
(if (and references
(equal (message-tokenize-header references " ")
(point-min) (point-max)))
header)
(with-temp-buffer
- (insert (format "211 %d Article retrieved.\n"
- (cdr gnus-article-current)))
+ (insert (format "211 %d Article retrieved.\n" article))
(insert head)
(insert ".\n")
(let ((nntp-server-buffer (current-buffer)))
- (setq header (car (gnus-get-newsgroup-headers
- nil t))))
+ (setq header (car (gnus-get-newsgroup-headers nil t))))
(with-current-buffer gnus-summary-buffer
- (gnus-data-set-header
- (gnus-data-find (cdr gnus-article-current))
- header)
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header)
- (if (gnus-summary-goto-subject
- (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))))))
+ (gnus-data-set-header (gnus-data-find article) header)
+ (gnus-summary-update-article-line article header)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))))))
;; Update threads.
(set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current))
- (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))
+ (gnus-summary-update-article article)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))
;; Prettify the article buffer again.
(unless no-highlight
(with-current-buffer gnus-article-buffer
- ;;;!!! Fix this -- article should be rehighlighted.
- ;;;(gnus-run-hooks 'gnus-article-display-hook)
+ ;;!!! Fix this -- article should be rehighlighted.
+ ;;(gnus-run-hooks 'gnus-article-display-hook)
(set-buffer gnus-original-article-buffer)
(gnus-request-article
- (cdr gnus-article-current)
- (car gnus-article-current) (current-buffer))))
+ article (car gnus-article-current) (current-buffer))))
;; Prettify the summary buffer line.
(when (gnus-visual-p 'summary-highlight 'highlight)
(gnus-run-hooks 'gnus-visual-mark-article-hook))))))
(not (equal gnus-newsgroup-name (car gnus-article-current))))
(error "No current article selected"))
;; Remove old bookmark, if one exists.
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
;; Set the new bookmark, which is on the form
;; (article-number . line-number-in-body).
(push
;; Remove old bookmark, if one exists.
(if (not (assq article gnus-newsgroup-bookmarks))
(gnus-message 6 "No bookmark in current article.")
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
(gnus-message 6 "Removed bookmark.")))
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads
article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
;; See whether the article is to be put in the cache.
(and gnus-use-cache
(t
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
t)))
-(defalias 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward)
-(make-obsolete 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward "Emacs 20.4")
(defun gnus-summary-tick-article-forward (n)
"Tick N articles forwards.
If N is negative, tick backwards instead.
(interactive "p")
(gnus-summary-mark-forward n gnus-ticked-mark))
-(defalias 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward)
-(make-obsolete 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward "Emacs 20.4")
(defun gnus-summary-tick-article-backward (n)
"Tick N articles backwards.
The difference between N and the number of articles ticked is returned."
(interactive "p")
(gnus-summary-mark-forward (- n) gnus-ticked-mark))
-(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article "Emacs 20.4")
(defun gnus-summary-tick-article (&optional article clear-mark)
"Mark current article as unread.
Optional 1st argument ARTICLE specifies article number to be marked as unread.
(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)
((null split-name)
(gnus-group-completing-read
prom
- (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
+ (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
nil prefix nil default))
((= 1 (length split-name))
(gnus-group-completing-read
- prom (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
+ prom
+ (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
nil prefix 'gnus-group-history (car split-name)))
(t
(gnus-completing-read