/[emacs]/emacs/lisp/gnus/gnus-sum.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-sum.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.38.6.8 by miles, Thu Oct 14 08:50:05 2004 UTC revision 1.38.6.9 by miles, Fri Oct 22 10:13:33 2004 UTC
# Line 44  Line 44 
44  (autoload 'gnus-cache-write-active "gnus-cache")  (autoload 'gnus-cache-write-active "gnus-cache")
45  (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)  (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
46  (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)  (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
47    (autoload 'gnus-pick-line-number "gnus-salt" nil t)
48  (autoload 'mm-uu-dissect "mm-uu")  (autoload 'mm-uu-dissect "mm-uu")
49  (autoload 'gnus-article-outlook-deuglify-article "deuglify"  (autoload 'gnus-article-outlook-deuglify-article "deuglify"
50    "Deuglify broken Outlook (Express) articles and redisplay."    "Deuglify broken Outlook (Express) articles and redisplay."
# Line 2238  gnus-summary-show-article-from-menu-as-c Line 2239  gnus-summary-show-article-from-menu-as-c
2239                ["Pipe through a filter..." gnus-summary-pipe-output t]                ["Pipe through a filter..." gnus-summary-pipe-output t]
2240                ["Add to SOUP packet" gnus-soup-add-article t]                ["Add to SOUP packet" gnus-soup-add-article t]
2241                ["Print with Muttprint..." gnus-summary-muttprint t]                ["Print with Muttprint..." gnus-summary-muttprint t]
2242                ["Print" gnus-summary-print-article t])                ["Print" gnus-summary-print-article
2243               ("Backend"                 ,@(if (featurep 'xemacs) '(t)
2244                       '(:help "Generate and print a PostScript image"))])
2245                 ("Copy, move,... (Backend)"
2246                  ,@(if (featurep 'xemacs) '(t)
2247                      '(:help "Copying, moving, expiring articles..."))
2248                ["Respool article..." gnus-summary-respool-article t]                ["Respool article..." gnus-summary-respool-article t]
2249                ["Move article..." gnus-summary-move-article                ["Move article..." gnus-summary-move-article
2250                 (gnus-check-backend-function                 (gnus-check-backend-function
# Line 2330  gnus-summary-show-article-from-menu-as-c Line 2335  gnus-summary-show-article-from-menu-as-c
2335        `("Post"        `("Post"
2336          ["Send a message (mail or news)" gnus-summary-post-news          ["Send a message (mail or news)" gnus-summary-post-news
2337           ,@(if (featurep 'xemacs) '(t)           ,@(if (featurep 'xemacs) '(t)
2338               '(:help "Post an article"))]               '(:help "Compose a new message (mail or news)"))]
2339          ["Followup" gnus-summary-followup          ["Followup" gnus-summary-followup
2340           ,@(if (featurep 'xemacs) '(t)           ,@(if (featurep 'xemacs) '(t)
2341               '(:help "Post followup to this article"))]               '(:help "Post followup to this article"))]
# Line 3229  buffer that was in action when the last Line 3234  buffer that was in action when the last
3234        (save-excursion        (save-excursion
3235          (gnus-set-work-buffer)          (gnus-set-work-buffer)
3236          (let ((gnus-summary-line-format-spec spec)          (let ((gnus-summary-line-format-spec spec)
3237                (gnus-newsgroup-downloadable '(0)))                (gnus-newsgroup-downloadable '(0))
3238                  marks)
3239              (insert ?\200 "\200" ?\201 "\201" ?\202 "\202" ?\203 "\203")
3240              (while (not (bobp))
3241                (push (buffer-substring (1- (point)) (point)) marks)
3242                (backward-char))
3243              (erase-buffer)
3244            (gnus-summary-insert-line            (gnus-summary-insert-line
3245             [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]             [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
3246             0 nil t 128 t nil "" nil 1)             0 nil t 128 t nil "" nil 1)
3247            (goto-char (point-min))            (goto-char (point-min))
3248            (setq pos (list (cons 'unread            (setq pos (list (cons 'unread
3249                                  (and (search-forward                                  (and (or (search-forward (nth 0 marks) nil t)
3250                                        (mm-string-as-multibyte "\200") nil t)                                           (search-forward (nth 1 marks) nil t))
3251                                       (- (point) (point-min) 1)))))                                       (- (point) (point-min) 1)))))
3252            (goto-char (point-min))            (goto-char (point-min))
3253            (push (cons 'replied (and (search-forward            (push (cons 'replied (and (or (search-forward (nth 2 marks) nil t)
3254                                       (mm-string-as-multibyte "\201") nil t)                                          (search-forward (nth 3 marks) nil t))
3255                                      (- (point) (point-min) 1)))                                      (- (point) (point-min) 1)))
3256                  pos)                  pos)
3257            (goto-char (point-min))            (goto-char (point-min))
3258            (push (cons 'score (and (search-forward            (push (cons 'score (and (or (search-forward (nth 4 marks) nil t)
3259                                     (mm-string-as-multibyte "\202") nil t)                                        (search-forward (nth 5 marks) nil t))
3260                                    (- (point) (point-min) 1)))                                    (- (point) (point-min) 1)))
3261                  pos)                  pos)
3262            (goto-char (point-min))            (goto-char (point-min))
3263            (push (cons 'download (and (search-forward            (push (cons 'download (and (or (search-forward (nth 6 marks) nil t)
3264                                        (mm-string-as-multibyte "\203") nil t)                                           (search-forward (nth 7 marks) nil t))
3265                                       (- (point) (point-min) 1)))                                       (- (point) (point-min) 1)))
3266                  pos)))                  pos)))
3267        (setq gnus-summary-mark-positions pos))))        (setq gnus-summary-mark-positions pos))))
# Line 5065  If SELECT-ARTICLES, only select those ar Line 5076  If SELECT-ARTICLES, only select those ar
5076               group (gnus-status-message group)))               group (gnus-status-message group)))
5077    
5078      (when gnus-agent      (when gnus-agent
5079        ;; The agent may be storing articles that are no longer in the        (gnus-agent-possibly-alter-active group (gnus-active group) info)
5080        ;; 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)))))  
   
