(gnus-summary-insert-old-articles): Make result of
[gnus] / lisp / gnus-sum.el
index fd9cc69..d06158f 100644 (file)
@@ -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
-(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
@@ -866,6 +866,8 @@ automatically when it is selected."
      . 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))
@@ -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
+    "m" gnus-summary-morse-message
     "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
-    "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
@@ -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))
-                        (lambda (a b)
-                          (string< (symbol-name a)
-                                   (symbol-name b))))))))
+                        'string<)))))
             ("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"))]
+             ["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]
@@ -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]
+        ["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]
@@ -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)
-    ((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)
@@ -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
-       (progn
+       (let (x)
          (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
-                (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
@@ -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))
-
     (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.
+
       (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...
-                    (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)
@@ -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
-      (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."
@@ -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))))
-    (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)
-       (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."
@@ -8402,6 +8425,31 @@ forward."
          (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)
@@ -8930,8 +8978,12 @@ groups."
                     (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)
@@ -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)))
-       (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
@@ -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))))))
 
+(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'."
@@ -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)
-        (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
@@ -10908,7 +10992,7 @@ UNREAD is a sorted list."
 
 (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
@@ -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
-             (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)
-             (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)
@@ -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)
-                     (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)