X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=239247e554e6005b629905d7d95dea1a98b21d49;hb=0d5e6c123a87f1b6863d1990ef257bf8a676c3bf;hp=53c2e5e596f6fa9a56a211551ae0015c346f6a02;hpb=5fae237f9de60011b45ae21271329b556f4e5f08;p=gnus diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 53c2e5e59..239247e55 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -118,6 +118,13 @@ If t, fetch all the available old headers." :type '(choice number (sexp :menu-tag "other" t))) +(defcustom gnus-refer-thread-use-nnir nil + "*Use nnir to search an entire server when referring threads. A +nil value will only search for thread-related articles in the +current group." + :group 'gnus-thread + :type 'boolean) + (defcustom gnus-summary-make-false-root 'adopt "*nil means that Gnus won't gather loose threads. If the root of a thread has expired or been read in a previous @@ -368,7 +375,8 @@ place point on some subject line." (const unread) (const first) (const unseen) - (const unseen-or-unread))) + (const unseen-or-unread) + (function :tag "Function to call"))) (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. @@ -1491,9 +1499,6 @@ the type of the variable (string, integer, character, etc).") (defvar gnus-newsgroup-forwarded nil "List of articles that have been forwarded in the current newsgroup.") -(defvar gnus-newsgroup-recent nil - "List of articles that have are recent in the current newsgroup.") - (defvar gnus-newsgroup-expirable nil "Sorted list of articles in the current newsgroup that can be expired.") @@ -1570,7 +1575,6 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-forwarded - gnus-newsgroup-recent gnus-newsgroup-expirable gnus-newsgroup-killed gnus-newsgroup-unseen @@ -3702,7 +3706,9 @@ buffer that was in action when the last article was fetched." gnus-newsgroup-name)) 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) - (inline (gnus-summary-extract-address-component gnus-tmp-from))))) + (gnus-string-mark-left-to-right + (inline + (gnus-summary-extract-address-component gnus-tmp-from)))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -3733,8 +3739,6 @@ buffer that was in action when the last article was fetched." gnus-forwarded-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) gnus-saved-mark) - ((memq gnus-tmp-number gnus-newsgroup-recent) - gnus-recent-mark) ((memq gnus-tmp-number gnus-newsgroup-unseen) gnus-unseen-mark) (t gnus-no-mark))) @@ -4098,7 +4102,7 @@ If NO-DISPLAY, don't generate a summary buffer." (setq gnus-newsgroup-prepared t) (gnus-run-hooks 'gnus-summary-prepared-hook) (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group)) + (gnus-group-update-group group nil t)) t))))) (defun gnus-summary-auto-select-subject () @@ -5385,8 +5389,6 @@ or a straight list of headers." gnus-forwarded-mark) ((memq number gnus-newsgroup-saved) gnus-saved-mark) - ((memq number gnus-newsgroup-recent) - gnus-recent-mark) ((memq number gnus-newsgroup-unseen) gnus-unseen-mark) (t gnus-no-mark)) @@ -5715,7 +5717,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-summary-remove-list-identifiers) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) + (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group)))) ;; Set up the article buffer now, if necessary. (unless (and gnus-single-article-buffer (equal gnus-article-buffer "*Article*")) @@ -5796,8 +5799,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (memq article gnus-newsgroup-forwarded)) ((eq type 'seen) (not (memq article gnus-newsgroup-unseen))) - ((eq type 'recent) - (memq article gnus-newsgroup-recent)) (t t)))) (defun gnus-articles-to-read (group &optional read-all) @@ -6561,7 +6562,10 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (defun gnus-summary-insert-subject (id &optional old-header use-old-header) "Find article ID and insert the summary line for that article. OLD-HEADER can either be a header or a line number to insert -the subject line on." +the subject line on. +If USE-OLD-HEADER is non-nil, then OLD-HEADER should be a header, +and OLD-HEADER will be used when the summary line is inserted, +too, instead of trying to fetch new headers." (let* ((line (and (numberp old-header) old-header)) (old-header (and (vectorp old-header) old-header)) (header (cond ((and old-header use-old-header) @@ -7139,7 +7143,12 @@ The prefix argument ALL means to select all articles." t))) (unless (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) - (let ((headers gnus-newsgroup-headers)) + (let ((headers gnus-newsgroup-headers) + (ephemeral-p (gnus-ephemeral-group-p group)) + info) + (unless ephemeral-p + (setq info (copy-sequence (gnus-get-info group)) + info (delq (gnus-info-params info) info))) ;; Set the new ranges of read articles. (with-current-buffer gnus-group-buffer (gnus-undo-force-boundary)) @@ -7159,8 +7168,12 @@ The prefix argument ALL means to select all articles." (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group))))))) + (unless ephemeral-p + (gnus-group-update-group + group nil + (equal info + (setq info (copy-sequence (gnus-get-info group)) + info (delq (gnus-info-params info) info)))))))))) (defun gnus-summary-save-newsrc (&optional force) "Save the current number of read/marked articles in the dribble buffer. @@ -7191,9 +7204,14 @@ If FORCE (the prefix), also save the .newsrc file(s)." (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (gnus-group-is-exiting-p t) (article-buffer gnus-article-buffer) + (original-article-buffer gnus-original-article-buffer) (mode major-mode) (group-point nil) - (buf (current-buffer))) + (buf (current-buffer)) + ;; `gnus-single-article-buffer' is nil buffer-locally in + ;; ephemeral group of which summary buffer will be killed, + ;; but the global value may be non-nil. + (single-article-buffer gnus-single-article-buffer)) (unless quit-config ;; Do adaptive scoring, and possibly save score files. (when gnus-newsgroup-adaptive @@ -7256,14 +7274,14 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-configure-windows 'group 'force))) ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer + (unless 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)) + (gnus-kill-buffer original-article-buffer)) ;; Clear the current group name. (unless quit-config @@ -7284,6 +7302,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (run-hooks 'gnus-summary-prepare-exit-hook) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer + (gnus-article-stop-animations) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) @@ -7309,7 +7328,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." ;; Clear the current group name. (setq gnus-newsgroup-name nil) (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group)) + (gnus-group-update-group group nil t)) (when (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (when quit-config @@ -7321,6 +7340,9 @@ The state which existed when entering the ephemeral is reset." (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) + (unless (eq (cdr quit-config) 'group) + (setq gnus-current-select-method + (gnus-find-method-for-group gnus-newsgroup-name))) (cond ((eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) ((eq major-mode 'gnus-article-mode) @@ -8599,6 +8621,8 @@ fetched for this group." 'list gnus-newsgroup-headers (gnus-fetch-headers articles nil t) 'gnus-article-sort-by-number)) + (setq gnus-newsgroup-articles + (gnus-sorted-nunion gnus-newsgroup-articles articles)) (gnus-summary-limit (append articles gnus-newsgroup-limit)))) (defun gnus-summary-limit-exclude-dormant () @@ -8935,12 +8959,32 @@ Return the number of articles fetched." (gnus-summary-position-point) n))) +(defun gnus-delete-duplicate-headers (headers) + ;; First remove leading duplicates. + (while (and (> (length headers) 1) + (= (mail-header-number (car headers)) + (mail-header-number (cadr headers)))) + (pop headers)) + ;; Then the rest. + (let ((result headers)) + (while (> (length headers) 1) + (if (= (mail-header-number (car headers)) + (mail-header-number (cadr headers))) + (setcdr headers (cddr headers)) + (pop headers))) + result)) + (defun gnus-summary-refer-thread (&optional limit) - "Fetch all articles in the current thread. -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." + "Fetch all articles in the current thread. For backends that +know how to search for threads (currently only 'nnimap) a +non-numeric prefix arg will use nnir to search the entire +server; without a prefix arg only the current group is +searched. If the variable `gnus-refer-thread-use-nnir' is +non-nil the prefix arg has the reverse meaning. If no +backend-specific 'request-thread function is available fetch +LIMIT (the numerical prefix) old headers. If LIMIT is +non-numeric or nil fetch the number specified by the +`gnus-refer-thread-limit' variable." (interactive "P") (gnus-warp-to-article) (let* ((header (gnus-summary-article-header)) @@ -8948,35 +8992,52 @@ variable." (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))) + (gnus-refer-thread-use-nnir + (if (and (not (null limit)) (listp limit)) + (not gnus-refer-thread-use-nnir) gnus-refer-thread-use-nnir)) + (new-headers + (if (gnus-check-backend-function + 'request-thread gnus-newsgroup-name) + (gnus-request-thread header gnus-newsgroup-name) + (let* ((limit (if (numberp limit) (prefix-numeric-value limit) + gnus-refer-thread-limit)) + (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)))) + article-ids) + (when (listp new-headers) + (dolist (header new-headers) + (push (mail-header-number header) article-ids) + (when (member (mail-header-number header) gnus-newsgroup-unselected) + (push (mail-header-number header) gnus-newsgroup-unreads) + (setq gnus-newsgroup-unselected + (delete (mail-header-number header) + gnus-newsgroup-unselected)))) + (setq gnus-newsgroup-headers + (gnus-delete-duplicate-headers + (gnus-merge + 'list gnus-newsgroup-headers new-headers + 'gnus-article-sort-by-number))) + (setq gnus-newsgroup-articles + (gnus-sorted-nunion gnus-newsgroup-articles (nreverse article-ids))) + (gnus-summary-limit-include-thread id)))) (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") + (gnus-warp-to-article) (when (and (stringp message-id) (not (zerop (length message-id)))) (setq message-id (gnus-replace-in-string message-id " " "")) @@ -9035,7 +9096,12 @@ variable." (dolist (method gnus-refer-article-method) (push (if (eq 'current method) gnus-current-select-method - method) + (if (eq 'nnir (car method)) + (list + 'nnir + (or (cadr method) + (gnus-method-to-server gnus-current-select-method))) + method)) out)) (nreverse out))) ;; One single select method. @@ -9565,6 +9631,7 @@ C-u g', show the raw article." ;; Destroy any MIME parts. (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer + (gnus-article-stop-animations) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) @@ -9989,7 +10056,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-dribble-enter (concat "(gnus-group-set-info '" (gnus-prin1-to-string (gnus-get-info to-group)) - ")")))) + ")") + (concat "^(gnus-group-set-info '(\"" + (regexp-quote to-group) "\"")))) ;; Update the Xref header in this article to point to ;; the new crossposted article we have just created. @@ -10215,34 +10284,33 @@ This will be the case if the article has both been mailed and posted." ;; There are expirable articles in this group, so we run them ;; through the expiry process. (gnus-message 6 "Expiring articles...") - (unless (gnus-check-group gnus-newsgroup-name) - (error "Can't open server for %s" gnus-newsgroup-name)) - ;; The list of articles that weren't expired is returned. - (save-excursion - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (dolist (article expirable) - (when (and (not (memq article es)) - (gnus-data-find article)) - (gnus-summary-mark-article article gnus-canceled-mark) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - nil - nil)))))) + (when (gnus-check-group gnus-newsgroup-name) + ;; The list of articles that weren't expired is returned. + (save-excursion + (if expiry-wait + (let ((nnmail-expiry-wait-function nil) + (nnmail-expiry-wait expiry-wait)) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (unless total + (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (dolist (article expirable) + (when (and (not (memq article es)) + (gnus-data-find article)) + (gnus-summary-mark-article article gnus-canceled-mark) + (run-hook-with-args 'gnus-summary-article-expire-hook + 'delete + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + nil + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -10907,8 +10975,6 @@ If NO-EXPIRE, auto-expiry will be inhibited." gnus-forwarded-mark) ((memq article gnus-newsgroup-saved) gnus-saved-mark) - ((memq article gnus-newsgroup-recent) - gnus-recent-mark) ((memq article gnus-newsgroup-unseen) gnus-unseen-mark) (t gnus-no-mark)) @@ -11569,7 +11635,10 @@ Returns nil if no threads were there to be hidden." (let ((ol (gnus-make-overlay starteol (point) nil t nil))) (gnus-overlay-put ol 'invisible 'gnus-sum) (gnus-overlay-put ol 'evaporate t))) - (gnus-summary-goto-subject article)) + (gnus-summary-goto-subject article) + (when (> start (point)) + (message "Hiding the thread moved us backwards, aborting!") + (goto-char (point-max)))) (goto-char start) nil)))) @@ -12669,6 +12738,8 @@ returned." gnus-newsgroup-headers (gnus-fetch-headers articles) 'gnus-article-sort-by-number)) + (setq gnus-newsgroup-articles + (gnus-sorted-nunion gnus-newsgroup-articles articles)) ;; Suppress duplicates? (when gnus-suppress-duplicates (gnus-dup-suppress-articles)) @@ -12780,26 +12851,26 @@ If ALL is a number, fetch this number of articles." (defun gnus-summary-insert-new-articles () "Insert all new articles in this group." (interactive) - (prog1 - (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) - (old-high gnus-newsgroup-highest) - (nnmail-fetched-sources (list t)) - i new) - (setq gnus-newsgroup-active - (gnus-copy-sequence - (gnus-activate-group gnus-newsgroup-name 'scan))) - (setq i (cdr gnus-newsgroup-active) - gnus-newsgroup-highest i) - (while (> i old-high) - (push i new) - (decf i)) - (if (not new) - (message "No gnus is bad news") - (gnus-summary-insert-articles new) - (setq gnus-newsgroup-unreads - (gnus-sorted-nunion gnus-newsgroup-unreads new)) - (gnus-summary-limit (gnus-sorted-nunion old new)))) - (gnus-summary-position-point))) + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) + (old-high gnus-newsgroup-highest) + (nnmail-fetched-sources (list t)) + (new-active (gnus-activate-group gnus-newsgroup-name 'scan)) + i new) + (unless new-active + (error "Couldn't fetch new data")) + (setq gnus-newsgroup-active (gnus-copy-sequence new-active)) + (setq i (cdr gnus-newsgroup-active) + gnus-newsgroup-highest i) + (while (> i old-high) + (push i new) + (decf i)) + (if (not new) + (message "No gnus is bad news") + (gnus-summary-insert-articles new) + (setq gnus-newsgroup-unreads + (gnus-sorted-nunion gnus-newsgroup-unreads new)) + (gnus-summary-limit (gnus-sorted-nunion old new)))) + (gnus-summary-position-point)) ;;; Bookmark support for Gnus. (declare-function bookmark-make-record-default