* gnus-agent.el (gnus-agent-group-pathname): Take notice of the method.
[gnus] / lisp / gnus-art.el
index 41d845d..9560886 100644 (file)
@@ -661,13 +661,12 @@ non-nil.
 
 If the match is a string, it is used as a regexp match on the
 article.  If the match is a symbol, that symbol will be funcalled
-from the buffer of the article to be saved with the newsgroup as
-the parameter.  If it is a list, it will be evaled in the same
-buffer.
+from the buffer of the article to be saved with the newsgroup as the
+parameter.  If it is a list, it will be evaled in the same buffer.
 
-If this form or function returns a string, this string will be
-used as a possible file name; and if it returns a non-nil list,
-that list will be used as possible file names."
+If this form or function returns a string, this string will be used as a
+possible file name; and if it returns a non-nil list, that list will be
+used as possible file names."
   :group 'gnus-article-saving
   :type '(repeat (choice (list :value (fun) function)
                         (cons :value ("" "") regexp (repeat string))
@@ -763,7 +762,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
 (defface gnus-header-from
   '((((class color)
       (background dark))
-     (:foreground "spring green"))
+     (:foreground "PaleGreen1"))
     (((class color)
       (background light))
      (:foreground "red3"))
@@ -778,7 +777,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
 (defface gnus-header-subject
   '((((class color)
       (background dark))
-     (:foreground "SeaGreen3"))
+     (:foreground "SeaGreen1"))
     (((class color)
       (background light))
      (:foreground "red4"))
@@ -810,7 +809,7 @@ articles."
 (defface gnus-header-name
   '((((class color)
       (background dark))
-     (:foreground "SeaGreen"))
+     (:foreground "SpringGreen2"))
     (((class color)
       (background light))
      (:foreground "maroon"))
@@ -825,7 +824,7 @@ articles."
 (defface gnus-header-content
   '((((class color)
       (background dark))
-     (:foreground "forest green" :italic t))
+     (:foreground "SpringGreen1" :italic t))
     (((class color)
       (background light))
      (:foreground "indianred4" :italic t))
