Merge from gnus--devo--0

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1629

5 files changed, 97 insertions, 28 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2bdd3dfa91a..b11a7295d48 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2009-08-28  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * mml.el (mml-attach-file, mml-attach-buffer, mml-attach-external):
+        Don't save excursion.
+
 2009-08-28  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * nnheader.el (nnheader-find-file-noselect):
@@ -23,6 +28,21 @@
         * gnus-art.el (gnus-button-patch): Use forward-line rather than
         goto-line.
 
+2009-08-12  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * gnus-group.el (gnus-safe-html-newsgroups): New user option.
+
+        * gnus-art.el (gnus-bind-safe-url-regexp): New macro.
+        (gnus-mime-view-all-parts, gnus-mime-view-part-internally)
+        (gnus-mm-display-part, gnus-mime-display-single)
+        (gnus-mime-display-alternative): Use gnus-bind-safe-url-regexp to
+        override mm-w3m-safe-url-regexp according to gnus-safe-html-newsgroups.
+
+        * gnus-sum.el
+        (gnus-mark-copied-or-moved-articles-as-expirable): New user option.
+        (gnus-summary-move-article): Add expirable mark to articles copied or
+        moved to group that has auto-expire turned on if the option is non-nil.
+
 2009-07-24  Glenn Morris  <rgm@gnu.org>
 
         * gnus-demon.el (gnus-demon-add-nntp-close-connection):
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index cedfff0421c..087ad68c539 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4740,6 +4740,23 @@ General format specifiers can also be used.  See Info node
                 (vector (caddr c) (car c) :active t))
               gnus-mime-button-commands)))
 
