* gnus-agent.el (gnus-agent-regenerate-group): New function.
[gnus] / lisp / gnus-art.el
index a2f5bbf..705f4c0 100644 (file)
     "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
     "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
     "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
-    "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:"
+    "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face"
     "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
     "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
     "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
@@ -228,23 +228,18 @@ regexp.  If it matches, the text in question is not a signature."
 (defcustom gnus-article-x-face-command
   (if (featurep 'xemacs)
       (if (or (gnus-image-type-available-p 'xface)
-             (gnus-image-type-available-p 'xpm))
-         'gnus-xmas-article-display-xface
+             (gnus-image-type-available-p 'pbm))
+         'gnus-display-x-face-in-from
        "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
-    (if (gnus-image-type-available-p 'xbm)
-       'gnus-article-display-xface
-      (if gnus-article-compface-xbm
-         "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
-       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
-display -")))
+    (if (gnus-image-type-available-p 'pbm)
+       'gnus-display-x-face-in-from
+      "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
+display -"))
   "*String or function to be executed to display an X-Face header.
 If it is a string, the command will be executed in a sub-shell
 asynchronously.         The compressed face will be piped to this command."
   :type `(choice string
-                (function-item
-                 ,(if (featurep 'xemacs)
-                      'gnus-xmas-article-display-xface
-                    'gnus-article-display-xface))
+                (function-item gnus-display-x-face-in-from)
                 function)
   :version "21.1"
   :group 'gnus-article-washing)
@@ -701,12 +696,13 @@ To see e.g. security buttons you could set this to
   :group 'gnus-article-mime
   :type '(repeat regexp))
 
-(defcustom gnus-body-boundary-delimiter "-"
+(defcustom gnus-body-boundary-delimiter "_"
   "String used to delimit header and body.
 This variable is used by `gnus-article-treat-body-boundary' which can
-be controled by `gnus-treat-body-boundary'."
+be controlled by `gnus-treat-body-boundary'."
   :group 'gnus-article-various
-  :type 'string)
+  :type '(choice (item :tag "None" :value nil)
+                string))
 
 (defcustom gnus-article-mime-part-function nil
   "Function called with a MIME handle as the argument.
@@ -1206,6 +1202,7 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-date-original gnus-article-date-original)
     (gnus-treat-date-user-defined gnus-article-date-user)
     (gnus-treat-date-iso8601 gnus-article-date-iso8601)
+    (gnus-treat-display-xface gnus-article-display-x-face)
     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
     (gnus-treat-hide-signature gnus-article-hide-signature)
@@ -1235,7 +1232,6 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-display-smileys gnus-treat-smiley)
     (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
     (gnus-treat-emphasize gnus-article-emphasize)
-    (gnus-treat-display-xface gnus-article-display-x-face)
     (gnus-treat-body-boundary gnus-article-treat-body-boundary)
     (gnus-treat-play-sounds gnus-earcon-display)))
 
@@ -1672,7 +1668,7 @@ unfolded."
 
 (defun gnus-treat-smiley ()
   "Display textual emoticons (\"smileys\") as small graphical icons."
-  (interactive "P")
+  (interactive)
   (gnus-with-article-buffer
     (if (memq 'smiley gnus-article-wash-types)
        (gnus-delete-images 'smiley)
@@ -1699,7 +1695,7 @@ unfolded."
     (while (gnus-article-goto-header "newsgroups\\|followup-to")
       (save-restriction
        (mail-header-narrow-to-field)
-       (while (search-forward "," nil t)
+       (while (re-search-forward ", *" nil t)
          (replace-match ", " t t))
        (mail-header-fold-field)
        (goto-char (point-max))))))
@@ -1707,17 +1703,18 @@ unfolded."
 (defun gnus-article-treat-body-boundary ()
   "Place a boundary line at the end of the headers."
   (interactive)
-  (gnus-with-article-headers
-    (goto-char (point-max))
-    (let ((start (point)))
-      (insert "X-Boundary: ")
-      (gnus-add-text-properties start (point) '(invisible t intangible t))
-      (insert (let (str)
-               (while (and gnus-body-boundary-delimiter
-                           (>= (1- (window-width)) (length str)))
-                 (setq str (concat str gnus-body-boundary-delimiter)))
-               (substring str 0 (1- (window-width))))
-             "\n"))))
+  (when (and gnus-body-boundary-delimiter 
+            (> (length gnus-body-boundary-delimiter) 0))
+    (gnus-with-article-headers
+      (goto-char (point-max))
+      (let ((start (point)))
+       (insert "X-Boundary: ")
+       (gnus-add-text-properties start (point) '(invisible t intangible t))
+       (insert (let (str)
+                 (while (>= (1- (window-width)) (length str))
+                   (setq str (concat str gnus-body-boundary-delimiter)))
+                 (substring str 0 (1- (window-width))))
+               "\n")))))
 
 (defun article-fill-long-lines ()
   "Fill lines that are wider than the window width."
@@ -1780,52 +1777,74 @@ unfolded."
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."
   (interactive (list 'force))
-  (gnus-with-article-headers
-    ;; Delete the old process, if any.
-    (when (process-status "article-x-face")
-      (delete-process "article-x-face"))
-    (if (memq 'xface gnus-article-wash-types)
-       ;; We have already displayed X-Faces, so we remove them
-       ;; instead.
-       (gnus-delete-images 'xface)
-      ;; Display X-Faces.
-      (let (x-faces from face)
-       (save-excursion
-         (set-buffer gnus-original-article-buffer)
-         (save-restriction
-           (mail-narrow-to-head)
-           (while (gnus-article-goto-header "x-face")
-             (push (mail-header-field-value) x-faces))
-           (setq from (message-fetch-field "from"))))
-       ;; Sending multiple EOFs to xv doesn't work, so we only do a
-       ;; single external face.
-       (when (stringp gnus-article-x-face-command)
-         (setq x-faces (list (car x-faces))))
-       (while (and (setq face (pop x-faces))
-                   gnus-article-x-face-command
-                   (or force
-                       ;; Check whether this face is censored.
-                       (not gnus-article-x-face-too-ugly)
-                       (and gnus-article-x-face-too-ugly from
-                            (not (string-match gnus-article-x-face-too-ugly
-                                               from)))))
-         ;; We display the face.
-         (if (symbolp gnus-article-x-face-command)
-             ;; The command is a lisp function, so we call it.
-             (if (gnus-functionp gnus-article-x-face-command)
-                 (funcall gnus-article-x-face-command face)
-               (error "%s is not a function" gnus-article-x-face-command))
-           ;; The command is a string, so we interpret the command
-           ;; as a, well, command, and fork it off.
-           (let ((process-connection-type nil))
-             (process-kill-without-query
-              (start-process
-               "article-x-face" nil shell-file-name shell-command-switch
-               gnus-article-x-face-command))
-             (with-temp-buffer
-               (insert face)
-               (process-send-region "article-x-face" (point-min) (point-max)))
-             (process-send-eof "article-x-face"))))))))
+  (let ((wash-face-p buffer-read-only))        ;; When type `W f'
+    (gnus-with-article-headers
+      ;; Delete the old process, if any.
+      (when (process-status "article-x-face")
+       (delete-process "article-x-face"))
+      (if (memq 'xface gnus-article-wash-types)
+         ;; We have already displayed X-Faces, so we remove them
+         ;; instead.
+         (gnus-delete-images 'xface)
+       ;; Display X-Faces.
+       (let (x-faces from face grey)
+         (save-excursion
+           (when (and wash-face-p
+                      (progn
+                        (goto-char (point-min))
+                        (not (re-search-forward 
+                              "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t)))
+                      (gnus-buffer-live-p gnus-original-article-buffer))
+             ;; If type `W f', use gnus-original-article-buffer,
+             ;; otherwise use the current buffer because displaying
+             ;; RFC822 parts calls this function too.
+             (set-buffer gnus-original-article-buffer))
+           (save-restriction
+             (mail-narrow-to-head)
+             (while (gnus-article-goto-header "x-face\\(-[0-9]+\\)?")
+               (when (match-beginning 2)
+                 (setq grey t))
+               (push (mail-header-field-value) x-faces))
+             (setq from (message-fetch-field "from"))))
+         (if grey
+             (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces))
+                   image)
+               (when xpm
+                 (setq image (gnus-create-image xpm 'xpm t))
+                 (gnus-article-goto-header "from")
+                 (gnus-add-wash-type 'xface)
+                 (gnus-add-image 'xface image)
+                 (gnus-put-image image)))
+           ;; Sending multiple EOFs to xv doesn't work, so we only do a
+           ;; single external face.
+           (when (stringp gnus-article-x-face-command)
+             (setq x-faces (list (car x-faces))))
+           (while (and (setq face (pop x-faces))
+                       gnus-article-x-face-command
+                       (or force
+                           ;; Check whether this face is censored.
+                           (not gnus-article-x-face-too-ugly)
+                           (and gnus-article-x-face-too-ugly from
+                                (not (string-match gnus-article-x-face-too-ugly
+                                                   from)))))
+             ;; We display the face.
+             (if (symbolp gnus-article-x-face-command)
+                 ;; The command is a lisp function, so we call it.
+                 (if (gnus-functionp gnus-article-x-face-command)
+                     (funcall gnus-article-x-face-command face)
+                   (error "%s is not a function" gnus-article-x-face-command))
+               ;; The command is a string, so we interpret the command
+               ;; as a, well, command, and fork it off.
+               (let ((process-connection-type nil))
+                 (process-kill-without-query
+                  (start-process
+                   "article-x-face" nil shell-file-name shell-command-switch
+                   gnus-article-x-face-command))
+                 (with-temp-buffer
+                   (insert face)
+                   (process-send-region "article-x-face"
+                                        (point-min) (point-max)))
+                 (process-send-eof "article-x-face"))))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -3154,6 +3173,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
   ">" end-of-buffer
   "\C-c\C-i" gnus-info-find-node
   "\C-c\C-b" gnus-bug
+  "R" gnus-article-reply-with-original
+  "F" gnus-article-followup-with-original
   "\C-hk" gnus-article-describe-key
   "\C-hc" gnus-article-describe-key-briefly
 
@@ -3438,14 +3459,19 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 ;;;
 
 (defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
-  "The following specs can be used:
+  "Format of the MIME buttons.
+
+Valid specifiers include:
 %t  The MIME type
 %T  MIME type, along with additional info
 %n  The `name' parameter
 %d  The description, if any
 %l  The length of the encoded part
 %p  The part identifier number
-%e  Dots if the part isn't displayed")
+%e  Dots if the part isn't displayed
+
+General format specifiers can also be used.  See
+(gnus)Formatting Variables.")
 
 (defvar gnus-mime-button-line-format-alist
   '((?t gnus-tmp-type ?s)
@@ -3956,14 +3982,11 @@ If no internal viewer is available, use an external viewer."
     (setq b (point))
     (gnus-eval-format
      gnus-mime-button-line-format gnus-mime-button-line-format-alist
-     `(keymap ,gnus-mime-button-map
-             ,@(if (>= (string-to-number emacs-version) 21)
-                   nil
-                 (list 'local-map gnus-mime-button-map))
-             gnus-callback gnus-mm-display-part
-             gnus-part ,gnus-tmp-id
-             article-type annotation
-             gnus-data ,handle))
+     `(,@(gnus-local-map-property gnus-mime-button-map)
+        gnus-callback gnus-mm-display-part
+        gnus-part ,gnus-tmp-id
+        article-type annotation
+        gnus-data ,handle))
     (setq e (point))
     (widget-convert-button
      'link b e
@@ -4216,12 +4239,9 @@ If no internal viewer is available, use an external viewer."
                       ',gnus-article-mime-handle-alist))
               (gnus-mime-display-alternative
                ',ihandles ',not-pref ',begend ,id))
-            ,@(if (>= (string-to-number emacs-version) 21)
-                  nil ;; XEmacs doesn't care
-                (list 'local-map gnus-mime-button-map))
+            ,@(gnus-local-map-property gnus-mime-button-map)
             ,gnus-mouse-face-prop ,gnus-article-mouse-face
             face ,gnus-article-button-face
-            keymap ,gnus-mime-button-map
             gnus-part ,id
             gnus-data ,handle))
          (widget-convert-button 'link from (point)
@@ -4243,12 +4263,9 @@ If no internal viewer is available, use an external viewer."
                         ',gnus-article-mime-handle-alist))
                 (gnus-mime-display-alternative
                  ',ihandles ',handle ',begend ,id))
-              ,@(if (>= (string-to-number emacs-version) 21)
-                    nil ;; XEmacs doesn't care
-                  (list 'local-map gnus-mime-button-map))
+              ,@(gnus-local-map-property gnus-mime-button-map)
               ,gnus-mouse-face-prop ,gnus-article-mouse-face
               face ,gnus-article-button-face
-              keymap ,gnus-mime-button-map
               gnus-part ,id
               gnus-data ,handle))
            (widget-convert-button 'link from (point)
@@ -4540,7 +4557,7 @@ Argument LINES specifies lines to be scrolled down."
   (interactive "P")
   (gnus-article-check-buffer)
   (let ((nosaves
-        '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
+        '("q" "Q"  "c" "r" "\C-c\C-f" "m"  "a" "f"
           "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
           "=" "^" "\M-^" "|"))
        (nosave-but-article
@@ -4654,6 +4671,36 @@ Argument LINES specifies lines to be scrolled down."
        (describe-key-briefly key insert))
     (describe-key-briefly key insert)))
 
+(defun gnus-article-reply-with-original (&optional wide)
+  "Start composing a reply mail to the current message.
+The text in the region will be yanked.  If the region isn't active,
+the entire article will be yanked."
+  (interactive "P")
+  (let ((article (cdr gnus-article-current)))
+    (if (not mark-active)
+       (gnus-summary-reply (list (list article)) wide)
+      ;; Deactivate active regions.
+      (when (and (boundp 'transient-mark-mode)
+                transient-mark-mode)
+       (setq mark-active nil))
+      (gnus-summary-reply
+       (list (list article (buffer-substring (point) (mark)))) wide))))
+
+(defun gnus-article-followup-with-original ()
+  "Compose a followup to the current article.
+The text in the region will be yanked.  If the region isn't active,
+the entire article will be yanked."
+  (interactive)
+  (let ((article (cdr gnus-article-current)))
+    (if (not mark-active)
+       (gnus-summary-followup (list (list article)))
+      ;; Deactivate active regions.
+      (when (and (boundp 'transient-mark-mode)
+                transient-mark-mode)
+       (setq mark-active nil))
+      (gnus-summary-followup
+       (list (list article (buffer-substring (point) (mark))))))))
+
 (defun gnus-article-hide (&optional arg force)
   "Hide all the gruft in the current article.
 This means that PGP stuff, signatures, cited text and (some)
@@ -4771,6 +4818,11 @@ If given a prefix, show the hidden text instead."
                 (numberp article)
                 (gnus-cache-request-article article group))
            'article)
+          ;; Check the agent cache.
+          ((and gnus-agent gnus-agent-cache gnus-plugged 
+                (numberp article)
+                (gnus-agent-request-article article group))
+           'article)
           ;; Get the article and put into the article buffer.
           ((or (stringp article)
                (numberp article))
@@ -5050,6 +5102,7 @@ variable it the real callback function."
     ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0)
     ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0)
     ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0)
+    ("^[^:]+:" "\\bmailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
      gnus-button-message-id 3))
   "*Alist of headers and regexps to match buttons in article heads.
@@ -5480,28 +5533,48 @@ specified by `gnus-button-alist'."
 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
 
-(defvar gnus-prev-page-map nil)
-(unless gnus-prev-page-map
-  (setq gnus-prev-page-map (make-sparse-keymap))
-  (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
-  (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
+(defvar gnus-prev-page-map
+  (let ((map (make-sparse-keymap)))
+    (unless (>= emacs-major-version 21)
+      ;; XEmacs doesn't care.
+      (set-keymap-parent map gnus-article-mode-map))
+    (define-key map gnus-mouse-2 'gnus-button-prev-page)
+    (define-key map "\r" 'gnus-button-prev-page)
+    map))
 
 (defun gnus-insert-prev-page-button ()
-  (let ((buffer-read-only nil))
+  (let ((b (point))
+       (buffer-read-only nil))
     (gnus-eval-format
      gnus-prev-page-line-format nil
-     `(gnus-prev t local-map ,gnus-prev-page-map
-                gnus-callback gnus-article-button-prev-page
-                article-type annotation))))
-
-(defvar gnus-next-page-map nil)
-(unless gnus-next-page-map
-  (setq gnus-next-page-map (make-keymap))
-  (suppress-keymap gnus-prev-page-map)
-  (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
-  (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
-
-(defun gnus-button-next-page ()
+     `(,@(gnus-local-map-property gnus-prev-page-map)
+        gnus-prev t 
+        gnus-callback gnus-article-button-prev-page
+        article-type annotation))
+    (widget-convert-button
+     'link b (point)
+     :action 'gnus-button-prev-page
+     :button-keymap gnus-prev-page-map)))
+
+(defvar gnus-prev-page-map
+  (let ((map (make-sparse-keymap)))
+    (unless (>= emacs-major-version 21)
+      ;; XEmacs doesn't care.
+      (set-keymap-parent map gnus-article-mode-map))
+    (define-key map gnus-mouse-2 'gnus-button-prev-page)
+    (define-key map "\r" 'gnus-button-prev-page)
+    map))
+
+(defvar gnus-next-page-map
+  (let ((map (make-sparse-keymap)))
+    (unless (>= emacs-major-version 21)
+      ;; XEmacs doesn't care.
+      (set-keymap-parent map gnus-article-mode-map))
+    (define-key map gnus-mouse-2 'gnus-button-next-page)
+    (define-key map "\r" 'gnus-button-next-page)
+    map))
+
+(defun gnus-button-next-page (&optional args more-args)
   "Go to the next page."
   (interactive)
   (let ((win (selected-window)))
@@ -5509,7 +5582,7 @@ specified by `gnus-button-alist'."
     (gnus-article-next-page)
     (select-window win)))
 
-(defun gnus-button-prev-page ()
+(defun gnus-button-prev-page (&optional args more-args)
   "Go to the prev page."
   (interactive)
   (let ((win (selected-window)))
@@ -5518,12 +5591,17 @@ specified by `gnus-button-alist'."
     (select-window win)))
 
 (defun gnus-insert-next-page-button ()
-  (let ((buffer-read-only nil))
+  (let ((b (point))
+       (buffer-read-only nil))
     (gnus-eval-format gnus-next-page-line-format nil
-                     `(gnus-next
-                       t local-map ,gnus-next-page-map
-                       gnus-callback gnus-article-button-next-page
-                       article-type annotation))))
+                     `(,@(gnus-local-map-property gnus-next-page-map)
+                         gnus-next t 
+                         gnus-callback gnus-article-button-next-page
+                         article-type annotation))
+    (widget-convert-button
+     'link b (point)
+     :action 'gnus-button-next-page
+     :button-keymap gnus-next-page-map)))
 
 (defun gnus-article-button-next-page (arg)
   "Go to the next page."
@@ -5852,14 +5930,11 @@ For example:
     (gnus-eval-format
      gnus-mime-security-button-line-format
      gnus-mime-security-button-line-format-alist
-     `(keymap ,gnus-mime-security-button-map
-             ,@(if (>= (string-to-number emacs-version) 21)
-                   nil ;; XEmacs doesn't care
-                 (list 'local-map gnus-mime-security-button-map))
-             gnus-callback gnus-mime-security-press-button
-             gnus-line-format ,gnus-mime-security-button-line-format
-             article-type annotation
-             gnus-data ,handle))
+     `(,@(gnus-local-map-property gnus-mime-security-button-map)
+        gnus-callback gnus-mime-security-press-button
+        gnus-line-format ,gnus-mime-security-button-line-format
+        article-type annotation
+        gnus-data ,handle))
     (setq e (point))
     (widget-convert-button
      'link b e