@@ -1416,9 +1415,9 @@ predicate.  See Info node `(gnus)Customizing Articles'."
              (executable-find "icontopbm")))
        'head)
   "Display X-Face headers.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles' and Info
-node `(gnus)X-Face' for details."
+Valid values are nil and `head'.
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)X-Face' for details."
   :group 'gnus-article-treat
   :version "21.1"
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -2526,44 +2525,31 @@ If PROMPT (the prefix), prompt for a coding system to use."
       (goto-char (setq end start)))))
 
 (defun article-decode-group-name ()
-  "Decode group names in `Newsgroups:'."
+  "Decode group names in Newsgroups, Followup-To and Xref headers."
   (let ((inhibit-point-motion-hooks t)
        (inhibit-read-only t)
-       (method (gnus-find-method-for-group gnus-newsgroup-name)))
+       (method (gnus-find-method-for-group gnus-newsgroup-name))
+       regexp)
     (when (and (or gnus-group-name-charset-method-alist
                   gnus-group-name-charset-group-alist)
               (gnus-buffer-live-p gnus-original-article-buffer))
       (save-restriction
        (article-narrow-to-head)
-       (with-current-buffer gnus-original-article-buffer
-         (goto-char (point-min)))
-       (while (re-search-forward
-               "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
-         (replace-match (save-match-data
-                          (gnus-decode-newsgroups
-                           ;; XXX how to use data in article buffer?
-                           (with-current-buffer gnus-original-article-buffer
-                             (re-search-forward
-                              "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
-                              nil t)
-                             (match-string 1))
-                           gnus-newsgroup-name method))
-                        t t nil 1))
-       (goto-char (point-min))
-       (with-current-buffer gnus-original-article-buffer
-         (goto-char (point-min)))
-       (while (re-search-forward
-               "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
-         (replace-match (save-match-data
-                          (gnus-decode-newsgroups
-                           ;; XXX how to use data in article buffer?
-                           (with-current-buffer gnus-original-article-buffer
-                             (re-search-forward
-                              "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
-                              nil t)
-                             (match-string 1))
-                           gnus-newsgroup-name method))
-                        t t nil 1))))))
+       (dolist (header '("Newsgroups" "Followup-To" "Xref"))
+         (with-current-buffer gnus-original-article-buffer
+           (goto-char (point-min)))
+         (setq regexp (concat "^" header
+                              ":\\([^\n]*\\(?:\n[\t ]+[^\n]+\\)*\\)\n"))
+         (while (re-search-forward regexp nil t)
+           (replace-match (save-match-data
+                            (gnus-decode-newsgroups
+                             ;; XXX how to use data in article buffer?
+                             (with-current-buffer gnus-original-article-buffer
+                               (re-search-forward regexp nil t)
+                               (match-string 1))
+                             gnus-newsgroup-name method))
+                          t t nil 1))
+         (goto-char (point-min)))))))
 
 (autoload 'idna-to-unicode "idna")
 
@@ -2839,7 +2825,7 @@ Recurse into multiparts."
 Warning: Spammers use links to images in HTML articles to verify
 whether you have read the message.  As
 `gnus-article-browse-html-article' passes the unmodified HTML
-content to the browser without eliminatin these \"web bugs\" you
+content to the browser without eliminating these \"web bugs\" you
 should only use it for mails from trusted senders."
   ;; Cf. `mm-w3m-safe-url-regexp'
   (interactive)
@@ -4143,7 +4129,8 @@ commands:
   (make-local-variable 'gnus-article-image-alist)
   (make-local-variable 'gnus-article-charset)
   (make-local-variable 'gnus-article-ignored-charsets)
-  ;; Prevent recent Emacsen from displaying non-break space as "\ ".
+  ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space'
+  ;; face.
   (set (make-local-variable 'nobreak-char-display) nil)
   (setq cursor-in-non-selected-windows nil)
   (setq truncate-lines gnus-article-truncate-lines)
@@ -4221,17 +4208,19 @@ Internal variable.")
 ;; Set article window start at LINE, where LINE is the number of lines
 ;; from the head of the article.
 (defun gnus-article-set-window-start (&optional line)
-  (set-window-start
-   (gnus-get-buffer-window gnus-article-buffer t)
-   (save-excursion
-     (set-buffer gnus-article-buffer)
-     (goto-char (point-min))
-     (if (not line)
-        (point-min)
-       (gnus-message 6 "Moved to bookmark")
-       (search-forward "\n\n" nil t)
-       (forward-line line)
-       (point)))))
+  (let ((article-window (gnus-get-buffer-window gnus-article-buffer t)))
+    (when article-window
+      (set-window-start
+       article-window
+       (save-excursion
+        (set-buffer gnus-article-buffer)
+        (goto-char (point-min))
+        (if (not line)
+            (point-min)
+          (gnus-message 6 "Moved to bookmark")
+          (search-forward "\n\n" nil t)
+          (forward-line line)
+          (point)))))))
 
 (defun gnus-article-prepare (article &optional all-headers header)
   "Prepare ARTICLE in article mode buffer.
@@ -4845,6 +4834,21 @@ Compressed files like .gz and .bz2 are decompressed."
           (mm-string-to-multibyte contents)))
        (goto-char b)))))
 
