Importing pgnus-0.32
[elisp/gnus.git-] / lisp / gnus-sum.el
index 7c5b55e..3823afe 100644 (file)
@@ -314,7 +314,7 @@ and non-`vertical', do both horizontal and vertical recentering."
   "*If non-nil, ignore articles with identical Message-ID headers."
   :group 'gnus-summary
   :type 'boolean)
-  
+
 (defcustom gnus-single-article-buffer t
   "*If non-nil, display all articles in the same buffer.
 If nil, each group will get its own article buffer."
@@ -328,13 +328,6 @@ variable."
   :group 'gnus-article-various
   :type 'boolean)
 
-(defcustom gnus-show-mime nil
-  "*If non-nil, do mime processing of articles.
-The articles will simply be fed to the function given by
-`gnus-show-mime-method'."
-  :group 'gnus-article-mime
-  :type 'boolean)
-
 (defcustom gnus-move-split-methods nil
   "*Variable used to suggest where articles are to be moved to.
 It uses the same syntax as the `gnus-split-methods' variable."
@@ -768,8 +761,13 @@ mark:    The articles mark."
 The function is called with one parameter, the article header vector,
 which it may alter in any way.")
 
+(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
+  "Variable that says which function should be used to decode a string with encoded words.")
+
 ;;; Internal variables
 
+(defvar gnus-article-mime-handles nil)
+(defvar gnus-article-decoded-p nil)
 (defvar gnus-scores-exclude-files nil)
 (defvar gnus-page-broken nil)
 
@@ -989,6 +987,25 @@ variable (string, integer, character, etc).")
 ;; Byte-compiler warning.
 (defvar gnus-article-mode-map)
 
+;; MIME stuff.
+
+(defvar gnus-encoded-word-method-alist
+  '(("chinese" mail-decode-encoded-word-string rfc1843-decode-string)
+    (".*" mail-decode-encoded-word-string))
+  "Alist of regexps (to match group names) and lists of functions to be applied.")
+
+(defun gnus-multi-decode-encoded-word-string (string)
+  "Apply the functions from `gnus-encoded-word-method-alist' that match."
+  (let ((alist gnus-encoded-word-method-alist)
+       elem)
+    (while (setq elem (pop alist))
+      (when (string-match (car elem) gnus-newsgroup-name)
+       (pop elem)
+       (while elem
+         (setq string (funcall (pop elem) string)))
+       (setq alist nil)))
+    string))
+
 ;; Subject simplification.
 
 (defun gnus-simplify-whitespace (str)
@@ -1188,7 +1205,6 @@ increase the score of each group you read."
     "\M-g" gnus-summary-rescan-group
     "w" gnus-summary-stop-page-breaking
     "\C-c\C-r" gnus-summary-caesar-message
-    "\M-t" gnus-summary-toggle-mime
     "f" gnus-summary-followup
     "F" gnus-summary-followup-with-original
     "C" gnus-summary-cancel-article
@@ -1226,7 +1242,7 @@ increase the score of each group you read."
     "L" gnus-summary-lower-score
     "\M-i" gnus-symbolic-argument
     "h" gnus-summary-select-article-buffer
-    
+
     "V" gnus-summary-score-map
     "X" gnus-uu-extract-map
     "S" gnus-summary-send-map)
@@ -1363,7 +1379,6 @@ increase the score of each group you read."
     "r" gnus-summary-caesar-message
     "t" gnus-article-hide-headers
     "v" gnus-summary-verbose-headers
-    "m" gnus-summary-toggle-mime
     "h" gnus-article-treat-html
     "d" gnus-article-treat-dumbquotes)
 
@@ -1519,7 +1534,6 @@ increase the score of each group you read."
               ["Add buttons" gnus-article-add-buttons t]
               ["Add buttons to head" gnus-article-add-buttons-to-head t]
               ["Stop page breaking" gnus-summary-stop-page-breaking t]
-              ["Toggle MIME" gnus-summary-toggle-mime t]
               ["Verbose header" gnus-summary-verbose-headers t]
               ["Toggle header" gnus-summary-toggle-header t])
              ("Output"
@@ -1865,7 +1879,7 @@ The following commands are available:
   (setq mode-name "Summary")
   (make-local-variable 'minor-mode-alist)
   (use-local-map gnus-summary-mode-map)
-  (buffer-disable-undo (current-buffer))
+  (buffer-disable-undo)
   (setq buffer-read-only t)            ;Disable modification
   (setq truncate-lines t)
   (setq selective-display t)
@@ -2030,20 +2044,6 @@ The following commands are available:
     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
     (setq data (cdr data))))
 
