(gnus-summary-insert-old-articles): Make result of

[gnus] / lisp / gnus-sum.el

diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index fd9cc69..d06158f 100644 (file)
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -185,7 +185,7 @@ This applies to marking commands as well as other commands that
 the end of an article.
 
 If nil, the marking commands do NOT go to the next unread article
 the end of an article.
 
 If nil, the marking commands do NOT go to the next unread article

-(they go to the next article instead).  If `never', commands that
+\(they go to the next article instead).  If `never', commands that

 usually go to the next unread article, will go to the next article,
 whether it is read or not."
   :group 'gnus-summary-marks
 usually go to the next unread article, will go to the next article,
 whether it is read or not."
   :group 'gnus-summary-marks


@@ -866,6 +866,8 @@ automatically when it is selected."
      . gnus-summary-low-ancient-face)
     ((eq mark gnus-ancient-mark)
      . gnus-summary-normal-ancient-face)
      . gnus-summary-low-ancient-face)
     ((eq mark gnus-ancient-mark)
      . gnus-summary-normal-ancient-face)

+    (downloaded
+     . gnus-agent-downloaded-article-face)

     ((and (> score default-high) (eq mark gnus-unread-mark))
      . gnus-summary-high-unread-face)
     ((and (< score default-low) (eq mark gnus-unread-mark))
     ((and (> score default-high) (eq mark gnus-unread-mark))
      . gnus-summary-high-unread-face)
     ((and (< score default-low) (eq mark gnus-unread-mark))


@@ -1762,6 +1764,7 @@ increase the score of each group you read."
     "f" gnus-article-display-x-face
     "l" gnus-summary-stop-page-breaking
     "r" gnus-summary-caesar-message
     "f" gnus-article-display-x-face
     "l" gnus-summary-stop-page-breaking
     "r" gnus-summary-caesar-message

+    "m" gnus-summary-morse-message

     "t" gnus-summary-toggle-header
     "g" gnus-treat-smiley
     "v" gnus-summary-verbose-headers
     "t" gnus-summary-toggle-header
     "g" gnus-treat-smiley
     "v" gnus-summary-verbose-headers


@@ -1833,7 +1836,9 @@ increase the score of each group you read."
     "f" gnus-summary-fetch-faq
     "d" gnus-summary-describe-group
     "h" gnus-summary-describe-briefly
     "f" gnus-summary-fetch-faq
     "d" gnus-summary-describe-group
     "h" gnus-summary-describe-briefly

-    "i" gnus-info-find-node)
+    "i" gnus-info-find-node
+    "c" gnus-group-fetch-charter
+    "C" gnus-group-fetch-control)

 
   (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
     "e" gnus-summary-expire-articles
 
   (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
     "e" gnus-summary-expire-articles


@@ -2043,9 +2048,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
                   (sort (if (fboundp 'coding-system-list)
                             (coding-system-list)
                           (mapcar 'car mm-mime-mule-charset-alist))
                   (sort (if (fboundp 'coding-system-list)
                             (coding-system-list)
                           (mapcar 'car mm-mime-mule-charset-alist))

-                        (lambda (a b)
-                          (string< (symbol-name a)
-                                   (symbol-name b))))))))
+                        'string<)))))

             ("Washing"
              ("Remove Blanks"
               ["Leading" gnus-article-strip-leading-blank-lines t]
             ("Washing"
              ("Remove Blanks"
               ["Leading" gnus-article-strip-leading-blank-lines t]


@@ -2069,6 +2072,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
              ["Rot 13" gnus-summary-caesar-message
               ,@(if (featurep 'xemacs) '(t)
                   '(:help "\"Caesar rotate\" article by 13"))]
              ["Rot 13" gnus-summary-caesar-message
               ,@(if (featurep 'xemacs) '(t)
                   '(:help "\"Caesar rotate\" article by 13"))]

+             ["Morse decode" gnus-summary-morse-message t]

              ["Unix pipe..." gnus-summary-pipe-message t]
              ["Add buttons" gnus-article-add-buttons t]
              ["Add buttons to head" gnus-article-add-buttons-to-head t]
              ["Unix pipe..." gnus-summary-pipe-message t]
              ["Add buttons" gnus-article-add-buttons t]
              ["Add buttons to head" gnus-article-add-buttons-to-head t]


@@ -2334,6 +2338,12 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
        ("Help"
         ["Fetch group FAQ" gnus-summary-fetch-faq t]
         ["Describe group" gnus-summary-describe-group t]
        ("Help"
         ["Fetch group FAQ" gnus-summary-fetch-faq t]
         ["Describe group" gnus-summary-describe-group t]

+        ["Fetch charter" gnus-group-fetch-charter
+         ,@(if (featurep 'xemacs) nil
+             '(:help "Display the charter of the current group"))]
+        ["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]
         ["Read manual" gnus-info-find-node t])
        ("Modes"
         ["Pick and read" gnus-pick-mode t]


@@ -2847,7 +2857,7 @@ time; i.e., when generating the summary lines.  After that,
 marks of articles."
   `(cond
     ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
 marks of articles."
   `(cond
     ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)

-    ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)
+;;;;    ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)

     ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
     ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
     ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
     ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
     ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
     ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)


@@ -3838,7 +3848,7 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
 
     ;; overview: [num subject from date id refs chars lines misc]
     (unwind-protect
 
     ;; overview: [num subject from date id refs chars lines misc]
     (unwind-protect

-       (progn
+       (let (x)

          (narrow-to-region (point) eol)
          (unless (eobp)
            (forward-char))
          (narrow-to-region (point) eol)
          (unless (eobp)
            (forward-char))


@@ -3846,10 +3856,14 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
          (setq header
                (make-full-mail-header
                 number                 ; number
          (setq header
                (make-full-mail-header
                 number                 ; number

-                (funcall gnus-decode-encoded-word-function
-                         (nnheader-nov-field)) ; subject
-                (funcall gnus-decode-encoded-word-function
-                         (nnheader-nov-field)) ; from
+                (condition-case ()     ; subject
+                    (funcall gnus-decode-encoded-word-function
+                             (setq x (nnheader-nov-field)))
+                  (error x))
+                (condition-case ()     ; from
+                    (funcall gnus-decode-encoded-word-function
+                             (setq x (nnheader-nov-field)))
+                  (error x))

                 (nnheader-nov-field)   ; date
                 (nnheader-nov-read-message-id) ; id
                 (setq references (nnheader-nov-field)) ; refs
                 (nnheader-nov-field)   ; date
                 (nnheader-nov-read-message-id) ; id
                 (setq references (nnheader-nov-field)) ; refs


@@ -4888,7 +4902,6 @@ If SELECT-ARTICLES, only select those articles from GROUP."
     ;; Adjust and set lists of article marks.
     (when info
       (gnus-adjust-marked-articles info))
     ;; Adjust and set lists of article marks.
     (when info
       (gnus-adjust-marked-articles info))

-

     (if (setq articles select-articles)
        (setq gnus-newsgroup-unselected
              (gnus-sorted-difference gnus-newsgroup-unreads articles))
     (if (setq articles select-articles)
        (setq gnus-newsgroup-unselected
              (gnus-sorted-difference gnus-newsgroup-unreads articles))


@@ -4905,6 +4918,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
            (gnus-make-hashtable (length articles)))
       (gnus-set-global-variables)
       ;; Retrieve the headers and read them in.
            (gnus-make-hashtable (length articles)))
       (gnus-set-global-variables)
       ;; Retrieve the headers and read them in.

+

       (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
 
       ;; Kludge to avoid having cached articles nixed out in virtual groups.
       (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
 
       ;; Kludge to avoid having cached articles nixed out in virtual groups.


@@ -6555,7 +6569,9 @@ previous group instead."
                     ;; in case the user is prompted for info, and we
                     ;; don't want the window conf to change before
                     ;; that...
                     ;; in case the user is prompted for info, and we
                     ;; don't want the window conf to change before
                     ;; that...

-                    (gnus-summary-exit t)
+                    (when (gnus-buffer-live-p current-buffer)
+                      (set-buffer current-buffer)
+                      (gnus-summary-exit t))

                     (gnus-summary-read-group
                      target-group nil no-article
                      (and (buffer-name current-buffer) current-buffer)
                     (gnus-summary-read-group
                      target-group nil no-article
                      (and (buffer-name current-buffer) current-buffer)


@@ -8160,12 +8176,19 @@ article.  If BACKWARD (the prefix) is non-nil, search backward instead."
   ;; We don't want to change current point nor window configuration.
   (save-excursion
     (save-window-excursion
   ;; We don't want to change current point nor window configuration.
   (save-excursion
     (save-window-excursion

-      (gnus-message 6 "Executing %s..." (key-description command))
-;; We'd like to execute COMMAND interactively so as to give arguments.
-      (gnus-execute header regexp
-                   `(call-interactively ',(key-binding command))
-                   backward)
-      (gnus-message 6 "Executing %s...done" (key-description command)))))
+      (let (gnus-visual
+           gnus-treat-strip-trailing-blank-lines
+           gnus-treat-strip-leading-blank-lines
+           gnus-treat-strip-multiple-blank-lines
+           gnus-treat-hide-boring-headers
+           gnus-treat-fold-newsgroups
+           gnus-article-prepare-hook)
+       (gnus-message 6 "Executing %s..." (key-description command))
+       ;; We'd like to execute COMMAND interactively so as to give arguments.
+       (gnus-execute header regexp
+                     `(call-interactively ',(key-binding command))
+                     backward)
+       (gnus-message 6 "Executing %s...done" (key-description command))))))

 
 (defun gnus-summary-beginning-of-article ()
   "Scroll the article back to the beginning."
 
 (defun gnus-summary-beginning-of-article ()
   "Scroll the article back to the beginning."


@@ -8350,37 +8373,37 @@ If ARG is a negative number, hide the unwanted header lines."
   (interactive "P")
   (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
                     (get-buffer-window gnus-article-buffer t))))
   (interactive "P")
   (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
                     (get-buffer-window gnus-article-buffer t))))

-    (when window
-      (with-current-buffer gnus-article-buffer
+    (with-current-buffer gnus-article-buffer
+      (widen)
+      (article-narrow-to-head)
+      (let* ((buffer-read-only nil)
+            (inhibit-point-motion-hooks t)
+            (hidden (if (numberp arg)
+                        (>= arg 0)
+                      (gnus-article-hidden-text-p 'headers)))
+            s e)
+       (delete-region (point-min) (point-max))
+       (with-current-buffer gnus-original-article-buffer
+         (goto-char (setq s (point-min)))
+         (setq e (if (search-forward "\n\n" nil t)
+                     (1- (point))
+                   (point-max))))
+       (insert-buffer-substring gnus-original-article-buffer s e)
+       (article-decode-encoded-words)
+       (if hidden
+           (let ((gnus-treat-hide-headers nil)
+                 (gnus-treat-hide-boring-headers nil))
+             (gnus-delete-wash-type 'headers)
+             (gnus-treat-article 'head))
+         (gnus-treat-article 'head))

        (widen)
        (widen)

-       (article-narrow-to-head)
-       (let* ((buffer-read-only nil)
-              (inhibit-point-motion-hooks t)
-              (hidden (if (numberp arg)
-                          (>= arg 0)
-                        (gnus-article-hidden-text-p 'headers)))
-              s e)
-         (delete-region (point-min) (point-max))
-         (with-current-buffer gnus-original-article-buffer
-           (goto-char (setq s (point-min)))
-           (setq e (if (search-forward "\n\n" nil t)
-                       (1- (point))
-                     (point-max))))
-         (insert-buffer-substring gnus-original-article-buffer s e)
-         (article-decode-encoded-words)
-         (if hidden
-             (let ((gnus-treat-hide-headers nil)
-                   (gnus-treat-hide-boring-headers nil))
-               (gnus-delete-wash-type 'headers)
-               (gnus-treat-article 'head))
-           (gnus-treat-article 'head))
-         (widen)
-         (set-window-start window (goto-char (point-min)))
-         (setq gnus-page-broken
-               (when gnus-break-pages
-                 (gnus-narrow-to-page)
-                 t))
-         (gnus-set-mode-line 'article))))))
+       (if window
+           (set-window-start window (goto-char (point-min))))
+       (setq gnus-page-broken
+             (when gnus-break-pages
+               (gnus-narrow-to-page)
+               t))
+       (gnus-set-mode-line 'article)))))

 
 (defun gnus-summary-show-all-headers ()
   "Make all header lines visible."
 
 (defun gnus-summary-show-all-headers ()
   "Make all header lines visible."


@@ -8402,6 +8425,31 @@ forward."
          (message-caesar-buffer-body arg)
          (set-window-start (get-buffer-window (current-buffer)) start))))))
 
          (message-caesar-buffer-body arg)
          (set-window-start (get-buffer-window (current-buffer)) start))))))
 

+(autoload 'unmorse-region "morse"
+  "Convert morse coded text in region to ordinary ASCII text."
+  t)
+
+(defun gnus-summary-morse-message (&optional arg)
+  "Morse decode the current article."
+  (interactive "P")
+  (gnus-summary-select-article)
+  (let ((mail-header-separator ""))
+    (gnus-eval-in-buffer-window gnus-article-buffer
+      (save-excursion
+       (save-restriction
+         (widen)
+         (let ((pos (window-start))
+               buffer-read-only)
+           (goto-char (point-min))
+           (when (message-goto-body)
+             (gnus-narrow-to-body))
+           (goto-char (point-min))
+           (while (re-search-forward "·" (point-max) t)
+             (replace-match "."))
+           (unmorse-region (point-min) (point-max))
+           (widen)
+           (set-window-start (get-buffer-window (current-buffer)) pos)))))))
+

 (defun gnus-summary-stop-page-breaking ()
   "Stop page breaking in the current article."
   (interactive)
 (defun gnus-summary-stop-page-breaking ()
   "Stop page breaking in the current article."
   (interactive)


@@ -8930,8 +8978,12 @@ groups."
                     (setq gnus-article-mime-handles nil))))))
      (t
       (setq force t)))
                     (setq gnus-article-mime-handles nil))))))
      (t
       (setq force t)))

-    (when (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts"))
-      (error "Can't edit the raw article in group nndraft:drafts"))
+    (when (and raw (not force)
+              (member gnus-newsgroup-name '("nndraft:delayed"
+                                            "nndraft:drafts"
+                                            "nndraft:queue")))
+      (error "Can't edit the raw article in group %s"
+            gnus-newsgroup-name))

     (save-excursion
       (set-buffer gnus-summary-buffer)
       (let ((mail-parse-charset gnus-newsgroup-charset)
     (save-excursion
       (set-buffer gnus-summary-buffer)
       (let ((mail-parse-charset gnus-newsgroup-charset)


@@ -8944,7 +8996,7 @@ groups."
        (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
          (with-current-buffer gnus-article-buffer
            (mm-enable-multibyte)))
        (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
          (with-current-buffer gnus-article-buffer
            (mm-enable-multibyte)))

-       (if (equal gnus-newsgroup-name "nndraft:drafts")
+       (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))

            (setq raw t))
        (gnus-article-edit-article
         (if raw 'ignore
            (setq raw t))
        (gnus-article-edit-article
         (if raw 'ignore


@@ -10785,6 +10837,27 @@ If REVERSE, save parts that do not match TYPE."
           (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
           'face gnus-summary-selected-face))))))
 
           (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
           'face gnus-summary-selected-face))))))
 

+(defvar gnus-summary-highlight-line-cached nil)
+(defvar gnus-summary-highlight-line-trigger nil)
+(defun gnus-summary-highlight-line-0 ()
+  (if (and (eq gnus-summary-highlight-line-trigger 
+               gnus-summary-highlight)
+           gnus-summary-highlight-line-cached)
+      gnus-summary-highlight-line-cached
+    (setq gnus-summary-highlight-line-trigger gnus-summary-highlight
+          gnus-summary-highlight-line-cached
+          (let* ((cond (list 'cond))
+                 (c cond)
+                 (list gnus-summary-highlight))
+            (while list
+              (setcdr c (cons (list (caar list) (list 'quote (cdar list))) nil))
+              (setq c (cdr c)
+                    list (cdr list)))
+            (gnus-byte-compile (list 'lambda nil cond))))))
+
+(defvar gnus-summary-highlight-line-downloaded-alist nil)
+(defvar gnus-summary-highlight-line-downloaded-cached nil)
+

 ;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
 (defun gnus-summary-highlight-line ()
   "Highlight current line according to `gnus-summary-highlight'."
 ;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
 (defun gnus-summary-highlight-line ()
   "Highlight current line according to `gnus-summary-highlight'."


@@ -10798,12 +10871,23 @@ If REVERSE, save parts that do not match TYPE."
         (inhibit-read-only t)
         (default gnus-summary-default-score)
         (default-high gnus-summary-default-high-score)
         (inhibit-read-only t)
         (default gnus-summary-default-score)
         (default-high gnus-summary-default-high-score)

-        (default-low gnus-summary-default-low-score))
-    ;; Eval the cars of the lists until we find a match.
-    (while (and list
-               (not (eval (caar list))))
-      (setq list (cdr list)))
-    (let ((face (cdar list)))
+        (default-low gnus-summary-default-low-score)
+         (downloaded (and (boundp 'gnus-agent-article-alist)
+                          gnus-agent-article-alist
+                          ;; Optimized for when gnus-summary-highlight-line is called multiple times for articles in ascending order (i.e. initial generation of summary buffer).
+                          (progn 
+                            (if (and (eq gnus-summary-highlight-line-downloaded-alist gnus-agent-article-alist)
+                                     (<= (caar gnus-summary-highlight-line-downloaded-cached) article))
+                                nil
+                              (setq gnus-summary-highlight-line-downloaded-alist  gnus-agent-article-alist
+                                    gnus-summary-highlight-line-downloaded-cached gnus-agent-article-alist))
+                            (let (n)
+                              (while (and (< (caar gnus-summary-highlight-line-downloaded-cached) article)
+                                          (setq n (cdr gnus-summary-highlight-line-downloaded-cached)))
+                                (setq gnus-summary-highlight-line-downloaded-cached n)))
+                            (and (eq (caar gnus-summary-highlight-line-downloaded-cached) article)
+                                 (cdar gnus-summary-highlight-line-downloaded-cached))))))
+    (let ((face (funcall (gnus-summary-highlight-line-0))))

       (unless (eq face (get-text-property beg 'face))
        (gnus-put-text-property-excluding-characters-with-faces
         beg (gnus-point-at-eol) 'face
       (unless (eq face (get-text-property beg 'face))
        (gnus-put-text-property-excluding-characters-with-faces
         beg (gnus-point-at-eol) 'face


@@ -10908,7 +10992,7 @@ UNREAD is a sorted list."
 
 (defun gnus-summary-setup-default-charset ()
   "Setup newsgroup default charset."
 
 (defun gnus-summary-setup-default-charset ()
   "Setup newsgroup default charset."

-  (if (equal gnus-newsgroup-name "nndraft:drafts")
+  (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))

       (setq gnus-newsgroup-charset nil)
     (let* ((ignored-charsets
            (or gnus-newsgroup-ephemeral-ignored-charsets
       (setq gnus-newsgroup-charset nil)
     (let* ((ignored-charsets
            (or gnus-newsgroup-ephemeral-ignored-charsets


@@ -11090,15 +11174,31 @@ If ALL is a number, fetch this number of articles."
       (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
            older len)
        (setq older
       (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
            older len)
        (setq older

-             (gnus-sorted-difference
-              (gnus-uncompress-range (list gnus-newsgroup-active))
-              old))
-       (setq len (length older))
+;;; Some nntp servers lie about their active range.  When this happens, the active range can be in the millions.  
+;;;          (gnus-sorted-difference
+;;;           (gnus-uncompress-range (list gnus-newsgroup-active))
+;;;           old)
+             (gnus-uncompress-range
+              (gnus-remove-from-range (list gnus-newsgroup-active) old))
+)
+       (setq len (gnus-range-length older))

        (cond
         ((null older) nil)
         ((numberp all)
          (if (< all len)
        (cond
         ((null older) nil)
         ((numberp all)
          (if (< all len)

-             (setq older (last older all))))
+              (let ((older-range (nreverse older)))
+                (setq older nil)
+
+                (while (> all 0)
+                  (let* ((r (pop older-range))
+                         (min (if (numberp r) r (car r)))
+                         (max (if (numberp r) r (cdr r))))
+                    (while (and (<= min max)
+                                (> all 0))
+                      (push max older)
+                      (setq all (1- all)
+                            max (1- max))))))
+            (setq older (gnus-uncompress-range older))))

         (all nil)
         (t
          (if (and (numberp gnus-large-newsgroup)
         (all nil)
         (t
          (if (and (numberp gnus-large-newsgroup)


@@ -11120,7 +11220,19 @@ If ALL is a number, fetch this number of articles."
                (unless (string-match "^[ \t]*$" input)
                  (setq all (string-to-number input))
                  (if (< all len)
                (unless (string-match "^[ \t]*$" input)
                  (setq all (string-to-number input))
                  (if (< all len)

-                     (setq older (last older all))))))))
+                      (let ((older-range (nreverse older)))
+                        (setq older nil)
+
+                        (while (> all 0)
+                          (let* ((r (pop older-range))
+                                 (min (if (numberp r) r (car r)))
+                                 (max (if (numberp r) r (cdr r))))
+                            (while (and (<= min max)
+                                        (> all 0))
+                              (push max older)
+                              (setq all (1- all)
+                                    max (1- max))))))
+                    (setq older (gnus-uncompress-range older))))))))

        (if (not older)
            (message "No old news.")
          (gnus-summary-insert-articles older)
        (if (not older)
            (message "No old news.")
          (gnus-summary-insert-articles older)