* lisp/gnus/gnus-art.el: Add `event` args and operate at its position.

(gnus-mime-save-part-and-strip)
(gnus-mime-delete-part, gnus-mime-save-part, gnus-mime-pipe-part)
(gnus-mime-view-part, gnus-mime-view-part-as-type)
(gnus-mime-copy-part, gnus-mime-print-part, gnus-mime-inline-part)
(gnus-mime-view-part-as-charset, gnus-mime-view-part-externally)
(gnus-mime-view-part-internally, gnus-article-press-button):
Add `event` arg and operate at its position.

1 files changed, 194 insertions, 173 deletions

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 588e75384a6..6a66dc65421 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2707,7 +2707,7 @@ If READ-CHARSET, ask for a coding system."
   "Format an HTML article."
   (interactive)
   (let ((handles nil)
-	(buffer-read-only nil))
+	(inhibit-read-only t))
     (when (gnus-buffer-live-p gnus-original-article-buffer)
       (with-current-buffer gnus-original-article-buffer
 	(setq handles (mm-dissect-buffer t t))))
@@ -5074,50 +5074,53 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
 	   file))
   (gnus-mime-save-part-and-strip file))
 
-(defun gnus-mime-save-part-and-strip (&optional file)
+(defun gnus-mime-save-part-and-strip (&optional file event)
   "Save the MIME part under point then replace it with an external body.
 If FILE is given, use it for the external part."
-  (interactive)
-  (gnus-article-check-buffer)
-  (when (gnus-group-read-only-p)
-    (error "The current group does not support deleting of parts"))
-  (when (mm-complicated-handles gnus-article-mime-handles)
-    (error "\
+  (interactive (list nil last-nonmenu-event))
+  (save-excursion
+    (mouse-set-point event)
+    (gnus-article-check-buffer)
+    (when (gnus-group-read-only-p)
+      (error "The current group does not support deleting of parts"))
+    (when (mm-complicated-handles gnus-article-mime-handles)
+      (error "\
 The current article has a complicated MIME structure, giving up..."))
-  (let* ((data (get-text-property (point) 'gnus-data))
-	 (id (get-text-property (point) 'gnus-part))
-	 (handles gnus-article-mime-handles))
-    (unless file
-      (setq file
-	    (and data (mm-save-part data "Delete MIME part and save to: "))))
-    (when file
-      (with-current-buffer (mm-handle-buffer data)
-	(erase-buffer)
-	(insert "Content-Type: " (mm-handle-media-type data))
-	(mml-insert-parameter-string (cdr (mm-handle-type data))
-				     '(charset))
-	;; Add a filename for the sake of saving the part again.
-	(mml-insert-parameter
-	 (mail-header-encode-parameter "name" (file-name-nondirectory file)))
-	(insert "\n")
-	(insert "Content-ID: " (message-make-message-id) "\n")
-	(insert "Content-Transfer-Encoding: binary\n")
-	(insert "\n"))
-      (setcdr data
-	      (cdr (mm-make-handle nil
-				   `("message/external-body"
-				     (access-type . "LOCAL-FILE")
-				     (name . ,file)))))
-      ;; (set-buffer gnus-summary-buffer)
-      (gnus-article-edit-part handles id))))
+    (let* ((data (get-text-property (point) 'gnus-data))
+	   (id (get-text-property (point) 'gnus-part))
+	   (handles gnus-article-mime-handles))
+      (unless file
+	(setq file
+	      (and data (mm-save-part data "Delete MIME part and save to: "))))
+      (when file
+	(with-current-buffer (mm-handle-buffer data)
+	  (erase-buffer)
+	  (insert "Content-Type: " (mm-handle-media-type data))
+	  (mml-insert-parameter-string (cdr (mm-handle-type data))
+				       '(charset))
+	  ;; Add a filename for the sake of saving the part again.
+	  (mml-insert-parameter
+	   (mail-header-encode-parameter "name" (file-name-nondirectory file)))
+	  (insert "\n")
+	  (insert "Content-ID: " (message-make-message-id) "\n")
+	  (insert "Content-Transfer-Encoding: binary\n")
+	  (insert "\n"))
+	(setcdr data
+		(cdr (mm-make-handle nil
+				     `("message/external-body"
+				       (access-type . "LOCAL-FILE")
+				       (name . ,file)))))
+	;; (set-buffer gnus-summary-buffer)
+	(gnus-article-edit-part handles id)))))
 
 ;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
 ;; parts...>') but with stripping would be nice.
 
-(defun gnus-mime-delete-part ()
+(defun gnus-mime-delete-part (&optional event)
   "Delete the MIME part under point.
 Replace it with some information about the removed part."
-  (interactive)
+  (interactive (list last-nonmenu-event))
+  (mouse-set-point event)
   (gnus-article-check-buffer)
   (when (gnus-group-read-only-p)
     (error "The current group does not support deleting of parts"))
@@ -5163,33 +5166,37 @@ Deleting parts may malfunction or destroy the article; continue? "))
       ;; (set-buffer gnus-summary-buffer)
       (gnus-article-edit-part handles id))))
 
-(defun gnus-mime-save-part ()
+(defun gnus-mime-save-part (&optional event)
   "Save the MIME part under point."
-  (interactive)
+  (interactive (list last-nonmenu-event))
+  (mouse-set-point event)
   (gnus-article-check-buffer)
   (let ((data (get-text-property (point) 'gnus-data)))
     (when data
       (mm-save-part data))))
 
-(defun gnus-mime-pipe-part (&optional cmd)
+(defun gnus-mime-pipe-part (&optional cmd event)
   "Pipe the MIME part under point to a process.
 Use CMD as the process."
-  (interactive)
+  (interactive (list nil last-nonmenu-event))
+  (mouse-set-point event)
   (gnus-article-check-buffer)
   (let ((data (get-text-property (point) 'gnus-data)))
     (when data
       (mm-pipe-part data cmd))))
 
-(defun gnus-mime-view-part ()
+(defun gnus-mime-view-part (&optional event)
   "Interactively choose a viewing method for the MIME part under point."
-  (interactive)
-  (gnus-article-check-buffer)
-  (let ((data (get-text-property (point) 'gnus-data)))
-    (when data
-      (setq gnus-article-mime-handles
-	    (mm-merge-handles
-	     gnus-article-mime-handles (setq data (copy-sequence data))))
-      (mm-interactively-view-part data))))
+  (interactive (list last-nonmenu-event))
+  (save-excursion
+    (mouse-set-point event)
+    (gnus-article-check-buffer)
+    (let ((data (get-text-property (point) 'gnus-data)))
+      (when data
+        (setq gnus-article-mime-handles
+              (mm-merge-handles
+               gnus-article-mime-handles (setq data (copy-sequence data))))
+        (mm-interactively-view-part data)))))
 
 (defun gnus-mime-view-part-as-type-internal ()
   (gnus-article-check-buffer)
@@ -5206,48 +5213,51 @@ Use CMD as the process."
 	     '("text/plain" . 0))
 	'("application/octet-stream" . 0))))
 
-(defun gnus-mime-view-part-as-type (&optional mime-type pred)
+(defun gnus-mime-view-part-as-type (&optional mime-type pred event)
   "Choose a MIME media type, and view the part as such.
 If non-nil, PRED is a predicate to use during completion to limit the
 available media-types."
-  (interactive)
-  (unless mime-type
-    (setq mime-type
-	  (let ((default (gnus-mime-view-part-as-type-internal)))
-	    (gnus-completing-read
-	     "View as MIME type"
-	     (if pred
-		 (seq-filter pred (mailcap-mime-types))
-	       (mailcap-mime-types))
-	     nil nil nil
-	     (car default)))))
-  (gnus-article-check-buffer)
-  (let ((handle (get-text-property (point) 'gnus-data)))
-    (when handle
-      (when (equal (mm-handle-media-type handle) "message/external-body")
-	(unless (mm-handle-cache handle)
-	  (mm-extern-cache-contents handle))
-	(setq handle (mm-handle-cache handle)))
-      (setq handle
-	    (mm-make-handle (mm-handle-buffer handle)
-			    (cons mime-type (cdr (mm-handle-type handle)))
-			    (mm-handle-encoding handle)
-			    (mm-handle-undisplayer handle)
-			    (mm-handle-disposition handle)
-			    (mm-handle-description handle)
-			    nil
-			    (mm-handle-id handle)))
-      (setq gnus-article-mime-handles
-	    (mm-merge-handles gnus-article-mime-handles handle))
-      (when (mm-handle-displayed-p handle)
-	(mm-remove-part handle))
-      (gnus-mm-display-part handle))))
-
-(defun gnus-mime-copy-part (&optional handle arg)
+  (interactive (list nil nil last-nonmenu-event))
+  (save-excursion
+    (if event (mouse-set-point event))
+    (unless mime-type
+      (setq mime-type
+	    (let ((default (gnus-mime-view-part-as-type-internal)))
+	      (gnus-completing-read
+	       "View as MIME type"
+	       (if pred
+		   (seq-filter pred (mailcap-mime-types))
+		 (mailcap-mime-types))
+	       nil nil nil
+	       (car default)))))
+    (gnus-article-check-buffer)
+    (let ((handle (get-text-property (point) 'gnus-data)))
+      (when handle
+	(when (equal (mm-handle-media-type handle) "message/external-body")
+	  (unless (mm-handle-cache handle)
+	    (mm-extern-cache-contents handle))
+	  (setq handle (mm-handle-cache handle)))
+	(setq handle
+	      (mm-make-handle (mm-handle-buffer handle)
+			      (cons mime-type (cdr (mm-handle-type handle)))
+			      (mm-handle-encoding handle)
+			      (mm-handle-undisplayer handle)
+			      (mm-handle-disposition handle)
+			      (mm-handle-description handle)
+			      nil
+			      (mm-handle-id handle)))
+	(setq gnus-article-mime-handles
+	      (mm-merge-handles gnus-article-mime-handles handle))
+	(when (mm-handle-displayed-p handle)
+	  (mm-remove-part handle))
+	(gnus-mm-display-part handle)))))
+
+(defun gnus-mime-copy-part (&optional handle arg event)
   "Put the MIME part under point into a new buffer.
 If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
 are decompressed."
-  (interactive (list nil current-prefix-arg))
+  (interactive (list nil current-prefix-arg last-nonmenu-event))
+  (mouse-set-point event)
   (gnus-article-check-buffer)
   (unless handle
     (setq handle (get-text-property (point) 'gnus-data)))
@@ -5299,15 +5309,18 @@ are decompressed."
 	(setq buffer-file-name nil))
       (goto-char (point-min)))))
 
-(defun gnus-mime-print-part (&optional handle filename)
+(defun gnus-mime-print-part (&optional handle filename event)
   "Print the MIME part under point."
-  (interactive (list nil (ps-print-preprint current-prefix-arg)))
-  (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-	 (contents (and handle (mm-get-part handle)))
-	 (file (make-temp-file (expand-file-name "mm." mm-tmp-directory)))
-	 (printer (mailcap-mime-info (mm-handle-media-type handle) "print")))
-    (when contents
+  (interactive
+   (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
+  (save-excursion
+    (mouse-set-point event)
+    (gnus-article-check-buffer)
+    (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+	   (contents (and handle (mm-get-part handle)))
+	   (file (make-temp-file (expand-file-name "mm." mm-tmp-directory)))
+	   (printer (mailcap-mime-info (mm-handle-media-type handle) "print")))
+      (when contents
 	(if printer
 	    (unwind-protect
 		(progn
@@ -5322,12 +5335,13 @@ are decompressed."
 	  (with-temp-buffer
 	    (insert contents)
 	    (gnus-print-buffer))
-	  (ps-despool filename)))))
+	  (ps-despool filename))))))
 
-(defun gnus-mime-inline-part (&optional handle arg)
+(defun gnus-mime-inline-part (&optional handle arg event)
   "Insert the MIME part under point into the current buffer.
 Compressed files like .gz and .bz2 are decompressed."
-  (interactive (list nil current-prefix-arg))
+  (interactive (list nil current-prefix-arg last-nonmenu-event))
+  (if event (mouse-set-point event))
   (gnus-article-check-buffer)
   (let* ((inhibit-read-only t)
 	 (b (point))
@@ -5421,82 +5435,88 @@ CHARSET may either be a string or a symbol."
 	  (setcdr param charset)
 	(setcdr type (cons (cons 'charset charset) (cdr type)))))))
 
-(defun gnus-mime-view-part-as-charset (&optional handle arg)
+(defun gnus-mime-view-part-as-charset (&optional handle arg event)
   "Insert the MIME part under point into the current buffer using the
 specified charset."
-  (interactive (list nil current-prefix-arg))
-  (gnus-article-check-buffer)
-  (let ((handle (or handle (get-text-property (point) 'gnus-data)))
-	(fun (get-text-property (point) 'gnus-callback))
-	(gnus-newsgroup-ignored-charsets 'gnus-all)
-	charset form preferred parts)
-    (when handle
-      (when (prog1
-		(and fun
-		     (setq charset
-			   (or (cdr (assq
-				     arg
-				     gnus-summary-show-article-charset-alist))
-			       (read-coding-system "Charset: "))))
-	      (if (mm-handle-undisplayer handle)
-		  (mm-remove-part 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)))
-		   (setq preferred (caddr form))
-		   (progn
-		     (when (eq (car preferred) 'quote)
-		       (setq preferred (cadr preferred)))
-		     (not (equal preferred
-				 (get-text-property (point) 'gnus-data))))
-		   (setq parts (get-text-property (point) 'gnus-part))
-		   (setq parts (cdr (assq parts
-					  gnus-article-mime-handle-alist)))
-		   (equal (mm-handle-media-type parts) "multipart/alternative")
-		   (setq parts (reverse (cdr parts))))
-	  (setcar (cddr form)
-		  (list 'quote (or (cadr (member preferred parts))
-				   (car parts)))))
-	(funcall fun handle)))))
-
-(defun gnus-mime-view-part-externally (&optional handle)
-  "View the MIME part under point with an external viewer."
-  (interactive)
-  (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-	 (mm-inlined-types nil)
-	 (mail-parse-charset gnus-newsgroup-charset)
-	 (mail-parse-ignored-charsets
-          (with-current-buffer gnus-summary-buffer
-            gnus-newsgroup-ignored-charsets))
-         (type (mm-handle-media-type handle))
-         (method (mailcap-mime-info type))
-         (mm-enable-external t))
-    (if (not (stringp method))
-	(gnus-mime-view-part-as-type
-	 nil (lambda (type) (stringp (mailcap-mime-info type))))
+  (interactive (list nil current-prefix-arg last-nonmenu-event))
+  (save-excursion
+    (mouse-set-point event)
+    (gnus-article-check-buffer)
+    (let ((handle (or handle (get-text-property (point) 'gnus-data)))
+	  (fun (get-text-property (point) 'gnus-callback))
+	  (gnus-newsgroup-ignored-charsets 'gnus-all)
+	  charset form preferred parts)
       (when handle
-	(mm-display-part handle nil t)))))
-
-(defun gnus-mime-view-part-internally (&optional handle)
+	(when (prog1
+		  (and fun
+		       (setq charset
+			     (or (cdr (assq
+				       arg
+				       gnus-summary-show-article-charset-alist))
+				 (read-coding-system "Charset: "))))
+		(if (mm-handle-undisplayer handle)
+		    (mm-remove-part 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)))
+		     (setq preferred (caddr form))
+		     (progn
+		       (when (eq (car preferred) 'quote)
+		         (setq preferred (cadr preferred)))
+		       (not (equal preferred
+				   (get-text-property (point) 'gnus-data))))
+		     (setq parts (get-text-property (point) 'gnus-part))
+		     (setq parts (cdr (assq parts
+					    gnus-article-mime-handle-alist)))
+		     (equal (mm-handle-media-type parts) "multipart/alternative")
+		     (setq parts (reverse (cdr parts))))
+	    (setcar (cddr form)
+		    (list 'quote (or (cadr (member preferred parts))
+				     (car parts)))))
+	  (funcall fun handle))))))
+
+(defun gnus-mime-view-part-externally (&optional handle event)
+  "View the MIME part under point with an external viewer."
+  (interactive (list nil last-nonmenu-event))
+  (save-excursion
+    (mouse-set-point event)
+    (gnus-article-check-buffer)
+    (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+	   (mm-inlined-types nil)
+	   (mail-parse-charset gnus-newsgroup-charset)
+	   (mail-parse-ignored-charsets
+            (with-current-buffer gnus-summary-buffer
+              gnus-newsgroup-ignored-charsets))
+           (type (mm-handle-media-type handle))
+           (method (mailcap-mime-info type))
+           (mm-enable-external t))
+      (if (not (stringp method))
+	  (gnus-mime-view-part-as-type
+	   nil (lambda (type) (stringp (mailcap-mime-info type))))
+	(when handle
+	  (mm-display-part handle nil t))))))
+
+(defun gnus-mime-view-part-internally (&optional handle event)
   "View the MIME part under point with an internal viewer.
 If no internal viewer is available, use an external viewer."
-  (interactive)
-  (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-	 (mm-inlined-types '(".*"))
-	 (mm-inline-large-images t)
-	 (mail-parse-charset gnus-newsgroup-charset)
-	 (mail-parse-ignored-charsets
-	  (with-current-buffer gnus-summary-buffer
-	    gnus-newsgroup-ignored-charsets))
-	 (inhibit-read-only t))
-    (if (not (mm-inlinable-p handle))
-        (gnus-mime-view-part-as-type
-         nil (lambda (type) (mm-inlinable-p handle type)))
-      (when handle
-	(gnus-bind-mm-vars (mm-display-part handle nil t))))))
+  (interactive (list nil last-nonmenu-event))
+  (save-excursion
+    (mouse-set-point event)
+    (gnus-article-check-buffer)
+    (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+	   (mm-inlined-types '(".*"))
+	   (mm-inline-large-images t)
+	   (mail-parse-charset gnus-newsgroup-charset)
+	   (mail-parse-ignored-charsets
+	    (with-current-buffer gnus-summary-buffer
+	      gnus-newsgroup-ignored-charsets))
+	   (inhibit-read-only t))
+      (if (not (mm-inlinable-p handle))
+          (gnus-mime-view-part-as-type
+           nil (lambda (type) (mm-inlinable-p handle type)))
+        (when handle
+	  (gnus-bind-mm-vars (mm-display-part handle nil t)))))))
 
 (defun gnus-mime-action-on-part (&optional action)
   "Do something with the MIME attachment at (point)."
@@ -7866,15 +7886,16 @@ call it with the value of the `gnus-data' text property."
     (when fun
       (funcall fun data))))
 
-(defun gnus-article-press-button ()
+(defun gnus-article-press-button (&optional event)
   "Check text at point for a callback function.
 If the text at point has a `gnus-callback' property,
 call it with the value of the `gnus-data' text property."
-  (interactive)
-  (let ((data (get-text-property (point) 'gnus-data))
-	(fun (get-text-property (point) 'gnus-callback)))
-    (when fun
-      (funcall fun data))))
+  (interactive (list last-nonmenu-event))
+  (save-excursion
+    (mouse-set-point event)
+    (let ((fun (get-text-property (point) 'gnus-callback)))
+      (when fun
+        (funcall fun (get-text-property (point) 'gnus-data))))))
 
 (defun gnus-article-highlight (&optional force)
   "Highlight current article.