+(defmacro gnus-bind-safe-url-regexp (&rest body)
+  "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
+  `(let ((mm-w3m-safe-url-regexp
+          (let ((group (if (and (eq major-mode 'gnus-article-mode)
+                                (gnus-buffer-live-p
+                                 gnus-article-current-summary))
+                           (with-current-buffer gnus-article-current-summary
+                             gnus-newsgroup-name)
+                         gnus-newsgroup-name)))
+            (if (cond ((stringp gnus-safe-html-newsgroups)
+                       (string-match gnus-safe-html-newsgroups group))
+                      ((consp gnus-safe-html-newsgroups)
+                       (member group gnus-safe-html-newsgroups)))
+                nil
+              mm-w3m-safe-url-regexp))))
+     ,@body))
+
 (defun gnus-mime-button-menu (event prefix)
  "Construct a context-sensitive menu of MIME commands."
  (interactive "e\nP")
@@ -4765,7 +4782,7 @@ General format specifiers can also be used.  See Info node
         (or (search-forward "\n\n") (goto-char (point-max)))
         (let ((inhibit-read-only t))
           (delete-region (point) (point-max))
-          (mm-display-parts handles))))))
+          (gnus-bind-safe-url-regexp (mm-display-parts handles)))))))
 
 (defun gnus-article-jump-to-part (n)
   "Jump to MIME part N."
@@ -5267,7 +5284,7 @@ If no internal viewer is available, use an external viewer."
       (when handle
         (if (mm-handle-undisplayer handle)
             (mm-remove-part handle)
-          (mm-display-part handle))))))
+          (gnus-bind-safe-url-regexp (mm-display-part handle)))))))
 
 (defun gnus-mime-action-on-part (&optional action)
   "Do something with the MIME attachment at \(point\)."
@@ -5488,7 +5505,7 @@ N is the numerical prefix."
                     (save-restriction
                       (narrow-to-region (point)
                                         (if (eobp) (point) (1+ (point))))
-                      (mm-display-part handle)
+                      (gnus-bind-safe-url-regexp (mm-display-part handle))
                       ;; We narrow to the part itself and
                       ;; then call the treatment functions.
                       (goto-char (point-min))
@@ -5767,7 +5784,7 @@ If displaying \"text/html\" is discouraged \(see
                                        (set-buffer gnus-summary-buffer)
                                      (error))
                                    gnus-newsgroup-ignored-charsets)))
-              (mm-display-part handle t))
+              (gnus-bind-safe-url-regexp (mm-display-part handle t)))
             (goto-char (point-max)))
            ((and text not-attachment)
             (when move
@@ -5903,7 +5920,7 @@ If displaying \"text/html\" is discouraged \(see
                   (mail-parse-ignored-charsets
                    (with-current-buffer gnus-summary-buffer
                      gnus-newsgroup-ignored-charsets)))
-              (mm-display-part preferred)
+              (gnus-bind-safe-url-regexp (mm-display-part preferred))
               ;; Do highlighting.
               (save-excursion
                 (save-restriction
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 602ee31944a..4a7f06833a3 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -110,6 +110,18 @@ If nil, no groups are permanently visible."
   :group 'gnus-group-listing
   :type '(choice regexp (const nil)))
 
+(defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
+  "Groups in which links in html articles are considered all safe.
+The value may be a regexp matching those groups, a list of group names,
+or nil.  This overrides `mm-w3m-safe-url-regexp' (which see).  This is
+effective only when emacs-w3m renders html articles, i.e., in the case
+`mm-text-html-renderer' is set to `w3m'."
+  :version "23.2"
+  :group 'gnus-group-various
+  :type '(choice regexp
+                 (repeat :tag "List of group names" (string :tag "Group"))
+                 (const nil)))
+
 (defcustom gnus-list-groups-with-ticked-articles t
   "*If non-nil, list groups that have only ticked articles.
 If nil, only list groups that have unread articles."
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 0624418f5ee..c77e3fcd9e2 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -668,6 +668,17 @@ string with the suggested prefix."
   :group 'gnus-summary
   :type 'boolean)
 
+(defcustom gnus-mark-copied-or-moved-articles-as-expirable nil
+  "If non-nil, mark articles copied or moved to auto-expire group as expirable.
+If nil, the expirable marks will be unchanged except that the marks
+will be removed when copying or moving articles to a group that has
+not turned auto-expire on.  If non-nil, articles that have been read
+will be marked as expirable when being copied or moved to a group in
+which auto-expire is turned on."
+  :version "23.2"
+  :type 'boolean
+  :group 'gnus-summary-marks)
+
 (defcustom gnus-view-pseudos nil
   "*If `automatic', pseudo-articles will be viewed automatically.
 If `not-confirm', pseudos will be viewed automatically, and the user
@@ -9753,11 +9764,12 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                                        (list (cdr art-group)))))
 
             ;; See whether the article is to be put in the cache.
-            (let ((marks (if (gnus-group-auto-expirable-p to-group)
-                             gnus-article-mark-lists
-                           (delete '(expirable . expire)
-                                   (copy-sequence gnus-article-mark-lists))))
-                  (to-article (cdr art-group)))
+            (let* ((expirable (gnus-group-auto-expirable-p to-group))
+                   (marks (if expirable
+                              gnus-article-mark-lists
+                            (delete '(expirable . expire)
+                                    (copy-sequence gnus-article-mark-lists))))
+                   (to-article (cdr art-group)))
 
               ;; Enter the article into the cache in the new group,
               ;; if that is required.
@@ -9796,6 +9808,17 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                        to-group (cdar marks) (list to-article) info)))
                   (setq marks (cdr marks)))
 
+                (when (and expirable
+                           gnus-mark-copied-or-moved-articles-as-expirable
+                           (not (memq 'expire to-marks)))
+                  ;; Mark this article as expirable.
+                  (push 'expire to-marks)
+                  (when (equal to-group gnus-newsgroup-name)
+                    (push to-article gnus-newsgroup-expirable))
+                  ;; Copy the expirable mark to other group.
+                  (gnus-add-marked-articles
+                   to-group 'expire (list to-article) info))
+
                 (gnus-request-set-mark
                  to-group (list (list (list to-article) 'add to-marks))))
 
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 6028ce8b205..796470bd17f 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1292,15 +1292,14 @@ body) or \"attachment\" (separate from the body)."
           (description (mml-minibuffer-read-description))
           (disposition (mml-minibuffer-read-disposition type nil file)))
      (list file type description disposition)))
-  (save-excursion
-    (unless (message-in-body-p) (goto-char (point-max)))
-    (mml-insert-empty-tag 'part
-                          'type type
-                          ;; icicles redefines read-file-name and returns a
-                          ;; string w/ text properties :-/
-                          'filename (mm-substring-no-properties file)
-                          'disposition (or disposition "attachment")
-                          'description description)))
+  (unless (message-in-body-p) (goto-char (point-max)))
+  (mml-insert-empty-tag 'part
+                        'type type
+                        ;; icicles redefines read-file-name and returns a
+                        ;; string w/ text properties :-/
+                        'filename (mm-substring-no-properties file)
+                        'disposition (or disposition "attachment")
+                        'description description))
 
 (defun mml-dnd-attach-file (uri action)
   "Attach a drag and drop file.
@@ -1336,11 +1335,10 @@ BUFFER is the name of the buffer to attach.  See
           (description (mml-minibuffer-read-description))
           (disposition (mml-minibuffer-read-disposition type nil)))
      (list buffer type description disposition)))
-  (save-excursion
-    (unless (message-in-body-p) (goto-char (point-max)))
-    (mml-insert-empty-tag 'part 'type type 'buffer buffer
-                          'disposition disposition
-                          'description description)))
+  (unless (message-in-body-p) (goto-char (point-max)))
+  (mml-insert-empty-tag 'part 'type type 'buffer buffer
+                        'disposition disposition
+                        'description description))
 
 (defun mml-attach-external (file &optional type description)
   "Attach an external file into the buffer.
@@ -1351,10 +1349,9 @@ TYPE is the MIME type to use."
           (type (mml-minibuffer-read-type file))
           (description (mml-minibuffer-read-description)))
      (list file type description)))
-  (save-excursion
-    (unless (message-in-body-p) (goto-char (point-max)))
-    (mml-insert-empty-tag 'external 'type type 'name file
-                          'disposition "attachment" 'description description)))
+  (unless (message-in-body-p) (goto-char (point-max)))
+  (mml-insert-empty-tag 'external 'type type 'name file
+                        'disposition "attachment" 'description description))
 
 (defun mml-insert-multipart (&optional type)
   (interactive (list (completing-read "Multipart type (default mixed): "