X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=7cd199325a8047936d3a3102e90f1799d3b6b09c;hp=77d766b1acd1cd04f68c316b563bbd0c3122ee6d;hb=478473e45d7dced7f964d7772c8d12558fcc3072;hpb=173afc58a02260a715d5201ed6cbbb7ba6aca57d diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 77d766b1a..7cd199325 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -25,7 +25,7 @@ ;;; 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 @@ -474,6 +474,12 @@ If nil, each group will get its own article buffer." :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' @@ -3493,8 +3499,6 @@ display only a single character." ;; Fix by Sudish Joseph (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) @@ -3837,7 +3841,8 @@ This function is intended to be used in (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. @@ -4981,6 +4986,10 @@ Unscored articles will be counted as having a score of zero." (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))) @@ -4991,6 +5000,10 @@ Unscored articles will be counted as having a score of zero." (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))) @@ -5670,17 +5683,17 @@ If SELECT-ARTICLES, only select those articles from GROUP." (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)) @@ -6929,12 +6942,20 @@ displayed, no centering will be performed." ;; 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." @@ -7565,7 +7586,8 @@ be displayed." (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 (buffer-name gnus-original-article-buffer)))) (and (not gnus-single-article-buffer) (or (null gnus-current-article) (not (eq gnus-current-article article)))) @@ -8265,9 +8287,9 @@ articles that are younger than AGE days." (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)) @@ -8668,8 +8690,8 @@ fetch-old-headers verbiage, and so on." (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 @@ -8714,7 +8736,8 @@ fetch-old-headers verbiage, and so on." 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 @@ -8804,31 +8827,40 @@ Return the number of articles fetched." (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") (let ((id (mail-header-id (gnus-summary-article-header))) + (gnus-summary-ignore-duplicates 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)) + (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) + (gnus-build-all-threads)) (gnus-summary-limit-include-thread id))) (defun gnus-summary-refer-article (message-id) @@ -10228,7 +10260,7 @@ groups." "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))) @@ -10248,15 +10280,25 @@ groups." (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 " ") @@ -10270,38 +10312,29 @@ groups." (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)))))) @@ -10509,7 +10542,7 @@ ARTICLE can also be a list of articles." (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 @@ -10530,7 +10563,7 @@ ARTICLE can also be a list of articles." ;; 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 . @@ -10656,7 +10689,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (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 @@ -10830,13 +10863,9 @@ If NO-EXPIRE, auto-expiry will be inhibited." (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. @@ -10844,18 +10873,12 @@ 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-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. @@ -11908,11 +11931,12 @@ save those articles instead." ((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