-(defun gnus-data-compute-positions ()
-  "Compute the positions of all articles."
-  (setq gnus-newsgroup-data-reverse nil)
-  (let ((data gnus-newsgroup-data))
-    (save-excursion
-      (gnus-save-hidden-threads
-       (goto-char (point-min))
-       (while data
-         (while (get-text-property (point) 'gnus-intangible)
-           (forward-line 1))
-         (gnus-data-set-pos (car data) (+ (point) 3))
-         (setq data (cdr data))
-         (forward-line 1))))))
-
 (defun gnus-summary-article-pseudo-p (article)
   "Say whether this article is a pseudo article or not."
   (not (vectorp (gnus-data-header (gnus-data-find article)))))
@@ -2211,6 +2211,21 @@ marks of articles."
             ,@forms)
         (gnus-restore-hidden-threads-configuration ,config)))))
 
+(defun gnus-data-compute-positions ()
+  "Compute the positions of all articles."
+  (setq gnus-newsgroup-data-reverse nil)
+  (let ((data gnus-newsgroup-data))
+    (save-excursion
+      (gnus-save-hidden-threads
+       (gnus-summary-show-all-threads)
+       (goto-char (point-min))
+       (while data
+         (while (get-text-property (point) 'gnus-intangible)
+           (forward-line 1))
+         (gnus-data-set-pos (car data) (+ (point) 3))
+         (setq data (cdr data))
+         (forward-line 1))))))
+
 (defun gnus-hidden-threads-configuration ()
   "Return the current hidden threads configuration."
   (save-excursion
@@ -2430,7 +2445,7 @@ marks of articles."
       (setq gnus-tmp-name gnus-tmp-from))
     (unless (numberp gnus-tmp-lines)
       (setq gnus-tmp-lines 0))
-    (gnus-put-text-property-excluding-characters-with-faces
+    (gnus-put-text-property
      (point)
      (progn (eval gnus-summary-line-format-spec) (point))
      'gnus-number gnus-tmp-number)
@@ -2679,7 +2694,7 @@ If NO-DISPLAY, don't generate a summary buffer."
          (goto-char (point-min))
          (gnus-summary-position-point)
          (gnus-configure-windows 'summary 'force)
-         (gnus-set-mode-line 'summary))        
+         (gnus-set-mode-line 'summary))
        (when (get-buffer-window gnus-group-buffer t)
          ;; Gotta use windows, because recenter does weird stuff if
          ;; the current buffer ain't the displayed window.
@@ -2879,7 +2894,7 @@ If NO-DISPLAY, don't generate a summary buffer."
     threads))
 
 ;; Build the thread tree.
-(defun gnus-dependencies-add-header (header dependencies force-new)
+(defsubst gnus-dependencies-add-header (header dependencies force-new)
   "Enter HEADER into the DEPENDENCIES table if it is not already there.
 
 If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
@@ -3060,8 +3075,10 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
          (setq header
                (make-full-mail-header
                 number                 ; number
-                (rfc2047-decode-string (gnus-nov-field)) ; subject
-                (rfc2047-decode-string (gnus-nov-field)) ; from
+                (funcall gnus-decode-encoded-word-function
+                         (gnus-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
@@ -3386,6 +3403,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
                  (while thread
                    (gnus-remove-thread-1 (car thread))
                    (setq thread (cdr thread))))
+             (gnus-summary-show-all-threads)
              (gnus-remove-thread-1 thread))))))))
 
 (defun gnus-remove-thread-1 (thread)
@@ -3771,7 +3789,7 @@ or a straight list of headers."
              (setq gnus-tmp-name gnus-tmp-from))
            (unless (numberp gnus-tmp-lines)
              (setq gnus-tmp-lines 0))
-           (gnus-put-text-property-excluding-characters-with-faces
+           (gnus-put-text-property
             (point)
             (progn (eval gnus-summary-line-format-spec) (point))
             'gnus-number number)
@@ -3894,6 +3912,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
       ;; Init the dependencies hash table.
       (setq gnus-newsgroup-dependencies
            (gnus-make-hashtable (length articles)))
+      (gnus-set-global-variables)
       ;; Retrieve the headers and read them in.
       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
       (setq gnus-newsgroup-headers
@@ -4309,7 +4328,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
       ;; Then we add the read articles to the range.
       (gnus-add-to-range
        ninfo (setq articles (sort articles '<))))))
-  
+
 (defun gnus-group-make-articles-read (group articles)
   "Update the info of GROUP to say that ARTICLES are read."
   (let* ((num 0)
@@ -4403,13 +4422,15 @@ The resulting hash table is returned, or nil if no Xrefs were found."
            (progn
              (goto-char p)
              (if (search-forward "\nsubject: " nil t)
-                 (rfc2047-decode-string (nnheader-header-value))
+                 (funcall gnus-decode-encoded-word-function
+                          (nnheader-header-value))
                "(none)"))
            ;; From.
            (progn
              (goto-char p)
              (if (search-forward "\nfrom: " nil t)
-                 (rfc2047-decode-string (nnheader-header-value))
+                 (funcall gnus-decode-encoded-word-function
+                          (nnheader-header-value))
                "(nobody)"))
            ;; Date.
            (progn
@@ -4529,10 +4550,9 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
                                     number dependencies force-new))))
                   (push header headers))
              (forward-line 1))
-         ;(error
-         ; (gnus-error 4 "Strange nov line (%d)"
-       ;              (count-lines (point-min) (point))))
-         )
+         (error
+          (gnus-error 4 "Strange nov line (%d)"
+                      (count-lines (point-min) (point)))))
        (forward-line 1))
       ;; A common bug in inn is that if you have posted an article and
       ;; then retrieves the active file, it will answer correctly --
@@ -5010,7 +5030,7 @@ The prefix argument ALL means to select all articles."
          (gnus-update-read-articles
           group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
          ;; Set the current article marks.
-         (let ((gnus-newsgroup-scored 
+         (let ((gnus-newsgroup-scored
                 (if (and (not gnus-save-score)
                          (not non-destructive))
                     nil
@@ -5085,6 +5105,10 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
     (setq group-point (point))
     (if temporary
        nil                             ;Nothing to do.
+      (when (gnus-buffer-live-p gnus-article-buffer)
+       (save-excursion
+         (set-buffer gnus-article-buffer)
+         (mapcar 'mm-destroy-part gnus-article-mime-handles)))
       ;; If we have several article buffers, we kill them at exit.
       (unless gnus-single-article-buffer
        (gnus-kill-buffer gnus-article-buffer)
@@ -5109,12 +5133,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
          (gnus-kill-buffer buf)))
       (setq gnus-current-select-method gnus-select-method)
       (pop-to-buffer gnus-group-buffer)
-      ;; Clear the current group name.
       (if (not quit-config)
          (progn
            (goto-char group-point)
            (gnus-configure-windows 'group 'force))
        (gnus-handle-ephemeral-exit quit-config))
+      ;; Clear the current group name.
       (unless quit-config
        (setq gnus-newsgroup-name nil)))))
 
@@ -5129,6 +5153,10 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
              (gnus-y-or-n-p "Discard changes to this group and exit? "))
       (gnus-async-halt-prefetch)
       (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
+      (when (gnus-buffer-live-p gnus-article-buffer)
+       (save-excursion
+         (set-buffer gnus-article-buffer)
+         (mapcar 'mm-destroy-part gnus-article-mime-handles)))
       ;; If we have several article buffers, we kill them at exit.
       (unless gnus-single-article-buffer
        (gnus-kill-buffer gnus-article-buffer)
@@ -6140,7 +6168,7 @@ If ALL, mark even excluded ticked and dormants as read."
 (defsubst gnus-cut-thread (thread)
   "Go forwards in the thread until we find an article that we want to display."
   (when (or (eq gnus-fetch-old-headers 'some)
-           (eq gnus-fetch-old-headers 'invisible)          
+           (eq gnus-fetch-old-headers 'invisible)
            (eq gnus-build-sparse-threads 'some)
            (eq gnus-build-sparse-threads 'more))
     ;; Deal with old-fetched headers and sparse threads.
@@ -6596,7 +6624,7 @@ Optional argument BACKWARD means do search for backward.
        (gnus-use-trees nil)            ;Inhibit updating tree buffer.
        (sum (current-buffer))
        (found nil)
-       point)
+       point gnus-display-mime-function)
     (gnus-save-hidden-threads
       (gnus-summary-select-article)
       (set-buffer gnus-article-buffer)
@@ -6742,14 +6770,14 @@ to save in."
              (set-buffer buffer)
              (gnus-article-delete-invisible-text)
              (let ((ps-left-header
-                    (list 
+                    (list
                      (concat "("
                              (mail-header-subject gnus-current-headers) ")")
                      (concat "("
                              (mail-header-from gnus-current-headers) ")")))
-                   (ps-right-header 
-                    (list 
-                     "/pagenumberstring load" 
+                   (ps-right-header
+                    (list
+                     "/pagenumberstring load"
                      (concat "("
                              (mail-header-date gnus-current-headers) ")"))))
                (gnus-run-hooks 'gnus-ps-print-hook)
@@ -6769,8 +6797,9 @@ article massaging functions being run."
     (let ((gnus-have-all-headers t)
          gnus-article-display-hook
          gnus-article-prepare-hook
+         gnus-article-decode-hook
+         gnus-display-mime-function
          gnus-break-pages
-         gnus-show-mime
          gnus-visual)
       (gnus-summary-select-article nil 'force)))
   (gnus-summary-goto-subject gnus-current-article)
@@ -6821,15 +6850,6 @@ If ARG is a negative number, hide the unwanted header lines."
   (interactive)
   (gnus-article-show-all-headers))
 
-(defun gnus-summary-toggle-mime (&optional arg)
-  "Toggle MIME processing.
-If ARG is a positive number, turn MIME processing on."
-  (interactive "P")
-  (setq gnus-show-mime
-       (if (null arg) (not gnus-show-mime)
-         (> (prefix-numeric-value arg) 0)))
-  (gnus-summary-select-article t 'force))
-
 (defun gnus-summary-caesar-message (&optional arg)
   "Caesar rotate the current article by 13.
 The numerical prefix specifies how many places to rotate each letter
@@ -6941,7 +6961,7 @@ and `request-accept' functions."
           (set-buffer copy-buf)
           (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
             (gnus-request-accept-article
-             to-newsgroup select-method (not articles)))))
+             to-newsgroup select-method (not articles) t))))
        ;; Crosspost the article.
        ((eq action 'crosspost)
         (let ((xref (message-tokenize-header
@@ -7055,7 +7075,7 @@ and `request-accept' functions."
 
        ;;;!!!Why is this necessary?
        (set-buffer gnus-summary-buffer)
-       
+
        (gnus-summary-goto-subject article)
        (when (eq action 'move)
          (gnus-summary-mark-article article gnus-canceled-mark))))
@@ -7149,7 +7169,6 @@ latter case, they will be copied into the relevant groups."
        (error "Can't read %s" file))
     (save-excursion
       (set-buffer (gnus-get-buffer-create " *import file*"))
-      (buffer-disable-undo (current-buffer))
       (erase-buffer)
       (insert-file-contents file)
       (goto-char (point-min))
@@ -7159,10 +7178,7 @@ latter case, they will be copied into the relevant groups."
              lines (count-lines (point-min) (point-max)))
        (insert "From: " (read-string "From: ") "\n"
                "Subject: " (read-string "Subject: ") "\n"
-               "Date: " (timezone-make-date-arpa-standard
-                         (current-time-string (nth 5 atts))
-                         (current-time-zone now)
-                         (current-time-zone now))
+               "Date: " (message-make-date (nth 5 atts))
                "\n"
                "Message-ID: " (message-make-message-id) "\n"
                "Lines: " (int-to-string lines) "\n"
@@ -7318,7 +7334,8 @@ groups."
       (if (and (not read-only)
               (not (gnus-request-replace-article
                     (cdr gnus-article-current) (car gnus-article-current)
-                    (current-buffer))))
+                    (current-buffer)
+                    (not gnus-article-decoded-p))))
          (error "Couldn't replace article")
        ;; Update the summary buffer.
        (if (and references
@@ -7519,7 +7536,7 @@ the actual number of articles marked is returned."
   "Mark ARTICLE replied and update the summary line."
   (push article gnus-newsgroup-replied)
   (let ((buffer-read-only nil))
-    (when (gnus-summary-goto-subject article)
+    (when (gnus-summary-goto-subject article nil t)
       (gnus-summary-update-secondary-mark article))))
 
 (defun gnus-summary-set-bookmark (article)
@@ -7644,6 +7661,8 @@ returned."
                   (= mark gnus-read-mark) (= mark gnus-souped-mark)
                   (= mark gnus-duplicate-mark)))
       (setq mark gnus-expirable-mark)
+      ;; Let the backend know about the mark change.
+      (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
       (push article gnus-newsgroup-expirable))
     ;; Set the mark in the buffer.
     (gnus-summary-update-mark mark 'unread)
@@ -7653,6 +7672,8 @@ returned."
   "Mark the current article quickly as unread with MARK."
   (let* ((article (gnus-summary-article-number))
         (old-mark (gnus-summary-article-mark article)))
+    ;; Allow the backend to change the mark.
+    (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
     (if (eq mark old-mark)
        t
       (if (<= article 0)
@@ -7708,6 +7729,8 @@ marked."
   (let* ((mark (or mark gnus-del-mark))
         (article (or article (gnus-summary-article-number)))
         (old-mark (gnus-summary-article-mark article)))
+    ;; Allow the backend to change the mark.
+    (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
     (if (eq mark old-mark)
        t
       (unless article
@@ -8663,7 +8686,7 @@ save those articles instead."
                                (lambda (f)
                                  (if (equal f " ")
                                      f
-                                   (gnus-quote-arg-for-sh-or-csh f)))
+                                   (mm-quote-arg f)))
                                files " ")))))
          (setq ps (cdr ps)))))
     (if (and gnus-view-pseudos (not not-view))