5081        (setq gnus-summary-use-undownloaded-faces        (setq gnus-summary-use-undownloaded-faces
5082              (gnus-agent-find-parameter              (gnus-agent-find-parameter
5083               group               group
# Line 5404  If SELECT-ARTICLES, only select those ar Line 5406  If SELECT-ARTICLES, only select those ar
5406           (min (car active))           (min (car active))
5407           (max (cdr active))           (max (cdr active))
5408           (types gnus-article-mark-lists)           (types gnus-article-mark-lists)
5409           marks var articles article mark mark-type)           marks var articles article mark mark-type
5410             bgn end)
5411    
5412      (dolist (marks marked-lists)      (dolist (marks marked-lists)
5413        (setq mark (car marks)        (setq mark (car marks)
# Line 5414  If SELECT-ARTICLES, only select those ar Line 5417  If SELECT-ARTICLES, only select those ar
5417        ;; We set the variable according to the type of the marks list,        ;; We set the variable according to the type of the marks list,
5418        ;; and then adjust the marks to a subset of the active articles.        ;; and then adjust the marks to a subset of the active articles.
5419        (cond        (cond
5420         ;; Adjust "simple" lists.         ;; Adjust "simple" lists - compressed yet unsorted
5421         ((eq mark-type 'list)         ((eq mark-type 'list)
5422          (set var (setq articles (gnus-uncompress-range (cdr marks))))          ;; Simultaneously uncompress and clip to active range
5423          (when (memq mark '(tick dormant expire reply save))          ;; See gnus-uncompress-range for a description of possible marks
5424            (while articles          (let (l lh)
5425              (when (or (< (setq article (pop articles)) min) (> article max))            (if (not (cadr marks))
5426                (set var (delq article (symbol-value var)))))))                (set var nil)
5427                (setq articles (if (numberp (cddr marks))
5428                                   (list (cdr marks))
5429                                 (cdr marks))
5430                      lh (cons nil nil)
5431                      l lh)
5432    
5433                (while (setq article (pop articles))
5434                  (cond ((consp article)
5435                         (setq bgn (max (car article) min)
5436                               end (min (cdr article) max))
5437                         (while (<= bgn end)
5438                           (setq l (setcdr l (cons bgn nil))
5439                                 bgn (1+ bgn))))
5440                        ((and (<= min article)
5441                              (>= max article))
5442                         (setq l (setcdr l (cons article nil))))))
5443                (set var (cdr lh)))))
5444         ;; Adjust assocs.         ;; Adjust assocs.
5445         ((eq mark-type 'tuple)         ((eq mark-type 'tuple)
5446          (set var (setq articles (cdr marks)))          (set var (setq articles (cdr marks)))
# Line 6353  displayed, no centering will be performe Line 6373  displayed, no centering will be performe
6373          (while read          (while read
6374            (when first            (when first
6375              (while (< first nlast)              (while (< first nlast)
6376                (push first unread)                (setq unread (cons first unread)
6377                (setq first (1+ first))))                      first (1+ first))))
6378            (setq first (1+ (if (atom (car read)) (car read) (cdar read))))            (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6379            (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))            (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6380            (setq read (cdr read)))))            (setq read (cdr read)))))
6381      ;; And add the last unread articles.      ;; And add the last unread articles.
6382      (while (<= first last)      (while (<= first last)
6383        (push first unread)        (setq unread (cons first unread)
6384        (setq first (1+ first)))              first (1+ first)))
6385      ;; Return the list of unread articles.      ;; Return the list of unread articles.
6386      (delq 0 (nreverse unread))))      (delq 0 (nreverse unread))))
6387    
# Line 6379  displayed, no centering will be performe Line 6399  displayed, no centering will be performe
6399             (cdr (assq 'dormant marked)))             (cdr (assq 'dormant marked)))
6400            (cdr (assq 'tick marked))))))            (cdr (assq 'tick marked))))))
6401    
6402    ;; This function returns a sequence of article numbers based on the
6403    ;; difference between the ranges of read articles in this group and
6404    ;; the range of active articles.
6405    (defun gnus-sequence-of-unread-articles (group)
6406      (let* ((read (gnus-info-read (gnus-get-info group)))
6407             (active (or (gnus-active group) (gnus-activate-group group)))
6408             (last (cdr active))
6409             first nlast unread)
6410        ;; If none are read, then all are unread.
6411        (if (not read)
6412            (setq first (car active))
6413          ;; If the range of read articles is a single range, then the
6414          ;; first unread article is the article after the last read
6415          ;; article.  Sounds logical, doesn't it?
6416          (if (and (not (listp (cdr read)))
6417                   (or (< (car read) (car active))
6418                       (progn (setq read (list read))
6419                              nil)))
6420              (setq first (max (car active) (1+ (cdr read))))
6421            ;; `read' is a list of ranges.
6422            (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6423                                      (caar read)))
6424                      1)
6425              (setq first (car active)))
6426            (while read
6427              (when first
6428                (push (cons first nlast) unread))
6429              (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6430              (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6431              (setq read (cdr read)))))
6432        ;; And add the last unread articles.
6433        (cond ((< first last)
6434               (push (cons first last) unread))
6435              ((= first last)
6436               (push first unread)))
6437        ;; Return the sequence of unread articles.
6438        (delq 0 (nreverse unread))))
6439    
6440  ;; Various summary commands  ;; Various summary commands
6441    
6442  (defun gnus-summary-select-article-buffer ()  (defun gnus-summary-select-article-buffer ()
# Line 11305  If REVERSE, save parts that do not match Line 11363  If REVERSE, save parts that do not match
11363           (default-high gnus-summary-default-high-score)           (default-high gnus-summary-default-high-score)
11364           (default-low gnus-summary-default-low-score)           (default-low gnus-summary-default-low-score)
11365           (uncached (and gnus-summary-use-undownloaded-faces           (uncached (and gnus-summary-use-undownloaded-faces
11366                          (memq article gnus-newsgroup-undownloaded))))                          (memq article gnus-newsgroup-undownloaded)
11367                            (not (memq article gnus-newsgroup-cached)))))
11368      (let ((face (funcall (gnus-summary-highlight-line-0))))      (let ((face (funcall (gnus-summary-highlight-line-0))))
11369        (unless (eq face (get-text-property beg 'face))        (unless (eq face (get-text-property beg 'face))
11370          (gnus-put-text-property-excluding-characters-with-faces          (gnus-put-text-property-excluding-characters-with-faces

Legend:
Removed from v.1.38.6.8  
changed lines
  Added in v.1.38.6.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26