X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=fb360fb81d89f47ae39ce2c26d03ab2de7bb33be;hb=2a6a3b915bd9a9025c8ad2541524b7413295e757;hp=592bd34115923aa092212fc72ab8be8f18118913;hpb=ff0935c032266211ffc258bd628f227a7d6dd84f;p=gnus diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 592bd3411..fb360fb81 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -44,6 +44,7 @@ (autoload 'gnus-cache-write-active "gnus-cache") (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) +(autoload 'gnus-pick-line-number "gnus-salt" nil t) (autoload 'mm-uu-dissect "mm-uu") (autoload 'gnus-article-outlook-deuglify-article "deuglify" "Deuglify broken Outlook (Express) articles and redisplay." @@ -421,6 +422,13 @@ this variable specifies group names." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) +(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix + "Function used to compute default prefix for article move/copy/etc prompts. +The function should take one argument, a group name, and return a +string with the suggested prefix." + :group 'gnus-summary-mail + :type 'function) + (defcustom gnus-unread-mark ? ;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks @@ -1166,7 +1174,6 @@ the normal Gnus MIME machinery." (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) (?i gnus-tmp-score ?d) (?z gnus-tmp-score-char ?c) - (?l (bbb-grouplens-score gnus-tmp-header) ?s) (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) (?U gnus-tmp-unread ?c) (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from) @@ -3984,8 +3991,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." "Translate STRING into something that doesn't contain weird characters." (mm-subst-char-in-string ?\r ?\- - (mm-subst-char-in-string - ?\n ?\- string))) + (mm-subst-char-in-string ?\n ?\- string t) t)) ;; This function has to be called with point after the article number ;; on the beginning of the line. @@ -4962,23 +4968,20 @@ or a straight list of headers." gnus-list-identifiers)) changed subject) (when regexp + (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)")) (dolist (header gnus-newsgroup-headers) (setq subject (mail-header-subject header) changed nil) - (while (string-match - (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)") - subject) + (while (string-match regexp subject) (setq subject - (concat (substring subject 0 (match-beginning 2)) + (concat (substring subject 0 (match-beginning 1)) (substring subject (match-end 0))) changed t)) - (when (and changed - (string-match - "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject)) - (setq subject - (concat (substring subject 0 (match-beginning 1)) - (substring subject (match-end 1))))) (when changed + (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject) + (setq subject + (concat (substring subject 0 (match-beginning 1)) + (substring subject (match-end 1))))) (mail-header-set-subject header subject)))))) (defun gnus-fetch-headers (articles) @@ -5035,17 +5038,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." group (gnus-status-message group))) (when gnus-agent - ;; The agent may be storing articles that are no longer in the - ;; server's active range. If that is the case, the active range - ;; needs to be expanded such that the agent's articles can be - ;; included in the summary. - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (alist (gnus-agent-load-alist group)) - (active (gnus-active group))) - (if (and (car alist) - (< (caar alist) (car active))) - (gnus-set-active group (cons (caar alist) (cdr active))))) - + (gnus-agent-possibly-alter-active group (gnus-active group) info) + (setq gnus-summary-use-undownloaded-faces (gnus-agent-find-parameter group @@ -5374,7 +5368,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - marks var articles article mark mark-type) + marks var articles article mark mark-type + bgn end) (dolist (marks marked-lists) (setq mark (car marks) @@ -5384,13 +5379,30 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; We set the variable according to the type of the marks list, ;; and then adjust the marks to a subset of the active articles. (cond - ;; Adjust "simple" lists. + ;; Adjust "simple" lists - compressed yet unsorted ((eq mark-type 'list) - (set var (setq articles (gnus-uncompress-range (cdr marks)))) - (when (memq mark '(tick dormant expire reply save)) - (while articles - (when (or (< (setq article (pop articles)) min) (> article max)) - (set var (delq article (symbol-value var))))))) + ;; Simultaneously uncompress and clip to active range + ;; See gnus-uncompress-range for a description of possible marks + (let (l lh) + (if (not (cadr marks)) + (set var nil) + (setq articles (if (numberp (cddr marks)) + (list (cdr marks)) + (cdr marks)) + lh (cons nil nil) + l lh) + + (while (setq article (pop articles)) + (cond ((consp article) + (setq bgn (max (car article) min) + end (min (cdr article) max)) + (while (<= bgn end) + (setq l (setcdr l (cons bgn nil)) + bgn (1+ bgn)))) + ((and (<= min article) + (>= max article)) + (setq l (setcdr l (cons article nil)))))) + (set var (cdr lh))))) ;; Adjust assocs. ((eq mark-type 'tuple) (set var (setq articles (cdr marks))) @@ -6317,15 +6329,15 @@ displayed, no centering will be performed." (while read (when first (while (< first nlast) - (push first unread) - (setq first (1+ first)))) + (setq unread (cons first unread) + first (1+ first)))) (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) (setq read (cdr read))))) ;; And add the last unread articles. (while (<= first last) - (push first unread) - (setq first (1+ first))) + (setq unread (cons first unread) + first (1+ first))) ;; Return the list of unread articles. (delq 0 (nreverse unread)))) @@ -6343,6 +6355,44 @@ displayed, no centering will be performed." (cdr (assq 'dormant marked))) (cdr (assq 'tick marked)))))) +;; This function returns a sequence of article numbers based on the +;; difference between the ranges of read articles in this group and +;; the range of active articles. +(defun gnus-sequence-of-unread-articles (group) + (let* ((read (gnus-info-read (gnus-get-info group))) + (active (or (gnus-active group) (gnus-activate-group group))) + (last (cdr active)) + first nlast unread) + ;; If none are read, then all are unread. + (if (not read) + (setq first (car active)) + ;; If the range of read articles is a single range, then the + ;; first unread article is the article after the last read + ;; article. Sounds logical, doesn't it? + (if (and (not (listp (cdr read))) + (or (< (car read) (car active)) + (progn (setq read (list read)) + nil))) + (setq first (max (car active) (1+ (cdr read)))) + ;; `read' is a list of ranges. + (when (/= (setq nlast (or (and (numberp (car read)) (car read)) + (caar read))) + 1) + (setq first (car active))) + (while read + (when first + (push (cons first nlast) unread)) + (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) + (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) + (setq read (cdr read))))) + ;; And add the last unread articles. + (cond ((< first last) + (push (cons first last) unread)) + ((= first last) + (push first unread))) + ;; Return the sequence of unread articles. + (delq 0 (nreverse unread)))) + ;; Various summary commands (defun gnus-summary-select-article-buffer () @@ -7546,10 +7596,9 @@ articles that are younger than AGE days." (if (numberp days) (progn (setq days-got t) - (if (< days 0) - (progn - (setq younger (not younger)) - (setq days (* days -1))))) + (when (< days 0) + (setq younger (not younger)) + (setq days (* days -1)))) (message "Please enter a number.") (sleep-for 1))) (list days younger))) @@ -7990,13 +8039,12 @@ fetch-old-headers verbiage, and so on." (and gnus-newsgroup-display (not (funcall gnus-newsgroup-display))) ;; Check NoCeM things. - (if (and gnus-use-nocem - (gnus-nocem-unwanted-article-p - (mail-header-id (car thread)))) - (progn - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - t)))) + (when (and gnus-use-nocem + (gnus-nocem-unwanted-article-p + (mail-header-id (car thread)))) + (setq gnus-newsgroup-unreads + (delq number gnus-newsgroup-unreads)) + t))) ;; Nope, invisible article. 0 ;; Ok, this article is to be visible, so we add it to the limit @@ -8832,7 +8880,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (let ((articles (gnus-summary-work-articles n)) (prefix (if (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) - (gnus-group-real-prefix gnus-newsgroup-name) + (funcall gnus-move-group-prefix-function + gnus-newsgroup-name) "")) (names '((move "Move" "Moving") (copy "Copy" "Copying")