Fix my last change.
[gnus] / lisp / gnus-art.el
index 4bc1e3f..7ddd89d 100644 (file)
@@ -219,6 +219,13 @@ asynchronously.     The compressed face will be piped to this command."
   :type '(choice regexp (const nil))
   :group 'gnus-article-washing)
 
+(defcustom gnus-article-banner-alist nil
+  "Banner alist for stripping.
+For example, 
+     ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+  :type '(repeat (cons symbol regexp))
+  :group 'gnus-article-washing)
+
 (defcustom gnus-emphasis-alist
   (let ((format
         "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
@@ -595,8 +602,8 @@ displayed by the first non-nil matching CONTENT face."
     ("\223" "``")
     ("\224" "\"")
     ("\225" "*")
-    ("\226" "---")
-    ("\227" "-")
+    ("\226" "-")
+    ("\227" "--")
     ("\231" "(TM)")
     ("\233" ">")
     ("\234" "oe")
@@ -647,6 +654,20 @@ used."
                :value undisplayed-alternative)
          (function)))
 
+(defcustom gnus-mime-action-alist
+  '(("save to file" . gnus-mime-save-part)
+    ("display as text" . gnus-mime-inline-part)
+    ("view the part" . gnus-mime-view-part)
+    ("pipe to command" . gnus-mime-pipe-part)
+    ("toggle display" . gnus-article-press-button)
+    ("view as type" . gnus-mime-view-part-as-type)
+    ("internalize type" . gnus-mime-internalize-part)
+    ("externalize type" . gnus-mime-externalize-part))
+  "An alist of actions that run on the MIME attachment."
+  :group 'gnus-article-mime
+  :type '(repeat (cons (string :tag "name")
+                      (function))))
+
 ;;;
 ;;; The treatment variables
 ;;;
@@ -874,7 +895,7 @@ See the manual for details."
 (defcustom gnus-treat-display-xface 
   (and (or (and (fboundp 'image-type-available-p)
                (image-type-available-p 'xbm))
-          (and gnus-xemacs (featurep 'xface)))
+          (and (featurep 'xemacs) (featurep 'xface)))
        'head)
   "Display X-Face headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -883,9 +904,12 @@ See the manual for details."
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-display-xface 'highlight t)
 
-(defcustom gnus-treat-display-smileys (if (and gnus-xemacs
-                                              (featurep 'xpm))
-                                         t nil)
+(defcustom gnus-treat-display-smileys 
+  (if (or (and (featurep 'xemacs)
+              (featurep 'xpm))
+         (and (fboundp 'image-type-available-p)
+              (image-type-available-p 'pbm)))
+      t nil)
   "Display smileys.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See the manual for details."
@@ -893,7 +917,7 @@ See the manual for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-display-smileys 'highlight t)
 
-(defcustom gnus-treat-display-picons (if gnus-xemacs 'head nil)
+(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil)
   "Display picons.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See the manual for details."
@@ -1529,9 +1553,11 @@ or not."
       (unless charset 
        (setq charset gnus-newsgroup-charset))
       (when (or force
-               (and type (string-match "quoted-printable" (downcase type))))
+               (and type (let ((case-fold-search t))
+                           (string-match "quoted-printable" type))))
        (article-goto-body)
-       (quoted-printable-decode-region (point) (point-max) charset)))))
+       (quoted-printable-decode-region
+        (point) (point-max) (mm-charset-to-coding-system charset))))))
 
 (defun article-de-base64-unreadable (&optional force)
   "Translate a base64 article.
@@ -1554,13 +1580,14 @@ If FORCE, decode the article whether it is marked as base64 not."
       (unless charset 
        (setq charset gnus-newsgroup-charset))
       (when (or force
-               (and type (string-match "base64" (downcase type))))
+               (and type (let ((case-fold-search t))
+                           (string-match "base64" type))))
        (article-goto-body)
        (save-restriction
          (narrow-to-region (point) (point-max))
          (base64-decode-region (point-min) (point-max))
-         (if (mm-coding-system-p charset)
-             (mm-decode-coding-region (point-min) (point-max) charset)))))))
+         (mm-decode-coding-region
+          (point-min) (point-max) (mm-charset-to-coding-system charset)))))))
 
 (eval-when-compile
   (require 'rfc1843))
@@ -1694,7 +1721,7 @@ always hide."
   (save-excursion
     (save-restriction
       (let ((inhibit-point-motion-hooks t)
-           (banner (gnus-group-get-parameter gnus-newsgroup-name 'banner))
+           (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner))
            (gnus-signature-limit nil)
            buffer-read-only beg end)
        (when banner
@@ -1705,6 +1732,10 @@ always hide."
              (widen)
              (forward-line -1)
              (delete-region (point) (point-max))))
+          ((symbolp banner)
+           (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
+               (while (re-search-forward banner nil t)
+                 (delete-region (match-beginning 0) (match-end 0)))))
           ((stringp banner)
            (while (re-search-forward banner nil t)
              (delete-region (match-beginning 0) (match-end 0))))))))))
@@ -2261,8 +2292,8 @@ This format is defined by the `gnus-article-time-format' variable."
   (let ((default-name
          (funcall function group headers (symbol-value variable)))
        result)
-    (setq
-     result
+    (setq result
+        (expand-file-name
      (cond
       ((eq filename 'default)
        default-name)
@@ -2330,7 +2361,7 @@ This format is defined by the `gnus-article-time-format' variable."
           (setq file (expand-file-name (file-name-nondirectory default-name)
                                        (file-name-as-directory file))))
         ;; Possibly translate some characters.
-        (nnheader-translate-file-chars file)))))
+        (nnheader-translate-file-chars file))))))
     (gnus-make-directory (file-name-directory result))
     (set variable result)))
 
