Changes committed gnus/lisp (ChangeLog gnus-art.el gnus-group.el gnus-sum.el)

Modified: ChangeLog gnus-art.el gnus-group.el gnus-sum.el

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


Index: ChangeLog
diff -u gnus/lisp/ChangeLog:7.2005 gnus/lisp/ChangeLog:7.2006
--- ChangeLog:7.2005	Sun Jul 26 10:58:16 2009
+++ ChangeLog	Wed Aug 12 10:27:50 2009
@@ -1,3 +1,18 @@
+2009-08-12  Katsumi Yamaoka  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* gnus-demon.el (gnus-demon-add-nntp-close-connection):
Index: gnus-art.el
diff -u gnus/lisp/gnus-art.el:7.292 gnus/lisp/gnus-art.el:7.293
--- gnus-art.el:7.292	Fri Jul 24 02:01:28 2009
+++ gnus-art.el	Wed Aug 12 10:27:50 2009
@@ -4740,6 +4740,23 @@
 		(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 @@
 	(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 @@
       (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 @@
 		    (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 @@
 				       (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 @@
 		  (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
Index: gnus-group.el
diff -u gnus/lisp/gnus-group.el:7.118 gnus/lisp/gnus-group.el:7.119
--- gnus-group.el:7.118	Fri Jul 10 14:05:55 2009
+++ gnus-group.el	Wed Aug 12 10:27:50 2009
@@ -110,6 +110,18 @@
   :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."
Index: gnus-sum.el
diff -u gnus/lisp/gnus-sum.el:7.238 gnus/lisp/gnus-sum.el:7.239
--- gnus-sum.el:7.238	Thu Feb  5 10:04:09 2009
+++ gnus-sum.el	Wed Aug 12 10:27:50 2009
@@ -668,6 +668,17 @@
   :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 @@
 				       (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 @@
 		       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))))