update.
[elisp/gnus.git-] / lisp / gnus-sum.el
index e4ad698..0a20c92 100644 (file)
@@ -1,8 +1,9 @@
-;;; gnus-sum.el --- summary mode commands for Gnus
+;;; gnus-sum.el --- summary mode commands for Semi-gnus
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
 (require 'gnus-range)
 (require 'gnus-int)
 (require 'gnus-undo)
+(require 'mime-view)
+
 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t)
 
 (defcustom gnus-kill-summary-on-exit t
   "*If non-nil, kill the summary buffer when you exit from it.
@@ -325,7 +329,7 @@ variable."
   :group 'gnus-article-various
   :type 'boolean)
 
-(defcustom gnus-show-mime nil
+(defcustom gnus-show-mime t
   "*If non-nil, do mime processing of articles.
 The articles will simply be fed to the function given by
 `gnus-show-mime-method'."
@@ -509,6 +513,7 @@ with some simple extensions:
 %G  Group name
 %p  Unprefixed group name
 %A  Current article number
+%z  Current article score
 %V  Gnus version
 %U  Number of unread articles in the group
 %e  Number of unselected articles in the group
@@ -659,18 +664,24 @@ is not run if `gnus-visual' is nil."
   :group 'gnus-summary-visual
   :type 'hook)
 
-(defcustom gnus-structured-field-decoder 'identity
+(defcustom gnus-structured-field-decoder
+  #'eword-decode-and-unfold-structured-field
   "Function to decode non-ASCII characters in structured field for summary."
   :group 'gnus-various
   :type 'function)
 
-(defcustom gnus-unstructured-field-decoder 'identity
+(defcustom gnus-unstructured-field-decoder
+  (function
+   (lambda (string)
+     (eword-decode-unstructured-field-body
+      (std11-unfold-string string) 'must-unfold)
+     ))
   "Function to decode non-ASCII characters in unstructured field for summary."
   :group 'gnus-various
   :type 'function)
 
 (defcustom gnus-parse-headers-hook
-  (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
+  '(gnus-set-summary-default-charset)
   "*A hook called before parsing the headers."
   :group 'gnus-various
   :type 'hook)
@@ -864,6 +875,7 @@ variable (string, integer, character, etc).")
     (?d (length gnus-newsgroup-dormant) ?d)
     (?t (length gnus-newsgroup-marked) ?d)
     (?r (length gnus-newsgroup-reads) ?d)
+    (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
     (?E gnus-newsgroup-expunged-tally ?d)
     (?s (gnus-current-score-file-nondirectory) ?s)))
 
@@ -1137,6 +1149,7 @@ increase the score of each group you read."
     [delete] gnus-summary-prev-page
     [backspace] gnus-summary-prev-page
     "\r" gnus-summary-scroll-up
+    "\e\r" gnus-summary-scroll-down
     "n" gnus-summary-next-unread-article
     "p" gnus-summary-prev-unread-article
     "N" gnus-summary-next-article
@@ -1218,6 +1231,7 @@ increase the score of each group you read."
     "t" gnus-article-hide-headers
     "g" gnus-summary-show-article
     "l" gnus-summary-goto-last-article
+    "v" gnus-summary-preview-mime-message
     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
     "\C-d" gnus-summary-enter-digest-group
     "\M-\C-d" gnus-summary-read-document
@@ -1361,7 +1375,6 @@ increase the score of each group you read."
     "e" gnus-article-emphasize
     "w" gnus-article-fill-cited-article
     "c" gnus-article-remove-cr
-    "q" gnus-article-de-quoted-unreadable
     "f" gnus-article-display-x-face
     "l" gnus-summary-stop-page-breaking
     "r" gnus-summary-caesar-message
@@ -1506,7 +1519,6 @@ increase the score of each group you read."
               ["Word wrap" gnus-article-fill-cited-article t]
               ["CR" gnus-article-remove-cr t]
               ["Show X-Face" gnus-article-display-x-face t]
-              ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
               ["UnHTMLize" gnus-article-treat-html t]
               ["Rot 13" gnus-summary-caesar-message t]
               ["Unix pipe" gnus-summary-pipe-message t]
@@ -2413,7 +2425,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
+    (gnus-put-text-property-excluding-characters-with-faces
      (point)
      (progn (eval gnus-summary-line-format-spec) (point))
      'gnus-number gnus-tmp-number)
@@ -2922,7 +2934,6 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
            ;; Yuk!  This is a reference loop.  Make the article be a
            ;; root article.
            (progn
-             (debug)
              (mail-header-set-references (car (symbol-value id-dep)) "none")
              (setq ref nil))
          (setq ref (gnus-parent-id (mail-header-references ref-header)))))
@@ -3256,13 +3267,13 @@ If LINE, insert the rebuilt thread starting on line LINE."
        (headers in-headers)
        references)
     (while (and parent
-               headers
                (not (zerop generation))
                (setq references (mail-header-references headers)))
-      (when (and references
-                (setq parent (gnus-parent-id references))
-                (setq headers (car (gnus-id-to-thread parent))))
-       (decf generation)))
+      (setq headers (if (and references
+                            (setq parent (gnus-parent-id references)))
+                       (car (gnus-id-to-thread parent))
+                     nil))
+      (decf generation))
     (and (not (eq headers in-headers))
         headers)))
 
@@ -3750,7 +3761,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
+           (gnus-put-text-property-excluding-characters-with-faces
             (point)
             (progn (eval gnus-summary-line-format-spec) (point))
             'gnus-number number)
@@ -4349,7 +4360,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
       (subst-char-in-region (point-min) (point-max) ?\t ?  t)
       (gnus-run-hooks 'gnus-parse-headers-hook)
       (let ((case-fold-search t)
-           in-reply-to header p lines)
+           in-reply-to header p lines chars)
        (goto-char (point-min))
        ;; Search to the beginning of the next header.  Error messages
        ;; do not begin with 2 or 3.
@@ -4438,7 +4449,12 @@ The resulting hash table is returned, or nil if no Xrefs were found."
                          (setq ref ref2))))
                  (setq ref nil))))
            ;; Chars.
-           0
+           (progn
+             (goto-char p)
+             (if (search-forward "\nchars: " nil t)
+                 (if (numberp (setq chars (ignore-errors (read cur))))
+                     chars 0)
+               0))
            ;; Lines.
            (progn
              (goto-char p)
@@ -4626,7 +4642,7 @@ current article will be taken into consideration."
       (let ((max (max (point) (mark)))
            articles article)
        (save-excursion
-         (goto-char (min (min (point) (mark))))
+         (goto-char (min (point) (mark)))
          (while
              (and
               (push (setq article (gnus-summary-article-number)) articles)
@@ -5147,6 +5163,23 @@ The state which existed when entering the ephemeral is reset."
       (gnus-summary-recenter)
       (gnus-summary-position-point))))
 
+(defun gnus-summary-preview-mime-message (arg)
+  "MIME decode and play this message."
+  (interactive "P")
+  (or gnus-show-mime
+      (let ((gnus-break-pages nil)
+           (gnus-show-mime t))
+       (gnus-summary-select-article t t)
+       ))
+  (select-window (get-buffer-window gnus-article-buffer))
+  )
+
+(defun gnus-summary-scroll-down ()
+  "Scroll down one line current article."
+  (interactive)
+  (gnus-summary-scroll-up -1)
+  )
+
 ;;; Dead summaries.
 
 (defvar gnus-dead-summary-mode-map nil)
@@ -5408,6 +5441,7 @@ If FORCE, also allow jumping to articles not currently shown."
            (gnus-message 3 "Can't find article %d" article))
          nil)
       (goto-char (gnus-data-pos data))
+      (gnus-summary-position-point)
       article)))
 
 ;; Walking around summary lines with displaying articles.