@@ -2813,6 +2844,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                (gnus-set-global-variables)
                (setq gnus-have-all-headers
                      (or all-headers gnus-show-all-headers))))
+           (save-excursion
+             (gnus-configure-windows 'article))
            (when (or (numberp article)
                      (stringp article))
              (gnus-article-prepare-display)
@@ -2878,7 +2911,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (gnus-mime-inline-part "i" "View As Text, In This Buffer")
     (gnus-mime-internalize-part "E" "View Internally")
     (gnus-mime-externalize-part "e" "View Externally")
-    (gnus-mime-pipe-part "|" "Pipe To Command...")))
+    (gnus-mime-pipe-part "|" "Pipe To Command...")
+    (gnus-mime-action-on-part "." "Take action on the part")))
 
 (defun gnus-article-mime-part-status ()
   (if gnus-article-mime-handle-alist-1
@@ -2996,19 +3030,33 @@ If ALL-HEADERS is non-nil, no headers are hidden."
       (setq buffer-file-name nil))
     (goto-char (point-min))))
 
-(defun gnus-mime-inline-part (&optional handle)
+(defun gnus-mime-inline-part (&optional handle arg)
   "Insert the MIME part under point into the current buffer."
-  (interactive)
+  (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-        contents
+        contents charset
         (b (point))
         buffer-read-only)
     (if (mm-handle-undisplayer handle)
        (mm-remove-part handle)
       (setq contents (mm-get-part handle))
+      (cond
+       ((not arg)
+       (setq charset (or (mail-content-type-get
+                          (mm-handle-type handle) 'charset)
+                         gnus-newsgroup-charset)))
+       ((numberp arg)
+       (setq charset
+             (or (cdr (assq arg 
+                            gnus-summary-show-article-charset-alist))
+                 (read-coding-system "Charset: ")))))
       (forward-line 2)
-      (mm-insert-inline handle contents)
+      (mm-insert-inline handle
+                       (if charset 
+                           (mm-decode-coding-string
+                            contents (mm-charset-to-coding-system charset))
+                         contents))
       (goto-char b))))
 
 (defun gnus-mime-externalize-part (&optional handle)
@@ -3042,6 +3090,16 @@ In no internal viewer is available, use an external viewer."
        (mm-remove-part handle)
       (mm-display-part handle))))
 
+(defun gnus-mime-action-on-part (&optional action)
+  "Do something with the MIME attachment at \(point\)."
+  (interactive
+   (list (completing-read "Action: " gnus-mime-action-alist)))
+  (gnus-article-check-buffer)
+  (let ((action-pair (assoc action gnus-mime-action-alist)))
+    (if action-pair
+       (funcall (cdr action-pair)))))
+
+
 (defun gnus-article-part-wrapper (n function)
   (save-current-buffer
     (set-buffer gnus-article-buffer)
@@ -3220,8 +3278,8 @@ In no internal viewer is available, use an external viewer."
        ;; window, overlay, position.
        (if (mm-handle-displayed-p
             (if overlay
-                (with-current-buffer (overlay-buffer overlay)
-                  (widget-get (widget-at (overlay-start overlay))
+                (with-current-buffer (gnus-overlay-buffer overlay)
+                  (widget-get (widget-at (gnus-overlay-start overlay))
                               :mime-handle))
               (widget-get widget/window :mime-handle)))
            "hide" "show")
@@ -3701,7 +3759,7 @@ Argument LINES specifies lines to be scrolled down."
       (set-buffer gnus-article-current-summary)
       (let (gnus-pick-mode)
         (push (or key last-command-event) unread-command-events)
-        (setq keys (if gnus-xemacs
+        (setq keys (if (featurep 'xemacs)
                       (events-to-keys (read-key-sequence nil))
                     (read-key-sequence nil)))))
                     
@@ -4544,16 +4602,14 @@ forbidden in URL encoding."
       (message-goto-subject))))
 
 (defun gnus-button-mailto (address)
-  ;; Mail to ADDRESS.
+  "Mail to ADDRESS."
   (set-buffer (gnus-copy-article-buffer))
   (message-reply address))
 
-(defun gnus-button-reply (address)
-  ;; Reply to ADDRESS.
-  (message-reply address))
+(defalias 'gnus-button-reply 'message-reply)
 
 (defun gnus-button-embedded-url (address)
-  "Browse ADDRESS."
+  "Activate ADDRESS with `browse-url'."
   (browse-url (gnus-strip-whitespace address)))
 
 ;;; Next/prev buttons in the article buffer.
@@ -4693,11 +4749,13 @@ For example:
          (funcall (cadr elem)))))))
 
 ;; Dynamic variables.
-(defvar part-number)
-(defvar total-parts)
-(defvar type)
-(defvar condition)
-(defvar length)
+(eval-when-compile
+  (defvar part-number)
+  (defvar total-parts)
+  (defvar type)
+  (defvar condition)
+  (defvar length))
+
 (defun gnus-treat-predicate (val)
   (cond
    ((null val)