From a06f41ad2ca786a70940297fd832a649196be9be Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 5 Aug 2020 12:21:35 +0200 Subject: [PATCH] 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 bdd31b1fe49..7a66422b17e 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 670e97f52cb..8c6e3e78139 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 fb560f0eab8..1453cbe643e 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 21491499eb8..1d348f3a6f0 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 -- 2.39.2