Sync with `t-gnus-6_14'.
[elisp/gnus.git-] / lisp / gnus-art.el
index aeaba89..f8e8f77 100644 (file)
@@ -210,9 +210,11 @@ regexp.  If it matches, the text in question is not a signature."
 
 (defcustom gnus-article-x-face-command
   (cond
+   ;; Fixme: This isn't the right thing for mixed graphical and and
+   ;; non-graphical frames in a session.
+   ;; gnus-xmas.el overrides this for XEmacs.
    ((and (fboundp 'image-type-available-p)
-        (or (image-type-available-p 'xpm)
-            (image-type-available-p 'xbm)))
+        (image-type-available-p 'xbm))
     'gnus-article-display-xface)
    ((and (not gnus-xemacs)
         window-system
@@ -1628,6 +1630,10 @@ If PROMPT (the prefix), prompt for a coding system to use."
     (forward-line 1)
     (save-restriction
       (narrow-to-region (point) (point-max))
+      (when (and (eq mail-parse-charset 'gnus-decoded)
+                (eq (mm-body-7-or-8) '8bit))
+       ;; The text code could have been decoded.
+       (setq charset mail-parse-charset))
       (when (and (or (not ctl)
                     (equal (car ctl) "text/plain"))
                 (not format)) ;; article with format will decode later.
@@ -1668,7 +1674,7 @@ If FORCE, decode the article whether it is marked as base64 not."
          (type (gnus-fetch-field "content-transfer-encoding"))
          (charset gnus-newsgroup-charset))
       (when (or force
-               (and type (string-match "quoted-printable" (downcase type))))
+               (and type (string-match "base64" (downcase type))))
        (article-goto-body)
        (save-restriction
          (narrow-to-region (point) (point-max))
@@ -2473,8 +2479,8 @@ This format is defined by the `gnus-article-time-format' variable."
         (gnus-make-directory (file-name-directory file))
         ;; If we have read a directory, we append the default file name.
         (when (file-directory-p file)
-          (setq file (concat (file-name-as-directory file)
-                             (file-name-nondirectory default-name))))
+          (setq file (expand-file-name (file-name-nondirectory default-name)
+                                       (file-name-as-directory file))))
         ;; Possibly translate some characters.
         (nnheader-translate-file-chars file)))))
     (gnus-make-directory (file-name-directory result))
@@ -2634,17 +2640,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        default
       (or last-file default))))
 
