Synch with `t-gnus-6_14' and Gnus.
[elisp/gnus.git-] / lisp / gnus-art.el
index 3ab7d48..94f21b8 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
@@ -270,6 +272,14 @@ is the face used for highlighting."
                       face))
   :group 'gnus-article-emphasis)
 
+(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
+  "A regexp to describe whitespace which should not be emphasized.
+Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
+The former avoids underlining of leading and trailing whitespace,
+and the latter avoids underlining any whitespace at all."
+  :group 'gnus-article-emphasis
+  :type 'regexp)
+
 (defface gnus-emphasis-bold '((t (:bold t)))
   "Face used for displaying strong emphasized text (*word*)."
   :group 'gnus-article-emphasis)
@@ -1620,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.
@@ -1660,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))
@@ -1710,9 +1724,14 @@ The `gnus-list-identifiers' variable specifies what to do."
          (when regexp
            (goto-char (point-min))
            (when (re-search-forward
-                  (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)")
+                  (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp 
+                          " *\\)\\)+\\(Re: +\\)?\\)")
                   nil t)
-             (delete-region (match-beginning 2) (match-end 0)))))))))
+             (let ((s (or (match-string 3) (match-string 5))))
+               (delete-region (match-beginning 1) (match-end 1))
+               (when s
+                 (goto-char (match-beginning 1))
+                 (insert s))))))))))
 
 (defun article-hide-pgp ()
   "Remove any PGP headers and signatures in the current article."
@@ -2460,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))
@@ -2621,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
@@ -2640,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
@@ -2652,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
@@ -2848,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)
@@ -2898,12 +2906,7 @@ commands:
     (mime-display-message mime-message-structure
                          gnus-article-buffer nil gnus-article-mode-map)
     (when all-headers
-      (gnus-article-hide-headers nil -1))
-    )
-  ;; `mime-display-message' changes current buffer to `gnus-article-buffer'.
-  (make-local-variable 'mime-button-mother-dispatcher)
-  (setq mime-button-mother-dispatcher
-       (function gnus-article-push-button))
+      (gnus-article-hide-headers nil -1)))
   (run-hooks 'gnus-mime-article-prepare-hook))
 
 (defun gnus-article-display-traditional-message ()
@@ -3213,15 +3216,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."
@@ -3287,7 +3289,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)
@@ -3346,7 +3348,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)
@@ -3531,21 +3533,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))
@@ -3825,7 +3836,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.
@@ -4158,11 +4169,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))))))))
@@ -4243,6 +4254,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))
@@ -4401,7 +4413,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)))
@@ -4515,7 +4527,7 @@ after replacing with the original article."
 
 ;;; Internal Variables:
 
-(defcustom gnus-button-url-regexp "\\b\\(\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)\\|[-a-zA-Z0-9_]+\\.[-a-zA-Z0-9_]+\\(\\.[-a-zA-Z0-9_]+[-a-zA-Z0-9_/]+\\)+"
+(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
   "Regular expression that matches URLs."
   :group 'gnus-article-buttons
   :type 'regexp)
@@ -4845,7 +4857,9 @@ specified by `gnus-button-alist'."
    (nconc (and gnus-article-mouse-face
               (list gnus-mouse-face-prop gnus-article-mouse-face))
          (list 'gnus-callback fun)
-         (and data (list 'gnus-data data)))))
+         (and data (list 'gnus-data data))))
+  (widget-convert-button 'link from to :action 'gnus-widget-press-button
+                        :button-keymap gnus-widget-button-keymap))
 
 ;;; Internal functions: