;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2016 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
:type '(repeat regexp))
(defcustom message-deletable-headers '(Message-ID Date Lines)
- "Headers to be deleted if they already exist and were generated by message previously."
+ "Headers to delete if present and previously generated by message."
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
- :type 'sexp)
+ :type '(repeat (symbol :tag "Header")))
(defcustom message-ignored-news-headers
"^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:\\|^X-Gnus-Delayed:"
(defcustom message-archive-header "X-No-Archive: Yes\n"
"Header to insert when you don't want your article to be archived.
-Archives \(such as groups.google.com\) respect this header."
+Archives \(such as groups.google.com) respect this header."
:version "22.1"
:type 'string
:link '(custom-manual "(message)Header Commands")
newsgroup), in brackets followed by the subject
* `message-forward-subject-name-subject' Source of article (name of author
or newsgroup), in brackets followed by the subject
-* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended
+* `message-forward-subject-fwd' Subject of article with `Fwd:' prepended
to it."
:group 'message-forwarding
:link '(custom-manual "(message)Forwarding")
For e.g., if you wish to set the envelope sender address so that bounces
go to the right place or to deal with listserv's usage of that address, you
-might set this variable to '(\"-f\" \"you@some.where\")."
+might set this variable to (\"-f\" \"you@some.where\")."
:group 'message-sending
:link '(custom-manual "(message)Mail Variables")
:type '(choice (function)
%n The mail address, e.g. \"john.doe@example.invalid\".
%N The real name if present, e.g.: \"John Doe\", else fall
back to the mail address.
- %F The first name if present, e.g.: \"John\".
+ %F The first name if present, e.g.: \"John\", else fall
+ back to the mail address.
%L The last name if present, e.g.: \"Doe\".
%Z, %z The time zone in the numeric form, e.g.:\"+0000\".
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead."
:version "23.2"
- :type 'sexp
+ :type '(choice string (const :tag "Contents of signature file" t)
+ function
+ sexp)
+ :risky t
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
probably want to set this variable only for specific groups,
e.g. using `gnus-posting-styles':
- (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
+ (eval (set (make-local-variable \\='message-cite-reply-position) \\='above))"
:version "24.1"
:type '(choice (const :tag "Reply inline" traditional)
(const :tag "Reply above" above)
(defcustom message-cite-style nil
"*The overall style to be used when yanking cited text.
-Value is either `nil' (no variable overrides) or a let-style list
+Value is either nil (no variable overrides) or a let-style list
of pairs (VARIABLE VALUE) that will be bound in
`message-yank-original' to do the quoting.
message-cite-style-* variables. This variable is intended for
use in `gnus-posting-styles', such as:
- ((posting-from-work-p) (eval (set (make-local-variable 'message-cite-style) message-cite-style-outlook)))"
+ ((posting-from-work-p) (eval (set (make-local-variable \\='message-cite-style) message-cite-style-outlook)))"
:version "24.1"
:group 'message-insertion
:type '(choice (const :tag "Do not override variables" :value nil)
(defvar message-reply-headers nil
"The headers of the current replied article.
It is a vector of the following headers:
-\[number subject from date id references chars lines xref extra].")
+[number subject from date id references chars lines xref extra].")
(defvar message-newsreader nil)
(defvar message-mailer nil)
(defvar message-sent-message-via nil)
actually occur."
:group 'message-sending
:link '(custom-manual "(message)Mail Variables")
+ :risky t
:type 'sexp)
;;;###autoload
"Alist of ways to send outgoing messages.
Each element has the form
- \(TYPE PREDICATE FUNCTION)
+ (TYPE PREDICATE FUNCTION)
where TYPE is a symbol that names the method; PREDICATE is a function
called without any parameters to determine whether the message is
(let (mucs-ignore-version-incompatibilities)
(require 'un-define))
(error)))
- (condition-case nil (require 'idna) (file-error))
+ (condition-case nil
+ (require 'idna)
+ (file-error)
+ (invalid-operation))
idna-program
(executable-find idna-program)
(string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o")
;; "dead" nato bitnet uucp
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
- :version "22.1"
+ :version "25.1"
:group 'message-headers
:type 'regexp)
(unless (fboundp 'mail-dont-reply-to)
(defalias 'mail-dont-reply-to 'rmail-dont-reply-to))
+(eval-and-compile
+ (if (featurep 'emacs)
+ (progn
+ (defun message-kill-all-overlays ()
+ (mapcar #'delete-overlay (overlays-in (point-min) (point-max))))
+ (defalias 'message-window-inside-pixel-edges
+ 'window-inside-pixel-edges))
+ (defun message-kill-all-overlays ()
+ (map-extents (lambda (extent ignore) (delete-extent extent))))
+ (defalias 'message-window-inside-pixel-edges 'ignore)))
+
\f
;;;
(unless cs-coding
(setq cs-coding
(mm-read-coding-system
- (format "\
+ (gnus-format-message "\
Decoded Subject \"%s\"
contains an encoded word. The charset `%s' is unknown or invalid.
Hit RET to replace non-decodable characters with \"%s\" or enter replacement
nil nil '("poster" . 0)
(if (boundp 'gnus-group-history)
'gnus-group-history))))
+ (when (fboundp 'gnus-group-real-name)
+ (setq target-group (gnus-group-real-name target-group)))
(cond ((not (or (null target-group) ; new subject not empty
(zerop (string-width target-group))
(string-match "^[ \t]*$" target-group)))
(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
+(defvar message-smileys '(":-)" ":)"
+ ":-(" ":("
+ ";-)" ";)")
+ "A list of recognized smiley faces in `message-mode'.")
+
+(defun message--syntax-propertize (beg end)
+ "Syntax-propertize certain message text specially."
+ (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$"))
+ (smiley-regexp (regexp-opt message-smileys)))
+ (goto-char beg)
+ (while (search-forward-regexp citation-regexp
+ end 'noerror)
+ (let ((start (match-beginning 0))
+ (end (match-end 0)))
+ (add-text-properties start (1+ start)
+ `(syntax-table ,(string-to-syntax "<")))
+ (add-text-properties end (min (1+ end) (point-max))
+ `(syntax-table ,(string-to-syntax ">")))))
+ (goto-char beg)
+ (while (search-forward-regexp smiley-regexp
+ end 'noerror)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ `(syntax-table ,(string-to-syntax "."))))))
+
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
"Major mode for editing mail and news to be sent.
;; multibyte is not necessary at all. -- zsh
(mm-enable-multibyte))
(set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
- (mml-mode))
+ (mml-mode)
+ ;; Syntactic fontification. Helps `show-paren-mode',
+ ;; `electric-pair-mode', and C-M-* navigation by syntactically
+ ;; excluding citations and other artifacts.
+ ;;
+ (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t))
(defun message-setup-fill-variables ()
"Setup message fill variables."
"Cite function in the standard Message manner."
(message-cite-original-1 nil))
-(defvar gnus-extract-address-components)
-
(autoload 'format-spec "format-spec")
(autoload 'gnus-date-get-time "gnus-util")
(unless from
(setq from (mail-header-from message-reply-headers)))
(let* ((data (condition-case ()
- (funcall (if (boundp gnus-extract-address-components)
+ (funcall (if (boundp 'gnus-extract-address-components)
gnus-extract-address-components
'mail-extract-address-components)
from)
(setq fname lname lname newlname)))))
;; The following letters are not used in `format-time-string':
(push ?E lst) (push "<E>" lst)
- (push ?F lst) (push fname lst)
+ (push ?F lst) (push (or fname name-or-net) lst)
;; We might want to use "" instead of "<X>" later.
(push ?J lst) (push "<J>" lst)
(push ?K lst) (push "<K>" lst)
(if message-return-action
(apply (car message-return-action) (cdr message-return-action))))
+(autoload 'mml-secure-bcc-is-safe "mml-sec")
+
(defun message-send (&optional arg)
"Send the message in the current buffer.
If `message-interactive' is non-nil, wait for success indication or
(let ((inhibit-read-only t))
(put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
+ (mml-secure-bcc-is-safe)
(run-hooks 'message-send-hook)
(when message-confirm-send
(or (y-or-n-p "Send message? ")
to (cdar regions)
regions (cdr regions))
(put-text-property from to 'invisible nil)
- (message-overlay-put (message-make-overlay from to)
- 'face 'highlight))
+ (overlay-put (make-overlay from to) 'face 'highlight))
(unless (yes-or-no-p
"Invisible text found and made visible; continue sending? ")
(error "Invisible text found and made visible")))))
control-1))
(not (get-text-property
(point) 'untranslated-utf-8))))
- (message-overlay-put (message-make-overlay (point) (1+ (point)))
- 'face 'highlight)
+ (overlay-put (make-overlay (point) (1+ (point))) 'face 'highlight)
(setq found t))
(forward-char))
(when found
(dolist (bog (message-bogus-recipient-p addr))
(and bog
(not (y-or-n-p
- (format
+ (gnus-format-message
"Address `%s'%s might be bogus. Continue? "
bog
;; If the encoded version of the email address
It is useful if your ISP requires the POP-before-SMTP
authentication. See the Gnus manual for details."
(run-hooks 'message-send-mail-hook)
+ ;; Change header-delimiter to be what smtpmail expects.
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n"))
(smtpmail-send-it))
(defun message-send-mail-with-mailclient ()
(defun message-is-yours-p ()
"Non-nil means current article is yours.
-If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
+If you have added `cancel-messages' to `message-shoot-gnksa-feet', all articles
are yours except those that have Cancel-Lock header not belonging to you.
Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
regexp to match all of yours addresses."
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)))))
-(defalias 'message-make-overlay 'make-overlay)
-(defalias 'message-delete-overlay 'delete-overlay)
-(defalias 'message-overlay-put 'overlay-put)
-(defun message-kill-all-overlays ()
- (if (featurep 'xemacs)
- (map-extents (lambda (extent ignore) (delete-extent extent)))
- (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))))
-
;; Support for toolbar
(defvar tool-bar-mode)
(defun message-flatten-list (list)
"Return a new, flat list that contains all elements of LIST.
-\(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
+\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7))
=> (1 2 3 4 5 6 7)"
(cond ((consp list)
(apply 'append (mapcar 'message-flatten-list list)))
(list message-hidden-headers)
message-hidden-headers))
(inhibit-point-motion-hooks t)
- (after-change-functions nil)
+ (inhibit-modification-hooks t)
(end-of-headers (point-min)))
(when regexps
(save-excursion
(when force
(sit-for message-send-form-letter-delay))
(if (or force
- (y-or-n-p (format "Send message to `%s'? " to)))
+ (y-or-n-p (gnus-format-message "Send message to `%s'? " to)))
(progn
(setq sent (1+ sent))
(message-send-and-exit))
- (message (format "Message to `%s' skipped." to))
+ (message "Message to `%s' skipped." to)
(setq skipped (1+ skipped)))
(when (buffer-live-p buff)
(kill-buffer buff))))
;;; multipart/related and HTML support.
(defun message-make-html-message-with-image-files (files)
+ "Make a message containing the current dired-marked image files."
(interactive (list (dired-get-marked-files nil current-prefix-arg)))
(message-mail)
(message-goto-body)
(insert "<#part type=text/html>\n\n")
(dolist (file files)
(insert (format "<img src=%S>\n\n" file)))
+ (message-toggle-image-thumbnails)
(message-goto-to))
+(defun message-toggle-image-thumbnails ()
+ "For any included image files, insert a thumbnail of that image."
+ (interactive)
+ (let ((overlays (overlays-in (point-min) (point-max)))
+ (displayed nil))
+ (while overlays
+ (let ((overlay (car overlays)))
+ (when (overlay-get overlay 'put-image)
+ (delete-overlay overlay)
+ (setq displayed t)))
+ (setq overlays (cdr overlays)))
+ (unless displayed
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t)
+ (let ((file (match-string 1))
+ (edges (message-window-inside-pixel-edges
+ (get-buffer-window (current-buffer)))))
+ (put-image
+ (create-image
+ file 'imagemagick nil
+ :max-width (truncate
+ (* 0.7 (- (nth 2 edges) (nth 0 edges))))
+ :max-height (truncate
+ (* 0.5 (- (nth 3 edges) (nth 1 edges)))))
+ (match-beginning 0)
+ " ")))))))
+
(when (featurep 'xemacs)
(require 'messagexmas)
(message-xmas-redefine))