Importing Pterodactyl Gnus v0.80.
[elisp/gnus.git-] / lisp / gnus-sum.el
index 73fe5f2..9a8a28c 100644 (file)
@@ -606,7 +606,7 @@ See `gnus-thread-score-function' for en explanation of what a
 \"thread score\" is.
 
 This variable is local to the summary buffers."
-  :group 'gnus-treading
+  :group 'gnus-threading
   :group 'gnus-score-default
   :type '(choice (const :tag "off" nil)
                 integer))
@@ -802,12 +802,23 @@ which it may alter in any way.")
     ("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
     ("^fj\\>\\|^japan\\>" iso-2022-jp-2)
     ("^relcom\\>" koi8-r)
+    ("^\\(cz\\|hun\\|pl\\|sk\\)\\>" iso-8859-2)
+    ("^israel\\>" iso-8859-1)
+    ("^han\\>" euc-kr)
+    ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
     (".*" iso-8859-1))
-  "Alist of regexps (to match group names) and default charsets to be used."
+  "Alist of regexps (to match group names) and default charsets to be used when reading."
   :type '(repeat (list (regexp :tag "Group")
                       (symbol :tag "Charset")))
   :group 'gnus-charset)
 
+(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit)
+  "List of charsets that should be ignored.
+When these charsets are used in the \"charset\" parameter, the
+default charset will be used instead."
+  :type '(repeat symbol)
+  :group 'gnus-charset)
+
 ;;; Internal variables
 
 (defvar gnus-article-mime-handles nil)
@@ -1264,6 +1275,7 @@ increase the score of each group you read."
     "\C-c\M-\C-s" gnus-summary-limit-include-expunged
     "\C-c\C-s\C-n" gnus-summary-sort-by-number
     "\C-c\C-s\C-l" gnus-summary-sort-by-lines
+    "\C-c\C-s\C-c" gnus-summary-sort-by-chars
     "\C-c\C-s\C-a" gnus-summary-sort-by-author
     "\C-c\C-s\C-s" gnus-summary-sort-by-subject
     "\C-c\C-s\C-d" gnus-summary-sort-by-date
@@ -1294,7 +1306,7 @@ increase the score of each group you read."
     "a" gnus-summary-post-news
     "x" gnus-summary-limit-to-unread
     "s" gnus-summary-isearch-article
-    "t" gnus-article-hide-headers
+    "t" gnus-summary-toggle-header
     "g" gnus-summary-show-article
     "l" gnus-summary-goto-last-article
     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
@@ -1356,6 +1368,7 @@ increase the score of each group you read."
     "a" gnus-summary-limit-to-author
     "u" gnus-summary-limit-to-unread
     "m" gnus-summary-limit-to-marks
+    "M" gnus-summary-limit-exclude-marks
     "v" gnus-summary-limit-to-score
     "*" gnus-summary-limit-include-cached
     "D" gnus-summary-limit-include-dormant
@@ -1444,6 +1457,8 @@ increase the score of each group you read."
     "o" gnus-article-treat-overstrike
     "e" gnus-article-emphasize
     "w" gnus-article-fill-cited-article
+    "Q" gnus-article-fill-long-lines
+    "C" gnus-article-capitalize-sentences
     "c" gnus-article-remove-cr
     "q" gnus-article-de-quoted-unreadable
     "f" gnus-article-display-x-face
@@ -1462,6 +1477,7 @@ increase the score of each group you read."
     "c" gnus-article-hide-citation
     "C" gnus-article-hide-citation-in-followups
     "p" gnus-article-hide-pgp
+    "B" gnus-article-strip-banner
     "P" gnus-article-hide-pem
     "\C-c" gnus-article-hide-citation-maybe)
 
@@ -1536,6 +1552,7 @@ increase the score of each group you read."
     "o" gnus-article-save-part
     "c" gnus-article-copy-part
     "e" gnus-article-externalize-part
+    "i" gnus-article-inline-part
     "|" gnus-article-pipe-part)
   )
 
@@ -1581,6 +1598,7 @@ increase the score of each group you read."
               ["Signature" gnus-article-hide-signature t]
               ["Citation" gnus-article-hide-citation t]
               ["PGP" gnus-article-hide-pgp t]
+             ["Banner" gnus-article-strip-banner t]
               ["Boring headers" gnus-article-hide-boring-headers t])
              ("Highlight"
               ["All" gnus-article-highlight t]
@@ -1612,6 +1630,8 @@ increase the score of each group you read."
               ["Dumb quotes" gnus-article-treat-dumbquotes t]
               ["Emphasis" gnus-article-emphasize t]
               ["Word wrap" gnus-article-fill-cited-article t]
+             ["Fill long lines" gnus-article-fill-long-lines t]
+             ["Capitalize sentences" gnus-article-capitalize-sentences t]
               ["CR" gnus-article-remove-cr t]
               ["Show X-Face" gnus-article-display-x-face t]
               ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
@@ -1765,6 +1785,7 @@ increase the score of each group you read."
        ["Hide childless dormant"
         gnus-summary-limit-exclude-childless-dormant t]
        ;;["Hide thread" gnus-summary-limit-exclude-thread t]
+       ["Hide marked" gnus-summary-limit-exclude-marks t]
        ["Show expunged" gnus-summary-show-all-expunged t])
        ("Process Mark"
        ["Set mark" gnus-summary-mark-as-processable t]
@@ -1811,7 +1832,8 @@ increase the score of each group you read."
        ["Sort by subject" gnus-summary-sort-by-subject t]
        ["Sort by date" gnus-summary-sort-by-date t]
        ["Sort by score" gnus-summary-sort-by-score t]
-       ["Sort by lines" gnus-summary-sort-by-lines t])
+       ["Sort by lines" gnus-summary-sort-by-lines t]
+       ["Sort by characters" gnus-summary-sort-by-chars t])
        ("Help"
        ["Fetch group FAQ" gnus-summary-fetch-faq t]
        ["Describe group" gnus-summary-describe-group t]
@@ -1981,8 +2003,6 @@ The following commands are available:
   (make-local-variable 'gnus-summary-dummy-line-format)
   (make-local-variable 'gnus-summary-dummy-line-format-spec)
   (make-local-variable 'gnus-summary-mark-positions)
-  (make-local-hook 'post-command-hook)
-  (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
   (make-local-hook 'pre-command-hook)
   (add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
   (gnus-run-hooks 'gnus-summary-mode-hook)
@@ -1992,9 +2012,8 @@ The following commands are available:
 
 (defun gnus-summary-make-local-variables ()
   "Make all the local summary buffer variables."
-  (let ((locals gnus-summary-local-variables)
-       global local)
-    (while (setq local (pop locals))
+  (let (global)
+    (dolist (local gnus-summary-local-variables)
       (if (consp local)
          (progn
            (if (eq (cdr local) 'global)
@@ -2002,11 +2021,9 @@ The following commands are available:
                (setq global (symbol-value (car local)))
              ;; Use the value from the list.
              (setq global (eval (cdr local))))
-           (make-local-variable (car local))
-           (set (car local) global))
+           (set (make-local-variable (car local)) global))
        ;; Simple nil-valued local variable.
-       (make-local-variable local)
-       (set local nil)))))
+       (set (make-local-variable local) nil)))))
 
 (defun gnus-summary-clear-local-variables ()
   (let ((locals gnus-summary-local-variables))
@@ -2436,7 +2453,8 @@ marks of articles."
 (defun gnus-summary-last-article-p (&optional article)
   "Return whether ARTICLE is the last article in the buffer."
   (if (not (setq article (or article (gnus-summary-article-number))))
-      t                                        ; All non-existent numbers are the last article.  :-)
+      ;; All non-existent numbers are the last article.  :-)
+      t
     (not (cdr (gnus-data-find-list article)))))
 
 (defun gnus-make-thread-indent-array ()
@@ -3160,31 +3178,6 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
             (setq heads nil)))))
      gnus-newsgroup-dependencies)))
 
-(defmacro gnus-nov-read-integer ()
-  '(prog1
-       (if (eq (char-after) ?\t)
-          0
-        (let ((num (ignore-errors (read buffer))))
-          (if (numberp num) num 0)))
-     (unless (eobp)
-       (search-forward "\t" eol 'move))))
-
-(defmacro gnus-nov-skip-field ()
-  '(search-forward "\t" eol 'move))
-
-(defmacro gnus-nov-field ()
-  '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-
-(defmacro gnus-nov-parse-extra ()
-  '(let (out string)
-     (while (not (memq (char-after) '(?\n nil)))
-       (setq string (gnus-nov-field))
-       (when (string-match "^\\([^ :]+\\): " string)
-        (push (cons (intern (match-string 1 string))
-                    (substring string (match-end 0)))
-              out)))
-     out))
-
 ;; This function has to be called with point after the article number
 ;; on the beginning of the line.
 (defsubst gnus-nov-parse-line (number dependencies &optional force-new)
@@ -3201,20 +3194,19 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
 
          (setq header
                (make-full-mail-header
-                number                 ; number
+                number                         ; number
                 (funcall gnus-decode-encoded-word-function
-                         (gnus-nov-field)) ; subject
+                         (nnheader-nov-field)) ; subject
                 (funcall gnus-decode-encoded-word-function
-                         (gnus-nov-field)) ; from
-                (gnus-nov-field)       ; date
-                (or (gnus-nov-field)
-                    (nnheader-generate-fake-message-id)) ; id
-                (gnus-nov-field)       ; refs
-                (gnus-nov-read-integer) ; chars
-                (gnus-nov-read-integer) ; lines
-                (unless (eq (char-after) ?\n)
-                  (gnus-nov-field))    ; misc
-                (gnus-nov-parse-extra)))) ; extra
+                         (nnheader-nov-field)) ; from
+                (nnheader-nov-field)           ; date
+                (nnheader-nov-read-message-id) ; id
+                (nnheader-nov-field)           ; refs
+                (nnheader-nov-read-integer)    ; chars
+                (nnheader-nov-read-integer)    ; lines
+                (unless (eobp)
+                  (nnheader-nov-field))                ; misc
+                (nnheader-nov-parse-extra))))  ; extra
 
       (widen))
 
@@ -3599,6 +3591,16 @@ If LINE, insert the rebuilt thread starting on line LINE."
   (gnus-article-sort-by-lines
    (gnus-thread-header h1) (gnus-thread-header h2)))
 
+(defsubst gnus-article-sort-by-chars (h1 h2)
+  "Sort articles by octet length."
+  (< (mail-header-chars h1)
+     (mail-header-chars h2)))
+
+(defun gnus-thread-sort-by-chars (h1 h2)
+  "Sort threads by root article octet length."
+  (gnus-article-sort-by-chars
+   (gnus-thread-header h1) (gnus-thread-header h2)))
+
 (defsubst gnus-article-sort-by-author (h1 h2)
   "Sort articles by root author."
   (string-lessp
@@ -4200,7 +4202,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
     out))
 
 (defun gnus-adjust-marked-articles (info)
-  "Set all article lists and remove all marks that are no longer legal."
+  "Set all article lists and remove all marks that are no longer valid."
   (let* ((marked-lists (gnus-info-marks info))
         (active (gnus-active (gnus-info-group info)))
         (min (car active))
@@ -4453,7 +4455,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
         (active (gnus-active group))
         ninfo)
     (when entry
-      ;; First peel off all illegal article numbers.
+      ;; First peel off all invalid article numbers.
       (when active
        (let ((ids articles)
              id first)
@@ -4522,15 +4524,6 @@ The resulting hash table is returned, or nil if no Xrefs were found."
        ;; Update the group buffer.
        (gnus-group-update-group group t)))))
 
-(defun gnus-methods-equal-p (m1 m2)
-  (let ((m1 (or m1 gnus-select-method))
-       (m2 (or m2 gnus-select-method)))
-    (or (equal m1 m2)
-       (and (eq (car m1) (car m2))
-            (or (not (memq 'address (assoc (symbol-name (car m1))
-                                           gnus-valid-select-methods)))
-                (equal (nth 1 m1) (nth 1 m2)))))))
-
 (defvar gnus-newsgroup-none-id 0)
 
 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
@@ -5719,7 +5712,9 @@ be displayed."
              ;; The requested article is different from the current article.
              (prog1
                  (gnus-summary-display-article article all-headers)
-               (setq did article))
+               (setq did article)
+               (when (or all-headers gnus-show-all-headers)
+                 (gnus-article-show-all-headers)))
            (when (or all-headers gnus-show-all-headers)
              (gnus-article-show-all-headers))
            'old))
@@ -6943,7 +6938,7 @@ article.  If BACKWARD (the prefix) is non-nil, search backward instead."
 If N is negative, print the N previous articles.  If N is nil and articles
 have been marked with the process mark, print these instead.
 
-If the optional second argument FILENAME is nil, send the image to the
+If the optional first argument FILENAME is nil, send the image to the
 printer.  If FILENAME is a string, save the PostScript image in a file with
 that name.  If FILENAME is a number, prompt the user for the name of the file
 to save in."
@@ -7022,27 +7017,30 @@ If ARG is a negative number, hide the unwanted header lines."
   (interactive "P")
   (save-excursion
     (set-buffer gnus-article-buffer)
-    (let* ((buffer-read-only nil)
-          (inhibit-point-motion-hooks t)
-          (hidden (text-property-any
-                   (goto-char (point-min)) (search-forward "\n\n")
-                   'invisible t))
-          e)
-      (goto-char (point-min))
-      (when (search-forward "\n\n" nil t)
-       (delete-region (point-min) (1- (point))))
-      (goto-char (point-min))
-      (save-excursion
-       (set-buffer gnus-original-article-buffer)
+    (save-restriction
+      (let* ((buffer-read-only nil)
+            (inhibit-point-motion-hooks t)
+            hidden e)
+       (save-restriction 
+         (message-narrow-to-head)
+         (setq hidden (gnus-article-hidden-text-p 'headers)))
+       (goto-char (point-min))
+       (when (search-forward "\n\n" nil t)
+         (delete-region (point-min) (1- (point))))
        (goto-char (point-min))
-       (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
-      (insert-buffer-substring gnus-original-article-buffer 1 e)
-      (narrow-to-region (point-min) (point))
-      (if (or (not hidden) (and (numberp arg) (< arg 0)))
-         (let ((gnus-treat-hide-headers nil)
-               (gnus-treat-hide-boring-headers nil))
-           (gnus-treat-article 'head))
-       (gnus-treat-article 'head)))))
+       (save-excursion
+         (set-buffer gnus-original-article-buffer)
+         (goto-char (point-min))
+         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+       (insert-buffer-substring gnus-original-article-buffer 1 e)
+       (save-restriction
+         (narrow-to-region (point-min) (point))
+         (if (or hidden
+                 (and (numberp arg) (< arg 0)))
+             (let ((gnus-treat-hide-headers nil)
+                   (gnus-treat-hide-boring-headers nil))
+               (gnus-treat-article 'head))
+           (gnus-treat-article 'head)))))))
 
 (defun gnus-summary-show-all-headers ()
   "Make all header lines visible."
@@ -7503,22 +7501,22 @@ This will have permanent effect only in mail groups.
 If FORCE is non-nil, allow editing of articles even in read-only
 groups."
   (interactive "P")
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (gnus-set-global-variables)
-    (when (and (not force)
-              (gnus-group-read-only-p))
-      (error "The current newsgroup does not support article editing"))
-    ;; Select article if needed.
-    (unless (eq (gnus-summary-article-number)
-               gnus-current-article)
-      (gnus-summary-select-article t))
-    (gnus-article-date-original)
-    (gnus-article-edit-article
-     `(lambda (no-highlight)
-       (gnus-summary-edit-article-done
-        ,(or (mail-header-references gnus-current-headers) "")
-        ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))
+  (let ((mail-parse-charset gnus-newsgroup-charset))
+    (save-excursion
+      (set-buffer gnus-summary-buffer)
+      (gnus-set-global-variables)
+      (when (and (not force)
+                (gnus-group-read-only-p))
+       (error "The current newsgroup does not support article editing"))
+      (gnus-summary-show-article t)
+      (gnus-article-edit-article
+       'mime-to-mml
+       `(lambda (no-highlight)
+         (let ((mail-parse-charset ',gnus-newsgroup-charset))
+           (mml-to-mime)
+           (gnus-summary-edit-article-done
+            ,(or (mail-header-references gnus-current-headers) "")
+            ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))))
 
 (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
 
@@ -7533,8 +7531,7 @@ groups."
       (if (and (not read-only)
               (not (gnus-request-replace-article
                     (cdr gnus-article-current) (car gnus-article-current)
-                    (current-buffer)
-                    (not gnus-article-decoded-p))))
+                    (current-buffer) t)))
          (error "Couldn't replace article")
        ;; Update the summary buffer.
        (if (and references
@@ -8073,7 +8070,8 @@ returned."
 The difference between N and the actual number of articles marked is
 returned."
   (interactive "p")
-  (gnus-summary-mark-forward (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
+  (gnus-summary-mark-forward
+   (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
 
 (defun gnus-summary-mark-as-read (&optional article mark)
   "Mark current article as read.
@@ -8598,11 +8596,17 @@ Argument REVERSE means reverse order."
   (gnus-summary-sort 'score reverse))
 
 (defun gnus-summary-sort-by-lines (&optional reverse)
-  "Sort the summary buffer by article length.
+  "Sort the summary buffer by the number of lines.
 Argument REVERSE means reverse order."
   (interactive "P")
   (gnus-summary-sort 'lines reverse))
 
+(defun gnus-summary-sort-by-chars (&optional reverse)
+  "Sort the summary buffer by article length.
+Argument REVERSE means reverse order."
+  (interactive "P")
+  (gnus-summary-sort 'chars reverse))  
+
 (defun gnus-summary-sort (predicate reverse)
   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
@@ -8639,10 +8643,9 @@ The variable `gnus-default-article-saver' specifies the saver function."
         (save-buffer (save-excursion
                        (nnheader-set-temp-buffer " *Gnus Save*")))
         (num (length articles))
-        header article file)
-    (while articles
-      (setq header (gnus-summary-article-header
-                   (setq article (pop articles))))
+        header file)
+    (dolist (article articles)
+      (setq header (gnus-summary-article-header article))
       (if (not (vectorp header))
          ;; This is a pseudo-article.
          (if (assq 'name header)
@@ -9171,7 +9174,8 @@ save those articles instead."
                   (gnus-group-real-name gnus-newsgroup-name))))
     (setq gnus-newsgroup-charset
          (or (and gnus-newsgroup-name
-                  (or (gnus-group-find-parameter gnus-newsgroup-name 'charset)
+                  (or (gnus-group-find-parameter gnus-newsgroup-name
+                                                 'charset)
                       (let ((alist gnus-group-charset-alist)
                             elem (charset nil))
                         (while (setq elem (pop alist))
@@ -9226,6 +9230,38 @@ treated as multipart/mixed."
        (gnus-summary-show-article))
     (gnus-summary-show-article)))
 
+;;;
+;;; with article
+;;;
+
+(defmacro gnus-with-article (article &rest forms)
+  "Select ARTICLE and perform FORMS in the original article buffer.
+Then replace the article with the result."
+  `(progn
+     ;; We don't want the article to be marked as read.
+     (let (gnus-mark-article-hook)
+       (gnus-summary-select-article t t nil ,article))
+     (set-buffer gnus-original-article-buffer)
+     ,@forms
+     (if (not (gnus-check-backend-function
+              'request-replace-article (car gnus-article-current)))
+        (gnus-message 5 "Read-only group; not replacing")
+       (unless (gnus-request-replace-article
+               ,article (car gnus-article-current)
+               (current-buffer) t)
+        (error "Couldn't replace article")))
+     ;; The cache and backlog have to be flushed somewhat.
+     (when gnus-keep-backlog
+       (gnus-backlog-remove-article
+       (car gnus-article-current) (cdr gnus-article-current)))
+     (when gnus-use-cache
+       (gnus-cache-update-article
+       (car gnus-article-current) (cdr gnus-article-current)))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
+
+
 (gnus-ems-redefine)
 
 (provide 'gnus-sum)