* 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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f3fce86..317d8d4 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+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-art.el b/lisp/gnus-art.el
index 09f4817..5a77254 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/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-group.el b/lisp/gnus-group.el
index 602ee31..4a7f068 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/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-sum.el b/lisp/gnus-sum.el
index 0624418..c77e3fc 100644 (file)
--- a/lisp/gnus-sum.el
+++ b/lisp/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))))