master a06f41a: Implement a screenshot command for Message mode

[Lars Ingebrigtsen]

branch: master
commit a06f41ad2ca786a70940297fd832a649196be9be
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Implement a screenshot command for Message mode
    
    * doc/misc/message.texi (MIME): Document it.
    
    * lisp/gnus/message.el (message-screenshot-command): New variable.
    (message-mode-map): New keystroke and menu item.  Also add
    mml-attach-file to the menu.
    (message-insert-screenshot): New command.
    
    * lisp/gnus/mml.el (mml-parse-1): Allow having
    content-transfer-encoding already in the part, so that we can have
    inline base64-encoded binaries in the Message buffers.
---
 doc/misc/message.texi | 12 ++++++++++++
 etc/NEWS              | 16 ++++++++++++----
 lisp/gnus/message.el  | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/gnus/mml.el      | 13 ++++++++++++-
 4 files changed, 89 insertions(+), 5 deletions(-)

diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index bdd31b1..7a66422 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -883,6 +883,18 @@ is a list, valid members are @code{type}, 
@code{description} and
 @code{nil}, don't ask for options.  If it is @code{t}, ask the user
 whether or not to specify options.
 
+@vindex message-screenshot-command
+@findex message-insert-screenshot
+@cindex screenshots
+@kindex C-c C-p
+If your system supports it, you can also insert screenshots directly
+into the Message buffer.  The @kbd{C-c C-p}
+(@code{message-insert-screenshot}) command inserts the image into the
+buffer as an @acronym{MML} part, and puts an image text property on
+top.  The @code{message-screenshot-command} variable says what
+external command to use to take the screenshot.  It defaults to
+@code{"import png:-"}, which is an ImageMagick command.
+
 You can also create arbitrarily complex multiparts using the @acronym{MML}
 language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME
 Manual}).
diff --git a/etc/NEWS b/etc/NEWS
index 670e97f..8c6e3e7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -228,6 +228,14 @@ The names of the commands 'gnus-slave', 
'gnus-slave-no-server' and
 *** The 'W Q' summary mode command now takes a numerical prefix to
 allow adjusting the fill width.
 
++++
+*** New variable 'mm-inline-font-lock'.
+This variable is supposed to be bound by callers to determine whether
+inline MIME parts (that support it) are supposed to be font-locked or
+not.
+
+** Message
+
 ---
 *** Change to default value of 'message-draft-headers' user option.
 The 'Date' symbol has been removed from the default value, meaning that
@@ -237,10 +245,10 @@ from when it is first saved or delayed, add the symbol 
'Date' back to
 this user option.
 
 +++
-*** New variable 'mm-inline-font-lock'.
-This variable is supposed to be bound by callers to determine whether
-inline MIME parts (that support it) are supposed to be font-locked or
-not.
+*** New command to take screenshots.
+In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot')
+command has been added.  It depends on using an external program to
+take the actual screenshot, and defaults to ImageMagick "import".
 
 ** Help
 
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index fb560f0..1453cbe 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -303,6 +303,13 @@ any confusion."
   :link '(custom-manual "(message)Message Headers")
   :type 'regexp)
 
+(defcustom message-screenshot-command '("import" "png:-")
+  "Command to take a screenshot.
+The command should insert a PNG in the current buffer."
+  :group 'message-various
+  :type '(list string)
+  :version "28.1")
+
 ;;; Start of variables adopted from `message-utils.el'.
 
 (defcustom message-subject-trailing-was-query t
@@ -2810,6 +2817,7 @@ systematically send encrypted emails when possible."
   (define-key message-mode-map [remap split-line]  'message-split-line)
 
   (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
+  (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot)
 
   (define-key message-mode-map "\C-a" 'message-beginning-of-line)
   (define-key message-mode-map "\t" 'message-tab)
@@ -2839,6 +2847,8 @@ systematically send encrypted emails when possible."
      :active (message-mark-active-p) :help "Mark region with enclosing tags"]
     ["Insert File Marked..." message-mark-insert-file
      :help "Insert file at point marked with enclosing tags"]
+    ["Attach File..." mml-attach-file t]
+    ["Insert Screenshot" message-insert-screenshot t]
     "----"
     ["Send Message" message-send-and-exit :help "Send this message"]
     ["Postpone Message" message-dont-send
@@ -8652,6 +8662,49 @@ Used in `message-simplify-recipients'."
                           (* 0.5 (- (nth 3 edges) (nth 1 edges)))))
             string)))))))
 
+(defun message-insert-screenshot (delay)
+  "Take a screenshot and insert in the current buffer.
+DELAY (the numeric prefix) says how many seconds to wait before
+starting the screenshotting process.
+
+The `message-screenshot-command' variable says what command is
+used to take the screenshot."
+  (interactive "p")
+  (unless (executable-find (car message-screenshot-command))
+    (error "Can't find %s to take the screenshot"
+          (car message-screenshot-command)))
+  (cl-decf delay)
+  (unless (zerop delay)
+    (dotimes (i delay)
+      (message "Sleeping %d second%s..."
+              (- delay i)
+              (if (= (- delay i) 1)
+                  ""
+                "s"))
+      (sleep-for 1)))
+  (message "Take screenshot")
+  (let ((image
+        (with-temp-buffer
+          (set-buffer-multibyte nil)
+          (apply #'call-process
+                 (car message-screenshot-command) nil (current-buffer) nil
+                 (cdr message-screenshot-command))
+          (buffer-string))))
+    (set-mark (point))
+    (insert-image
+     (create-image image 'png t
+                  :max-width (* (frame-pixel-width) 0.8)
+                  :max-height (* (frame-pixel-height) 0.8))
+     (format "<#part type=\"image/png\" disposition=inline 
content-transfer-encoding=base64 raw=t>\n%s\n<#/part>"
+            ;; Get a base64 version of the image.
+            (with-temp-buffer
+              (set-buffer-multibyte nil)
+              (insert image)
+              (base64-encode-region (point-min) (point-max) t)
+              (buffer-string))))
+    (insert "\n\n")
+    (message "")))
+
 (provide 'message)
 
 (run-hooks 'message-load-hook)
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 2149149..1d348f3 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -295,6 +295,17 @@ part.  This is for the internal use, you should never 
modify the value.")
                        (t
                         (mm-find-mime-charset-region point (point)
                                                      mm-hack-charsets))))
+       ;; We have a part that already has a transfer encoding.  Undo
+       ;; that so that we don't double-encode later.
+       (when (and raw
+                  (cdr (assq 'content-transfer-encoding tag)))
+         (with-temp-buffer
+           (set-buffer-multibyte nil)
+           (insert contents)
+           (mm-decode-content-transfer-encoding
+            (intern (cdr (assq 'content-transfer-encoding tag)))
+            (cdr (assq 'type tag)))
+           (setq contents (buffer-string))))
        (when (and (not raw) (memq nil charsets))
          (if (or (memq 'unknown-encoding mml-confirmation-set)
                  (message-options-get 'unknown-encoding)
@@ -313,8 +324,8 @@ Message contains characters with unknown encoding.  Really 
send? ")
                (eq 'mml (car tag))
                (< (length charsets) 2))
            (if (or (not no-markup-p)
+                   ;; Don't create blank parts.
                    (string-match "[^ \t\r\n]" contents))
-               ;; Don't create blank parts.
                (push (nconc tag (list (cons 'contents contents)))
                      struct))
          (let ((nstruct (mml-parse-singlepart-with-multiple-charsets