@@ -7106,7 +7140,7 @@ latter case, they will be copied into the relevant groups."
       (set-buffer (get-buffer-create " *import file*"))
       (buffer-disable-undo (current-buffer))
       (erase-buffer)
-      (insert-file-contents file)
+      (nnheader-insert-file-contents file)
       (goto-char (point-min))
       (unless (nnheader-article-p)
        ;; This doesn't look like an article, so we fudge some headers.
@@ -7267,55 +7301,58 @@ groups."
   "Make edits to the current article permanent."
   (interactive)
   ;; Replace the article.
-  (if (and (not read-only)
-          (not (gnus-request-replace-article
-                (cdr gnus-article-current) (car gnus-article-current)
-                (current-buffer))))
-      (error "Couldn't replace article")
-    ;; Update the summary buffer.
-    (if (and references
-            (equal (message-tokenize-header references " ")
-                   (message-tokenize-header
-                    (or (message-fetch-field "references") "") " ")))
-       ;; We only have to update this line.
-       (save-excursion
-         (save-restriction
-           (message-narrow-to-head)
-           (let ((head (buffer-string))
-                 header)
-             (nnheader-temp-write nil
-               (insert (format "211 %d Article retrieved.\n"
-                               (cdr gnus-article-current)))
-               (insert head)
-               (insert ".\n")
-               (let ((nntp-server-buffer (current-buffer)))
-                 (setq header (car (gnus-get-newsgroup-headers
-                                    (save-excursion
-                                      (set-buffer gnus-summary-buffer)
-                                      gnus-newsgroup-dependencies)
-                                    t))))
-               (save-excursion
-                 (set-buffer gnus-summary-buffer)
-                 (gnus-data-set-header
-                  (gnus-data-find (cdr gnus-article-current))
-                  header)
-                 (gnus-summary-update-article-line
-                  (cdr gnus-article-current) header))))))
-      ;; Update threads.
-      (set-buffer (or buffer gnus-summary-buffer))
-      (gnus-summary-update-article (cdr gnus-article-current)))
-    ;; Prettify the article buffer again.
-    (unless no-highlight
-      (save-excursion
-       (set-buffer gnus-article-buffer)
-       (gnus-run-hooks 'gnus-article-display-hook)
-       (set-buffer gnus-original-article-buffer)
-       (gnus-request-article
-        (cdr gnus-article-current)
-        (car gnus-article-current) (current-buffer))))
-    ;; Prettify the summary buffer line.
-    (when (gnus-visual-p 'summary-highlight 'highlight)
-      (gnus-run-hooks 'gnus-visual-mark-article-hook))))
+  (let ((buf (current-buffer)))
+    (nnheader-temp-write nil
+      (insert-buffer buf)
+      (if (and (not read-only)
+              (not (gnus-request-replace-article
+                    (cdr gnus-article-current) (car gnus-article-current)
+                    (current-buffer))))
+         (error "Couldn't replace article")
+       ;; Update the summary buffer.
+       (if (and references
+                (equal (message-tokenize-header references " ")
+                       (message-tokenize-header
+                        (or (message-fetch-field "references") "") " ")))
+           ;; We only have to update this line.
+           (save-excursion
+             (save-restriction
+               (message-narrow-to-head)
+               (let ((head (buffer-string))
+                     header)
+                 (nnheader-temp-write nil
+                   (insert (format "211 %d Article retrieved.\n"
+                                   (cdr gnus-article-current)))
+                   (insert head)
+                   (insert ".\n")
+                   (let ((nntp-server-buffer (current-buffer)))
+                     (setq header (car (gnus-get-newsgroup-headers
+                                        (save-excursion
+                                          (set-buffer gnus-summary-buffer)
+                                          gnus-newsgroup-dependencies)
+                                        t))))
+                   (save-excursion
+                     (set-buffer gnus-summary-buffer)
+                     (gnus-data-set-header
+                      (gnus-data-find (cdr gnus-article-current))
+                      header)
+                     (gnus-summary-update-article-line
+                      (cdr gnus-article-current) header))))))
+         ;; Update threads.
+         (set-buffer (or buffer gnus-summary-buffer))
+         (gnus-summary-update-article (cdr gnus-article-current)))
+       ;; Prettify the article buffer again.
+       (unless no-highlight
+         (save-excursion
+           (set-buffer gnus-article-buffer)
+           (gnus-run-hooks 'gnus-article-display-hook)
+           (set-buffer gnus-original-article-buffer)
+           (gnus-request-article
+            (cdr gnus-article-current)
+            (car gnus-article-current) (current-buffer))))
+       ;; Prettify the summary buffer line.
+       (when (gnus-visual-p 'summary-highlight 'highlight)
+         (gnus-run-hooks 'gnus-visual-mark-article-hook))))))
 
 (defun gnus-summary-edit-wash (key)
   "Perform editing command KEY in the article buffer."
@@ -7613,9 +7650,7 @@ returned."
               (push article gnus-newsgroup-dormant))
              (t
               (push article gnus-newsgroup-unreads)))
-       (setq gnus-newsgroup-reads
-             (delq (assq article gnus-newsgroup-reads)
-                   gnus-newsgroup-reads))
+       (gnus-pull article gnus-newsgroup-reads)
 
        ;; See whether the article is to be put in the cache.
        (and gnus-use-cache
@@ -7756,9 +7791,7 @@ marked."
             (push article gnus-newsgroup-dormant))
            (t
             (push article gnus-newsgroup-unreads)))
-      (setq gnus-newsgroup-reads
-           (delq (assq article gnus-newsgroup-reads)
-                 gnus-newsgroup-reads))
+      (gnus-pull article gnus-newsgroup-reads)
       t)))
 
 (defalias 'gnus-summary-mark-as-unread-forward
@@ -8817,7 +8850,7 @@ save those articles instead."
        (setq list (cdr list))))
     (let ((face (cdar list)))
       (unless (eq face (get-text-property beg 'face))
-       (gnus-put-text-property
+       (gnus-put-text-property-excluding-characters-with-faces
         beg end 'face
         (setq face (if (boundp face) (symbol-value face) face)))
        (when gnus-summary-highlight-line-function
@@ -8901,6 +8934,38 @@ save those articles instead."
           (gnus-summary-exit))
         buffers)))))
 
+
+;;; @ for mime-partial
+;;;
+
+(defun gnus-request-partial-message ()
+  (save-excursion
+    (let ((number (gnus-summary-article-number))
+         (group gnus-newsgroup-name)
+         (mother gnus-article-buffer))
+      (set-buffer (get-buffer-create " *Partial Article*"))
+      (erase-buffer)
+      (setq mime-preview-buffer mother)
+      (gnus-request-article-this-buffer number group)
+      (mime-parse-buffer)
+      )))
+
+(autoload 'mime-combine-message/partial-pieces-automatically
+  "mime-partial"
+  "Internal method to combine message/partial messages automatically.")
+
+(mime-add-condition
+ 'action '((type . message)(subtype . partial)
+          (major-mode . gnus-original-article-mode)
+          (method . mime-combine-message/partial-pieces-automatically)
+          (summary-buffer-exp . gnus-summary-buffer)
+          (request-partial-message-method . gnus-request-partial-message)
+          ))
+
+
+;;; @ end
+;;;
+
 (gnus-ems-redefine)
 
 (provide 'gnus-sum)