]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/gnus-art.el
(dired-pop-to-buffer): Try to make this behave the
[gnu-emacs] / lisp / gnus / gnus-art.el
index a8ca34386f17ff6c22dacbf11b4b5912693f945d..91fccf7a4350eda02021e01c06d3abdd9fd1cd1a 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-art.el --- article mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -537,6 +537,7 @@ that the symbol of the saver function, which is specified by
   :group 'gnus-article-saving
   :type 'regexp)
 
+;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
   "A function to save articles in your favourite format.
 The function will be called by way of the `gnus-summary-save-article'
@@ -1453,7 +1454,7 @@ See Info node `(gnus)Customizing Articles' and Info node
   "Display 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."
+node `(gnus)Face' for details."
   :group 'gnus-article-treat
   :version "22.1"
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -2728,14 +2729,33 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
   (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
        w3m-force-redisplay)
     (w3m-region (point-min) (point-max)))
+  ;; Put the mark meaning this part was rendered by emacs-w3m.
+  (put-text-property (point-min) (point-max) 'mm-inline-text-html-with-w3m t)
   (when (and mm-inline-text-html-with-w3m-keymap
             (boundp 'w3m-minor-mode-map)
             w3m-minor-mode-map)
-    (add-text-properties
-     (point-min) (point-max)
-     (list 'keymap w3m-minor-mode-map
-          ;; Put the mark meaning this part was rendered by emacs-w3m.
-          'mm-inline-text-html-with-w3m t))))
+    (if (and (boundp 'w3m-link-map)
+            w3m-link-map)
+       (let* ((start (point-min))
+              (end (point-max))
+              (on (get-text-property start 'w3m-href-anchor))
+              (map (copy-keymap w3m-link-map))
+              next)
+         (set-keymap-parent map w3m-minor-mode-map)
+         (while (< start end)
+           (if on
+               (progn
+                 (setq next (or (text-property-any start end
+                                                   'w3m-href-anchor nil)
+                                end))
+                 (put-text-property start next 'keymap map))
+             (setq next (or (text-property-not-all start end
+                                                   'w3m-href-anchor nil)
+                            end))
+             (put-text-property start next 'keymap w3m-minor-mode-map))
+           (setq start next
+                 on (not on))))
+      (put-text-property (point-min) (point-max) 'keymap w3m-minor-mode-map))))
 
 (defvar charset) ;; Bound by `article-wash-html'.
 
@@ -3385,9 +3405,15 @@ should replace the \"Date:\" one, or should be added below it."
                                    (point) 'original-date))
                     (setq date (get-text-property pos 'original-date))
                     t))
-         (narrow-to-region pos (or (text-property-any pos (point-max)
-                                                      'original-date nil)
-                                   (point-max)))
+         (narrow-to-region
+          pos (if (setq pos (text-property-any pos (point-max)
+                                               'original-date nil))
+                  (progn
+                    (goto-char pos)
+                    (if (or (bolp) (eobp))
+                        (point)
+                      (1+ (point))))
+                (point-max)))
          (goto-char (point-min))
          (when (re-search-forward tdate-regexp nil t)
            (setq bface (get-text-property (point-at-bol) 'face)
@@ -3851,6 +3877,9 @@ Directory to save to is default to `gnus-article-save-directory'."
     (save-excursion
       (save-restriction
        (widen)
+       ;; Note that unlike gnus-summary-save-in-mail, there is no
+       ;; check to see if filename is Babyl.  Rmail in Emacs 23 does
+       ;; not use Babyl.
        (gnus-output-to-rmail filename))))
   filename)
 
@@ -3869,7 +3898,7 @@ Directory to save to is default to `gnus-article-save-directory'."
        (if (and (file-readable-p filename)
                 (file-regular-p filename)
                 (mail-file-babyl-p filename))
-           (rmail-output-to-rmail-file filename t)
+           (gnus-output-to-rmail filename)
          (gnus-output-to-mail filename)))))
   filename)
 
@@ -5138,10 +5167,14 @@ 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."
+(defun gnus-mime-set-charset-parameters (handle charset)
+  "Set CHARSET to parameters in HANDLE.
+CHARSET may either be a string or a symbol."
+  (unless (stringp charset)
+    (setq charset (symbol-name charset)))
   (if (stringp (car handle))
-      (mapc #'gnus-mime-strip-charset-parameters (cdr handle))
+      (dolist (h (cdr handle))
+       (gnus-mime-set-charset-parameters h charset))
     (let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle)
                                            "message/external-body")
                                     (progn
@@ -5149,9 +5182,10 @@ Compressed files like .gz and .bz2 are decompressed."
                                         (mm-extern-cache-contents handle))
                                       (mm-handle-cache handle))
                                   handle)))
-          (charset (assq 'charset (cdr type))))
-      (when charset
-       (delq charset type)))))
+          (param (assq 'charset (cdr type))))
+      (if param
+         (setcdr param charset)
+       (setcdr type (cons (cons 'charset charset) (cdr type)))))))
 
 (defun gnus-mime-view-part-as-charset (&optional handle arg)
   "Insert the MIME part under point into the current buffer using the
@@ -5161,18 +5195,18 @@ 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 form preferred parts)
+       charset form preferred parts)
     (when handle
       (when (prog1
                (and fun
-                    (setq gnus-newsgroup-charset
+                    (setq charset
                           (or (cdr (assq
                                     arg
                                     gnus-summary-show-article-charset-alist))
                               (mm-read-coding-system "Charset: "))))
              (if (mm-handle-undisplayer handle)
                  (mm-remove-part handle)))
-       (gnus-mime-strip-charset-parameters handle)
+       (gnus-mime-set-charset-parameters handle charset)
        (when (and (consp (setq form (cdr-safe fun)))
                   (setq form (ignore-errors
                                (assq 'gnus-mime-display-alternative form)))
@@ -6373,6 +6407,7 @@ not have a face in `gnus-article-boring-faces'."
                                      (point))))
                (when (and (not not-restore-window)
                           new-sum-point
+                          (window-live-p win)
                           (with-current-buffer (window-buffer win)
                             (eq major-mode 'gnus-summary-mode)))
                  (set-window-point win new-sum-point)
@@ -7377,7 +7412,11 @@ positives are possible."
       gnus-button-ctan-directory-regexp
       "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
      1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
-    ;; This is info (home-grown style) <info://foo/bar+baz>
+    ;; Info Konqueror style <info:/foo/bar baz>.
+    ;; Must come before " Gnus home-grown style".
+    ("\\binfo://?\\([^'\">\n\t]+\\)"
+     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
+   ;; Info, Gnus home-grown style (deprecated) <info://foo/bar+baz>
     ("\\binfo://\\([^'\">\n\t ]+\\)"
      0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
     ;; Info GNOME style <info:foo#bar_baz>