-(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
-  (or last-file
-      (expand-file-name
-       (if (gnus-use-long-file-name 'not-save)
-          (gnus-capitalize-newsgroup newsgroup)
-        (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
-       gnus-article-save-directory)))
-
 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
 If variable `gnus-use-long-file-name' is non-nil, it is
@@ -2653,7 +2648,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
       (expand-file-name
        (if (gnus-use-long-file-name 'not-save)
           newsgroup
-        (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
+        (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)))
        gnus-article-save-directory)))
 
 (eval-and-compile
@@ -2665,17 +2660,16 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                 gfunc (cdr func))
         (setq afunc func
               gfunc (intern (format "gnus-%s" func))))
-       (fset gfunc
-            (if (not (fboundp afunc))
-                nil
-              `(lambda (&optional interactive &rest args)
-                 ,(documentation afunc t)
-                 (interactive (list t))
-                 (save-excursion
-                   (set-buffer gnus-article-buffer)
-                   (if interactive
-                       (call-interactively ',afunc)
-                     (apply ',afunc args))))))))
+       (defalias gfunc
+        (if (fboundp afunc)
+          `(lambda (&optional interactive &rest args)
+             ,(documentation afunc t)
+             (interactive (list t))
+             (save-excursion
+               (set-buffer gnus-article-buffer)
+               (if interactive
+                   (call-interactively ',afunc)
+                 (apply ',afunc args))))))))
    '(article-hide-headers
      article-hide-boring-headers
      article-toggle-headers
@@ -2861,6 +2855,7 @@ commands:
     ;; Init original article buffer.
     (save-excursion
       (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+      (set-buffer-multibyte nil)
       (setq major-mode 'gnus-original-article-mode)
       (make-local-variable 'gnus-original-article))
     (if (get-buffer name)
@@ -3226,15 +3221,14 @@ value of the variable `gnus-show-mime' is non-nil."
          (format " (%d parts)" (length (mime-entity-children entity)))
        ""))))
 
-(defvar gnus-mime-button-map nil)
-(unless gnus-mime-button-map
-  (setq gnus-mime-button-map (make-sparse-keymap))
-  (set-keymap-parent gnus-mime-button-map gnus-article-mode-map)
-  (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
-  (define-key gnus-mime-button-map gnus-down-mouse-3 'gnus-mime-button-menu)
-  (mapcar (lambda (c)
-           (define-key gnus-mime-button-map (cadr c) (car c)))
-         gnus-mime-button-commands))
+(defvar gnus-mime-button-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map gnus-article-mode-map)
+    (define-key map gnus-mouse-2 'gnus-article-push-button)
+    (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
+    (dolist (c gnus-mime-button-commands)
+      (define-key map (cadr c) (car c)))
+    map))
 
 (defun gnus-mime-button-menu (event)
   "Construct a context-sensitive menu of MIME commands."
@@ -3300,7 +3294,7 @@ value of the variable `gnus-show-mime' is non-nil."
   (interactive
    (list (completing-read
          "View as MIME type: "
-         (mapcar (lambda (i) (list i i)) (mailcap-mime-types))
+         (mapcar #'list (mailcap-mime-types))
          nil nil
          (gnus-mime-view-part-as-type-internal))))
   (gnus-article-check-buffer)
@@ -3359,7 +3353,7 @@ value of the variable `gnus-show-mime' is non-nil."
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
         (mm-user-display-methods nil)
-        (mm-inline-large-images nil)
+        (mm-inlined-types nil)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets 
          (save-excursion (set-buffer gnus-summary-buffer)
@@ -3544,21 +3538,30 @@ In no internal viewer is available, use an external viewer."
                 article-type annotation
                 gnus-data ,handle))
     (setq e (point))
-    (widget-convert-button 'link b e
-                          :mime-handle handle
-                          :action 'gnus-widget-press-button
-                          :button-keymap gnus-mime-button-map
-                          :help-echo
-                          (lambda (widget)
-                            ;; Needed to properly clear the message
-                            ;; due to a bug in wid-edit
-                            (setq help-echo-owns-message t)
-                            (format
-                             "Click to %s the MIME part; %s for more options"
-                             (if (mm-handle-displayed-p
-                                  (widget-get widget :mime-handle))
-                                 "hide" "show")
-                             (if gnus-xemacs "button3" "mouse-3"))))))
+    (widget-convert-button
+     'link b e
+     :mime-handle handle
+     :action 'gnus-widget-press-button
+     :button-keymap gnus-mime-button-map
+     :help-echo
+     (lambda (widget/window &optional overlay pos)
+       ;; Needed to properly clear the message due to a bug in
+       ;; wid-edit (XEmacs only).
+       (if (boundp 'help-echo-owns-message)
+          (setq help-echo-owns-message t))
+       (format
+       "%S: %s the MIME part; %S: more options"
+       (aref gnus-mouse-2 0)
+       ;; XEmacs will get a single widget arg; Emacs 21 will get
+       ;; window, overlay, position.
+       (if (mm-handle-displayed-p
+            (if overlay
+                (with-current-buffer (overlay-buffer overlay)
+                  (widget-get (widget-at (overlay-start overlay))
+                              :mime-handle))
+              (widget-get widget/window :mime-handle)))
+           "hide" "show")
+       (aref gnus-down-mouse-3 0))))))
 
 (defun gnus-widget-press-button (elems el)
   (goto-char (widget-get elems :from))
@@ -3838,7 +3841,7 @@ In no internal viewer is available, use an external viewer."
              (if gnus-show-mime ?m ? )
              (if emphasis ?e ? )))))
 
-(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
+(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
 
 (defun gnus-article-maybe-hide-headers ()
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
@@ -4171,11 +4174,11 @@ If given a prefix, show the hidden text instead."
                               gnus-newsgroup-name)))
                  (when (and (eq (car method) 'nneething)
                             (vectorp header))
-                   (let ((dir (concat
+                   (let ((dir (expand-file-name
+                               (mail-header-subject header)
                                (file-name-as-directory
                                 (or (cadr (assq 'nneething-address method))
-                                    (nth 1 method)))
-                               (mail-header-subject header))))
+                                    (nth 1 method))))))
                      (when (file-directory-p dir)
                        (setq article 'nneething)
                        (gnus-group-enter-directory dir))))))))
@@ -4256,6 +4259,7 @@ If given a prefix, show the hidden text instead."
          (if (get-buffer gnus-original-article-buffer)
              (set-buffer gnus-original-article-buffer)
            (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+           (set-buffer-multibyte nil)
            (buffer-disable-undo)
            (setq major-mode 'gnus-original-article-mode)
            (setq buffer-read-only t))
@@ -4414,7 +4418,7 @@ groups."
   "Exit the article editing without updating."
   (interactive)
   ;; We remove all text props from the article buffer.
-  (let ((buf (format "%s" (buffer-string)))
+  (let ((buf (buffer-substring-no-properties (point-min) (point-max)))
        (curbuf (current-buffer))
        (p (point))
        (window-start (window-start)))