+(defun gnus-mime-strip-charset-parameters (handle)
+  "Strip charset parameters from HANDLE."
+  (if (stringp (car handle))
+      (mapc #'gnus-mime-strip-charset-parameters (cdr handle))
+    (let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle)
+                                           "message/external-body")
+                                    (progn
+                                      (unless (mm-handle-cache handle)
+                                        (mm-extern-cache-contents handle))
+                                      (mm-handle-cache handle))
+                                  handle)))
+          (charset (assq 'charset (cdr type))))
+      (when charset
+       (delq charset type)))))
+
 (defun gnus-mime-view-part-as-charset (&optional handle arg)
   "Insert the MIME part under point into the current buffer using the
 specified charset."
@@ -4853,7 +4857,7 @@ specified charset."
   (let ((handle (or handle (get-text-property (point) 'gnus-data)))
        (fun (get-text-property (point) 'gnus-callback))
        (gnus-newsgroup-ignored-charsets 'gnus-all)
-       gnus-newsgroup-charset type charset)
+       gnus-newsgroup-charset form preferred parts)
     (when handle
       (if (mm-handle-undisplayer handle)
          (mm-remove-part handle))
@@ -4861,17 +4865,24 @@ specified charset."
        (setq gnus-newsgroup-charset
              (or (cdr (assq arg gnus-summary-show-article-charset-alist))
                  (mm-read-coding-system "Charset: ")))
-       ;; Strip the charset parameter from `handle'.
-       (setq type (mm-handle-type
-                   (if (equal (mm-handle-media-type handle)
-                              "message/external-body")
-                       (progn
-                         (unless (mm-handle-cache handle)
-                           (mm-extern-cache-contents handle))
-                         (mm-handle-cache handle))
-                     handle))
-             charset (assq 'charset (cdr type)))
-       (delq charset type)
+       (gnus-mime-strip-charset-parameters handle)
+       (when (and (consp (setq form (cdr-safe fun)))
+                  (setq form (ignore-errors
+                               (assq 'gnus-mime-display-alternative form)))
+                  (setq preferred (caddr form))
+                  (progn
+                    (when (eq (car preferred) 'quote)
+                      (setq preferred (cadr preferred)))
+                    (not (equal preferred
+                                (get-text-property (point) 'gnus-data))))
+                  (setq parts (get-text-property (point) 'gnus-part))
+                  (setq parts (cdr (assq parts
+                                         gnus-article-mime-handle-alist)))
+                  (equal (mm-handle-media-type parts) "multipart/alternative")
+                  (setq parts (reverse (cdr parts))))
+         (setcar (cddr form)
+                 (list 'quote (or (cadr (member preferred parts))
+                                  (car parts)))))
        (funcall fun handle)))))
 
 (defun gnus-mime-view-part-externally (&optional handle)
@@ -4890,7 +4901,7 @@ specified charset."
          (mm-enable-external t))
     (if (not (stringp method))
        (gnus-mime-view-part-as-type
-        nil (lambda (type) (stringp (mailcap-mime-info type))))
+        nil (lambda (types) (stringp (mailcap-mime-info (car types)))))
       (when handle
        (if (mm-handle-undisplayer handle)
            (mm-remove-part handle)
@@ -4911,7 +4922,7 @@ If no internal viewer is available, use an external viewer."
         (inhibit-read-only t))
     (if (not (mm-inlinable-p handle))
         (gnus-mime-view-part-as-type
-         nil (lambda (type) (mm-inlinable-p handle type)))
+         nil (lambda (types) (mm-inlinable-p handle (car types))))
       (when handle
        (if (mm-handle-undisplayer handle)
            (mm-remove-part handle)
@@ -4941,6 +4952,25 @@ If INTERACTIVE, call FUNCTION interactivly."
       (unless (with-current-buffer gnus-summary-buffer
                (eq gnus-current-article (gnus-summary-article-number)))
        (error "You should select the right article first"))
+      (if n
+         (setq n (prefix-numeric-value n))
+       (let ((pt (point)))
+         (setq n (or (get-text-property pt 'gnus-part)
+                     (and (not (bobp))
+                          (get-text-property (1- pt) 'gnus-part))
+                     (get-text-property (prog2
+                                            (forward-line 1)
+                                            (point)
+                                          (goto-char pt))
+                                        'gnus-part)
+                     (get-text-property
+                      (or (and (setq pt (previous-single-property-change
+                                         pt 'gnus-part))
+                               (1- pt))
+                          (next-single-property-change (point) 'gnus-part)
+                          (point))
+                      'gnus-part)
+                     1))))
       ;; Check whether the specified part exists.
       (when (> n (length gnus-article-mime-handle-alist))
        (error "No such part")))
@@ -4991,62 +5021,62 @@ If INTERACTIVE, call FUNCTION interactivly."
 
 (defun gnus-article-pipe-part (n)
   "Pipe MIME part N, which is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'mm-pipe-part))
 
 (defun gnus-article-save-part (n)
   "Save MIME part N, which is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'mm-save-part))
 
 (defun gnus-article-interactively-view-part (n)
   "View MIME part N interactively, which is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'mm-interactively-view-part))
 
 (defun gnus-article-copy-part (n)
   "Copy MIME part N, which is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-copy-part))
 
 (defun gnus-article-view-part-as-charset (n)
   "View MIME part N using a specified charset.
 N is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
 
 (defun gnus-article-view-part-externally (n)
   "View MIME part N externally, which is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
 
 (defun gnus-article-inline-part (n)
   "Inline MIME part N, which is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-inline-part))
 
 (defun gnus-article-save-part-and-strip (n)
   "Save MIME part N and replace it with an external body.
 N is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
 
 (defun gnus-article-replace-part (n)
   "Replace MIME part N with an external body.
 N is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-replace-part t t))
 
 (defun gnus-article-delete-part (n)
   "Delete MIME part N and add some information about the removed part.
 N is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-delete-part t))
 
 (defun gnus-article-view-part-as-type (n)
   "Choose a MIME media type, and view part N as such.
 N is the numerical prefix."
-  (interactive "p")
+  (interactive "P")
   (gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t))
 
 (defun gnus-article-mime-match-handle-first (condition)
@@ -5178,8 +5208,8 @@ N is the numerical prefix."
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e)
-                        'face gnus-article-button-face))
+      (gnus-overlay-put (gnus-make-overlay b e nil t)
+                       'face gnus-article-button-face))
     (widget-convert-button
      'link b e
      :mime-handle handle
@@ -5890,7 +5920,7 @@ not have a face in `gnus-article-boring-faces'."
   "Execute the last keystroke in the summary buffer."
   (interactive)
   (let (func)
-    (pop-to-buffer gnus-article-current-summary 'norecord)
+    (pop-to-buffer gnus-article-current-summary nil (not (featurep 'xemacs)))
     (setq func (lookup-key (current-local-map) (this-command-keys)))
     (call-interactively func)))
 
@@ -5924,64 +5954,96 @@ not have a face in `gnus-article-boring-faces'."
 
     (message "")
 
-    (if (or (member keys nosaves)
-           (member keys nosave-but-article)
-           (member keys nosave-in-article))
-       (let (func)
-         (save-window-excursion
-           (pop-to-buffer gnus-article-current-summary 'norecord)
-           ;; We disable the pick minor mode commands.
-           (let (gnus-pick-mode)
-             (setq func (lookup-key (current-local-map) keys))))
-         (if (or (not func)
-                 (numberp func))
-             (ding)
-           (unless (member keys nosave-in-article)
-             (set-buffer gnus-article-current-summary))
-           (call-interactively func)
-           (setq new-sum-point (point)))
-         (when (member keys nosave-but-article)
-           (pop-to-buffer gnus-article-buffer 'norecord)))
+    (cond
+     ((eq (aref keys (1- (length keys))) ?\C-h)
+      (with-current-buffer gnus-article-current-summary
+       (describe-bindings (substring keys 0 -1))))
+     ((or (member keys nosaves)
+         (member keys nosave-but-article)
+         (member keys nosave-in-article))
+      (let (func)
+       (save-window-excursion
+         (pop-to-buffer gnus-article-current-summary
+                        nil (not (featurep 'xemacs)))
+         ;; We disable the pick minor mode commands.
+         (let (gnus-pick-mode)
+           (setq func (lookup-key (current-local-map) keys))))
+       (if (or (not func)
+               (numberp func))
+           (ding)
+         (unless (member keys nosave-in-article)
+           (set-buffer gnus-article-current-summary))
+         (call-interactively func)
+         (setq new-sum-point (point)))
+       (when (member keys nosave-but-article)
+         (pop-to-buffer gnus-article-buffer nil (not (featurep 'xemacs))))))
+     (t
       ;; These commands should restore window configuration.
       (let ((obuf (current-buffer))
            (owin (current-window-configuration))
-           (opoint (point))
-           win func in-buffer selected new-sum-start new-sum-hscroll)
+           win func in-buffer selected new-sum-start new-sum-hscroll err)
        (cond (not-restore-window
-              (pop-to-buffer gnus-article-current-summary 'norecord))
+              (pop-to-buffer gnus-article-current-summary
+                             nil (not (featurep 'xemacs)))
+              (setq win (selected-window)))
              ((setq win (get-buffer-window gnus-article-current-summary))
               (select-window win))
              (t
-              (switch-to-buffer gnus-article-current-summary 'norecord)))
+              (let ((summary-buffer gnus-article-current-summary))
+                (gnus-configure-windows 'article)
+                (unless (setq win (get-buffer-window summary-buffer 'visible))
+                  (let ((gnus-buffer-configuration
+                         '(article ((vertical 1.0
+                                              (summary 0.25 point)
+                                              (article 1.0))))))
+                    (gnus-configure-windows 'article))
+                  (setq win (get-buffer-window summary-buffer 'visible)))
+                (gnus-select-frame-set-input-focus (window-frame win))
+                (select-window win))))
        (setq in-buffer (current-buffer))
        ;; We disable the pick minor mode commands.
        (if (and (setq func (let (gnus-pick-mode)
                              (lookup-key (current-local-map) keys)))
-                (functionp func))
+                (functionp func)
+                (condition-case code
+                    (progn
+                      (call-interactively func)
+                      t)
+                  (error
+                   (setq err code)
+                   nil)))
            (progn
-             (call-interactively func)
              (when (eq win (selected-window))
                (setq new-sum-point (point)
                      new-sum-start (window-start win)
                      new-sum-hscroll (window-hscroll win)))
-             (when (eq in-buffer (current-buffer))
+             (when (or (eq in-buffer (current-buffer))
+                       (when (eq obuf (current-buffer))
+                         (set-buffer in-buffer)
+                         t))
                (setq selected (gnus-summary-select-article))
                (set-buffer obuf)
                (unless not-restore-window
                  (set-window-configuration owin))
-               (when (eq selected 'old)
-                 (article-goto-body)
+               (when (and (eq selected 'old)
+                          new-sum-point)
                  (set-window-start (get-buffer-window (current-buffer))
                                    1)
                  (set-window-point (get-buffer-window (current-buffer))
-                                   (point)))
+                                   (if (article-goto-body)
+                                       (1- (point))
+                                     (point))))
                (when (and (not not-restore-window)
-                          new-sum-point)
+                          new-sum-point
+                          (with-current-buffer (window-buffer win)
+                            (eq major-mode 'gnus-summary-mode)))
                  (set-window-point win new-sum-point)
                  (set-window-start win new-sum-start)
                  (set-window-hscroll win new-sum-hscroll))))
          (set-window-configuration owin)
-         (ding))))))
+         (if err
+             (signal (car err) (cdr err))
+           (ding))))))))
 
 (defun gnus-article-describe-key (key)
   "Display documentation of the function invoked by KEY.  KEY is a string."
@@ -6473,7 +6535,7 @@ groups."
             (punct "!?:;.,"))
         (concat
          "\\(?:"
-         ;; Match paired parentheses, e.g. in WikiPedia URLs:
+         ;; Match paired parentheses, e.g. in Wikipedia URLs:
          "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
          "\\|"
          "[" chars punct     "]+" "[" chars "]"
@@ -6566,7 +6628,7 @@ Strings like this can be either a message ID or a mail address.  If it is one
 of the symbols `mid' or `mail', Gnus will always assume that the string is a
 message ID or a mail address, respectively.  If this variable is set to the
 symbol `ask', always query the user what do do.  If it is a function, this
-function will be called with the string as it's only argument.  The function
+function will be called with the string as its only argument.  The function
 must return `mid', `mail', `invalid' or `ask'."
   :version "22.1"
   :group 'gnus-article-buttons
@@ -6953,7 +7015,7 @@ positives are possible."
      0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
     ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
      0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
-    ("`\\(\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
+    ("`\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
      ;; Unlike the other regexps we really have to require quoting
      ;; here to determine where it ends.
      1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)