diff options
Diffstat (limited to 'lisp/gnus/message.el')
| -rw-r--r-- | lisp/gnus/message.el | 247 |
1 files changed, 131 insertions, 116 deletions
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index bff1b2a60d9..c2d14296f94 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -48,6 +48,8 @@ (require 'puny) (require 'rmc) ; read-multiple-choice (require 'subr-x) +(require 'yank-media) +(require 'mailcap) (autoload 'mailclient-send-it "mailclient") @@ -2395,6 +2397,8 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." (save-excursion ;; add to the end of the region first, otherwise end would be invalid (goto-char end) + (unless (bolp) + (insert "\n")) (insert (if verbatim "#v-\n" message-mark-insert-end)) (goto-char beg) (insert (if verbatim "#v+\n" message-mark-insert-begin)))) @@ -2868,84 +2872,78 @@ Consider adding this function to `message-header-setup-hook'" ;;; Set up keymap. -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (make-keymap)) - (set-keymap-parent message-mode-map text-mode-map) - (define-key message-mode-map "\C-c?" #'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from) - (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary) - (define-key message-mode-map "\C-c\C-f\C-i" - #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\C-f\C-a" - #'message-generate-unsubscribed-mail-followup-to) +(defvar-keymap message-mode-map + :full t :parent text-mode-map + :doc "Message Mode keymap." + "C-c ?" #'describe-mode + + "C-c C-f C-t" #'message-goto-to + "C-c C-f C-o" #'message-goto-from + "C-c C-f C-b" #'message-goto-bcc + "C-c C-f C-w" #'message-goto-fcc + "C-c C-f C-c" #'message-goto-cc + "C-c C-f C-s" #'message-goto-subject + "C-c C-f C-r" #'message-goto-reply-to + "C-c C-f C-n" #'message-goto-newsgroups + "C-c C-f C-d" #'message-goto-distribution + "C-c C-f C-f" #'message-goto-followup-to + "C-c C-f C-m" #'message-goto-mail-followup-to + "C-c C-f C-k" #'message-goto-keywords + "C-c C-f C-u" #'message-goto-summary + "C-c C-f C-i" #'message-insert-or-toggle-importance + "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to ;; modify headers (and insert notes in body) - (define-key message-mode-map "\C-c\C-fs" #'message-change-subject) + "C-c C-f s" #'message-change-subject ;; - (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to) + "C-c C-f x" #'message-cross-post-followup-to ;; prefix+message-cross-post-followup-to = same w/o cross-post - (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc) - (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header) + "C-c C-f t" #'message-reduce-to-to-cc + "C-c C-f a" #'message-add-archive-header ;; mark inserted text - (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region) - (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file) - - (define-key message-mode-map "\C-c\C-b" #'message-goto-body) - (define-key message-mode-map "\C-c\C-i" #'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" #'message-insert-to) - (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply) - (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups) - (define-key message-mode-map "\C-c\C-l" #'message-to-list-only) - (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires) - - (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\M-n" - #'message-insert-disposition-notification-to) - - (define-key message-mode-map "\C-c\C-y" #'message-yank-original) - (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer) - (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" #'message-insert-signature) - (define-key message-mode-map "\C-c\M-h" #'message-insert-headers) - (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" #'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" #'message-send) - (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" #'message-dont-send) - (define-key message-mode-map "\C-c\n" #'gnus-delay-article) - - (define-key message-mode-map "\C-c\M-k" #'message-kill-address) - (define-key message-mode-map "\C-c\C-e" #'message-elide-region) - (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region) - (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature) - (define-key message-mode-map "\M-\r" #'message-newline-and-reformat) - (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) - - (define-key message-mode-map "\M-n" #'message-display-abbrev)) + "C-c M-m" #'message-mark-inserted-region + "C-c M-f" #'message-mark-insert-file + + "C-c C-b" #'message-goto-body + "C-c C-i" #'message-goto-signature + + "C-c C-t" #'message-insert-to + "C-c C-f w" #'message-insert-wide-reply + "C-c C-n" #'message-insert-newsgroups + "C-c C-l" #'message-to-list-only + "C-c C-f C-e" #'message-insert-expires + "C-c C-u" #'message-insert-or-toggle-importance + "C-c M-n" #'message-insert-disposition-notification-to + + "C-c C-y" #'message-yank-original + "C-c C-M-y" #'message-yank-buffer + "C-c C-q" #'message-fill-yanked-message + "C-c C-w" #'message-insert-signature + "C-c M-h" #'message-insert-headers + "C-c C-r" #'message-caesar-buffer-body + "C-c C-o" #'message-sort-headers + "C-c M-r" #'message-rename-buffer + + "C-c C-c" #'message-send-and-exit + "C-c C-s" #'message-send + "C-c C-k" #'message-kill-buffer + "C-c C-d" #'message-dont-send + "C-c C-j" #'gnus-delay-article + + "C-c M-k" #'message-kill-address + "C-c C-e" #'message-elide-region + "C-c C-v" #'message-delete-not-region + "C-c C-z" #'message-kill-to-signature + "M-RET" #'message-newline-and-reformat + "<remap> <split-line>" #'message-split-line + + "C-c C-a" #'mml-attach-file + "C-c C-p" #'message-insert-screenshot + + "C-a" #'message-beginning-of-line + "TAB" #'message-tab + + "M-n" #'message-display-abbrev) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -3159,6 +3157,7 @@ Like `text-mode', but with these additional commands: (setq-local message-checksum nil) (setq-local message-mime-part 0) (message-setup-fill-variables) + (yank-media-handler "image/.*" #'message--yank-media-image-handler) (when message-fill-column (setq fill-column message-fill-column) (turn-on-auto-fill)) @@ -3572,8 +3571,18 @@ Prefix arg means justify as well." (when (looking-at message-cite-prefix-regexp) (setq quoted (match-string 0)) (goto-char (match-end 0)) - (looking-at "[ \t]*") - (setq leading-space (match-string 0))) + (let ((after (point))) + ;; This is a line with no text after the cite prefix. In that + ;; case, the trailing space is commonly not present, so look + ;; around for other lines that have some data. + (when (looking-at-p "\n") + (let ((regexp (concat "^" message-cite-prefix-regexp "[ \t]"))) + (when (or (re-search-backward regexp nil t) + (re-search-forward regexp nil t)) + (goto-char (1- (match-end 0)))))) + (looking-at "[ \t]*") + (setq leading-space (match-string 0)) + (goto-char after))) (if (and quoted (not not-break) (not bolp) @@ -3590,7 +3599,7 @@ Prefix arg means justify as well." (equal quoted (match-string 0))) (goto-char (match-end 0)) (looking-at "[ \t]*") - (when (< (length leading-space) (length (match-string 0))) + (when (> (length leading-space) (length (match-string 0))) (setq leading-space (match-string 0))) (forward-line 1)) (setq end (point)) @@ -3841,7 +3850,7 @@ text was killed." "Caesar rotate all letters in the current buffer by 13 places. Used to encode/decode possibly offensive messages (commonly in rec.humor). With prefix arg, specifies the number of places to rotate each letter forward. -Mail and USENET news headers are not rotated unless WIDE is non-nil." +Mail and Usenet news headers are not rotated unless WIDE is non-nil." (interactive (if current-prefix-arg (list (prefix-numeric-value current-prefix-arg)) (list nil)) @@ -4754,23 +4763,25 @@ Valid types are `send', `return', `exit', `kill' and `postpone'." t "\ The message size, " - (/ (buffer-size) 1000) "KB, is too large. + (/ (buffer-size) 1000) + (substitute-command-keys "KB, is too large. Some mail gateways (MTA's) bounce large messages. To avoid the -problem, answer `y', and the message will be split into several -smaller pieces, the size of each is about " +problem, answer \\`y', and the message will be split into several +smaller pieces, the size of each is about ") (/ message-send-mail-partially-limit 1000) - "KB except the last + (substitute-command-keys + "KB except the last one. However, some mail readers (MUA's) can't read split messages, i.e., -mails in message/partially format. Answer `n', and the message +mails in message/partially format. Answer \\`n', and the message will be sent in one piece. The size limit is controlled by `message-send-mail-partially-limit'. If you always want Gnus to send messages in one piece, set `message-send-mail-partially-limit' to nil. -"))) +")))) (progn (message "Sending via mail...") (if message-send-mail-real-function @@ -5346,7 +5357,7 @@ Otherwise, generate and save a value for `canlock-password' first." (zerop (length (setq to (completing-read - "Followups to (default no Followup-To header): " + (format-prompt "Followups to" "no Followup-To header") (mapcar #'list (cons "poster" (message-tokenize-header @@ -5817,15 +5828,15 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; You might for example insert a "." somewhere (not next to another dot ;; or string boundary), or modify the "fsf" string. (defun message-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. + ;; Don't use fractional seconds from timestamp; they may be unsupported. ;; Instead we use this randomly inited counter. (setq message-unique-id-char - (% (1+ (or message-unique-id-char - (random (ash 1 20)))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) + ;; 2^16 * 25 just fits into 4 digits i base 36. + (let ((base (* 25 25))) + (if message-unique-id-char + (% (1+ message-unique-id-char) base) + (random base)))) + (let ((tm (time-convert nil 'integer))) (concat (if (or (eq system-type 'ms-dos) ;; message-number-base36 doesn't handle bigints. @@ -5835,10 +5846,12 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) - (ash (% message-unique-id-char 25) 16)) 4) - (message-number-base36 (+ (nth 1 tm) - (ash (/ message-unique-id-char 25) 16)) 4) + (message-number-base36 (+ (ash tm -16) + (ash (% message-unique-id-char 25) 16)) + 4) + (message-number-base36 (+ (logand tm #xffff) + (ash (/ message-unique-id-char 25) 16)) + 4) ;; Append a given name, because while the generated ID is unique ;; to this newsreader, other newsreaders might otherwise generate ;; the same ID via another algorithm. @@ -5935,12 +5948,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (defun message-make-expires () "Return an Expires header based on `message-expires'." - (let ((current (current-time)) - (future (* 1.0 message-expires 60 60 24))) + (let ((future (* 60 60 24 message-expires))) ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - (message-make-date current))) + (message-make-date (time-add nil future)))) (defun message-make-path () "Return uucp path." @@ -8867,24 +8877,29 @@ used to take the screenshot." (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 (truncate (* (frame-pixel-width) 0.8)) - :max-height (truncate (* (frame-pixel-height) 0.8)) - :scale 1) - (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" - ;; Get a base64 version of the image -- this avoids later - ;; complications if we're auto-saving the buffer and - ;; restoring from a file. - (with-temp-buffer - (set-buffer-multibyte nil) - (insert image) - (base64-encode-region (point-min) (point-max) t) - (buffer-string)))) - (insert "\n\n") + (message--yank-media-image-handler 'image/png image) (message ""))) +(defun message--yank-media-image-handler (type image) + (set-mark (point)) + (insert-image + (create-image image (mailcap-mime-type-to-extension type) t + :max-width (truncate (* (frame-pixel-width) 0.8)) + :max-height (truncate (* (frame-pixel-height) 0.8)) + :scale 1) + (format "<#part type=\"%s\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" + type + ;; Get a base64 version of the image -- this avoids later + ;; complications if we're auto-saving the buffer and + ;; restoring from a file. + (with-temp-buffer + (set-buffer-multibyte nil) + (insert image) + (base64-encode-region (point-min) (point-max) t) + (buffer-string))) + nil nil t) + (insert "\n\n")) + (declare-function gnus-url-unhex-string "gnus-util") (defun message-parse-mailto-url (url) |