;;; 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
;; This is apparently necessary even though things are autoloaded.
;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
;; require mailabbrev here.
-(if (featurep 'xemacs)
- (require 'mail-abbrevs)
- (require 'mailabbrev))
+(require 'mailabbrev)
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
(require 'format-spec)
(require 'dired)
+(require 'mm-util)
+(require 'rfc2047)
+(require 'puny)
-(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
+(autoload 'mailclient-send-it "mailclient")
(defvar gnus-message-group-art)
(defvar gnus-list-identifiers) ; gnus-sum is required where necessary
: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:"
regexp))
(defcustom message-subject-re-regexp
- "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
+ "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)* ?:[ \t]*\\)*[ \t]*"
"*Regexp matching \"Re: \" in the subject line."
:group 'message-various
:link '(custom-manual "(message)Message Headers")
(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)
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)
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)
(if (and (boundp 'mail-archive-file-name)
(stringp mail-archive-file-name))
(format "FCC: %s\n" mail-archive-file-name))
- ;; Use the value of `mail-default-headers' if available.
- ;; Note: as for XEmacs 21.4 and 21.5, it is unavailable
- ;; unless sendmail.el is loaded.
- (if (boundp 'mail-default-headers)
- mail-default-headers))
+ mail-default-headers)
"*A string of header lines to be inserted in outgoing mails."
:version "23.2"
:group 'message-headers
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
:link '(custom-manual "(message)Various Message Variables")
:type '(choice directory (const :tag "Don't auto-save" nil)))
-(defcustom message-default-charset
- (and (not (mm-multibyte-p)) 'iso-8859-1)
+(defcustom message-default-charset (and (not (mm-multibyte-p)) 'iso-8859-1)
"Default charset used in non-MULE Emacsen.
If nil, you might be asked to input the charset."
:version "21.1"
:group 'message
:link '(custom-manual "(message)Various Message Variables")
:type 'symbol)
+(make-obsolete-variable
+ 'message-default-charset
+ "The default charset comes from the language environment" "25.2")
+
+(defcustom message-dont-reply-to-names mail-dont-reply-to-names
+ "Addresses to prune when doing wide replies.
+This can be a regexp, a list of regexps or a predicate function.
+Also, a value of nil means exclude your own user name only.
-(defcustom message-dont-reply-to-names
- (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names)
- "*Addresses to prune when doing wide replies.
-This can be a regexp or a list of regexps. Also, a value of nil means
-exclude your own user name only."
+If a function email is passed as the argument."
:version "24.3"
:group 'message
:link '(custom-manual "(message)Wide Reply")
(repeat :tag "Regexp List" regexp)))
(defsubst message-dont-reply-to-names ()
- (gmm-regexp-concat message-dont-reply-to-names))
+ (if (functionp message-dont-reply-to-names)
+ message-dont-reply-to-names
+ (gmm-regexp-concat message-dont-reply-to-names)))
(defvar message-shoot-gnksa-feet nil
"*A list of GNKSA feet you are allowed to shoot.
(0 'message-mml))))
"Additional expressions to highlight in Message mode.")
-
-;; XEmacs does it like this. For Emacs, we have to set the
-;; `font-lock-defaults' buffer-local variable.
-(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
-
(defvar message-face-alist
'((bold . message-bold-region)
(underline . underline-region)
(defvar message-send-coding-system 'binary
"Coding system to encode outgoing mail.")
-(defvar message-draft-coding-system
- mm-auto-save-coding-system
- "*Coding system to compose mail.
-If you'd like to make it possible to share draft files between XEmacs
-and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
-Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
+(defvar message-draft-coding-system mm-auto-save-coding-system
+ "Coding system to compose mail.")
(defcustom message-send-mail-partially-limit nil
"The limitation of messages sent as message/partial.
(integer 1000000)))
(defcustom message-alternative-emails nil
- "*Regexp matching alternative email addresses.
+ "*Regexp or predicate function matching alternative email addresses.
The first address in the To, Cc or From headers of the original
article matching this variable is used as the From field of
outgoing messages.
+If a function, an email string is passed as the argument.
+
This variable has precedence over posting styles and anything that runs
off `message-setup-hook'."
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "Always use primary" nil)
- regexp))
+ regexp
+ function))
(defcustom message-hierarchical-addresses nil
"A list of hierarchical mail address definitions.
:type '(radio (const :format "%v " nil)
(string :format "FQDN: %v")))
-(defcustom message-use-idna
- (and (or (mm-coding-system-p 'utf-8)
- (condition-case nil
- (let (mucs-ignore-version-incompatibilities)
- (require 'un-define))
- (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")
- t)
- "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
-GNU Libidn, and in particular the elisp package \"idna.el\" and
-the external program \"idn\", must be installed for this
-functionality to work."
- :version "22.1"
+(defcustom message-use-idna t
+ "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
+ :version "25.2"
:group 'message-headers
:link '(custom-manual "(message)IDNA")
:type '(choice (const :tag "Ask" ask)
(defvar message-options nil
"Some saved answers when sending message.")
-;; FIXME: On XEmacs this causes problems since let-binding like:
-;; (let ((message-options message-options)) ...)
-;; as in `message-send' and `mml-preview' loses to buffer-local
-;; variable initialization.
-(unless (featurep 'xemacs)
- (make-variable-buffer-local 'message-options))
+(make-variable-buffer-local 'message-options)
(defvar message-send-mail-real-function nil
"Internal send mail function.")
(defvar message-bogus-system-names "\\`localhost\\.\\|\\.local\\'"
"The regexp of bogus system names.")
-(defcustom message-valid-fqdn-regexp
- (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
- ;; valid TLDs:
- "\\([a-z][a-z]\\|" ;; two letter country TDLs
- "aero\\|arpa\\|asia\\|bitnet\\|biz\\|bofh\\|"
- "cat\\|com\\|coop\\|edu\\|gov\\|"
- "info\\|int\\|jobs\\|"
- "mil\\|mobi\\|museum\\|name\\|net\\|"
- "org\\|pro\\|tel\\|travel\\|uucp\\|"
- ;; ICANN-era generic top-level domains
- "academy\\|actor\\|agency\\|airforce\\|archi\\|associates\\|axa\\|"
- "bar\\|bargains\\|bayern\\|beer\\|berlin\\|best\\|bid\\|bike\\|"
- "biz\\|black\\|blackfriday\\|blue\\|boutique\\|build\\|builders\\|"
- "buzz\\|cab\\|camera\\|camp\\|capital\\|cards\\|care\\|career\\|"
- "careers\\|cash\\|catering\\|center\\|ceo\\|cheap\\|christmas\\|"
- "church\\|citic\\|cleaning\\|clinic\\|clothing\\|club\\|codes\\|"
- "coffee\\|college\\|cologne\\|com\\|community\\|company\\|computer\\|"
- "construction\\|contractors\\|cooking\\|cool\\|country\\|creditcard\\|"
- "cruises\\|dance\\|dating\\|democrat\\|dental\\|desi\\|design\\|"
- "diamonds\\|directory\\|discount\\|domains\\|education\\|email\\|"
- "engineering\\|enterprises\\|equipment\\|estate\\|eus\\|events\\|"
- "exchange\\|expert\\|exposed\\|fail\\|farm\\|feedback\\|finance\\|"
- "financial\\|fish\\|fishing\\|fitness\\|flights\\|florist\\|foo\\|"
- "foundation\\|frogans\\|fund\\|furniture\\|futbol\\|gal\\|"
- "gallery\\|gift\\|glass\\|globo\\|gmo\\|gop\\|graphics\\|gratis\\|"
- "gripe\\|guide\\|guitars\\|guru\\|hamburg\\|haus\\|hiphop\\|"
- "holdings\\|holiday\\|homes\\|horse\\|house\\|immobilien\\|"
- "industries\\|info\\|ink\\|institute\\|insure\\|international\\|"
- "investments\\|jetzt\\|juegos\\|kaufen\\|kim\\|kitchen\\|kiwi\\|"
- "koeln\\|kred\\|land\\|lat\\|latino\\|lease\\|life\\|lighting\\|"
- "limited\\|limo\\|link\\|loans\\|london\\|luxe\\|luxury\\|"
- "management\\|mango\\|marketing\\|media\\|meet\\|menu\\|miami\\|"
- "moda\\|moe\\|monash\\|moscow\\|motorcycles\\|nagoya\\|name\\|"
- "net\\|neustar\\|ninja\\|nyc\\|okinawa\\|onl\\|org\\|paris\\|"
- "partners\\|parts\\|photo\\|photography\\|photos\\|pics\\|"
- "pictures\\|pink\\|plumbing\\|pro\\|productions\\|properties\\|"
- "pub\\|qpon\\|quebec\\|recipes\\|red\\|reisen\\|ren\\|rentals\\|"
- "repair\\|report\\|rest\\|reviews\\|rich\\|rocks\\|rodeo\\|"
- "ruhr\\|ryukyu\\|saarland\\|schule\\|scot\\|services\\|sexy\\|"
- "shiksha\\|shoes\\|singles\\|social\\|sohu\\|solar\\|solutions\\|"
- "soy\\|supplies\\|supply\\|support\\|surgery\\|systems\\|tattoo\\|"
- "tax\\|technology\\|tienda\\|tips\\|today\\|tokyo\\|tools\\|"
- "town\\|toys\\|trade\\|training\\|university\\|uno\\|vacations\\|"
- "vegas\\|ventures\\|viajes\\|villas\\|vision\\|vodka\\|vote\\|"
- "voting\\|voto\\|voyage\\|wang\\|watch\\|webcam\\|wed\\|wien\\|"
- "wiki\\|works\\|wtc\\|wtf\\|xyz\\|yachts\\|yokohama\\|you\\|"
- "zone\\)")
- ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
- ;; http://en.wikipedia.org/wiki/GTLD
- ;; `approved, but not yet in operation': .xxx
- ;; "dead" nato bitnet uucp
- "Regular expression that matches a valid FQDN."
- ;; see also: gnus-button-valid-fqdn-regexp
- :version "25.1"
- :group 'message-headers
- :type 'regexp)
-
(autoload 'gnus-alive-p "gnus-util")
(autoload 'gnus-delay-article "gnus-delay")
(autoload 'gnus-extract-address-components "gnus-util")
(autoload 'gnus-group-name-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
-(autoload 'gnus-make-local-hook "gnus-util")
(autoload 'gnus-open-server "gnus-int")
(autoload 'gnus-output-to-mail "gnus-util")
(autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'gnus-request-post "gnus-int")
-(autoload 'gnus-select-frame-set-input-focus "gnus-util")
(autoload 'gnus-server-string "gnus")
-(autoload 'idna-to-ascii "idna")
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
(autoload 'rmail-msg-is-pruned "rmail")
(autoload 'rmail-output "rmailout")
-;; Emacs < 24.1 do not have mail-dont-reply-to
-(unless (fboundp 'mail-dont-reply-to)
- (defalias 'mail-dont-reply-to 'rmail-dont-reply-to))
-
-(eval-and-compile
- (if (featurep 'emacs)
- (progn
- (defalias 'message-delete-overlay 'delete-overlay)
- (defun message-kill-all-overlays ()
- (mapcar #'delete-overlay (overlays-in (point-min) (point-max))))
- (defalias 'message-make-overlay 'make-overlay)
- (defalias 'message-overlay-get 'overlay-get)
- (defalias 'message-overlay-put 'overlay-put)
- (defalias 'message-overlays-in 'overlays-in)
- (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)))
+(defun message-kill-all-overlays ()
+ (mapcar #'delete-overlay (overlays-in (point-min) (point-max))))
\f
;; No double encoded subject? => bogus charset.
(unless cs-coding
(setq cs-coding
- (mm-read-coding-system
- (format "\
+ (read-coding-system
+ (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
"Remove trailing \"(was: <old subject>)\" from SUBJECT lines.
Leading \"Re: \" is not stripped by this function. Use the function
`message-strip-subject-re' for this."
- (let* ((query message-subject-trailing-was-query)
- (new) (found))
- (setq found
- (string-match
- (if (eq query 'ask)
- message-subject-trailing-was-ask-regexp
- message-subject-trailing-was-regexp)
- subject))
- (if found
- (setq new (substring subject 0 (match-beginning 0))))
- (if (or (not found) (eq query nil))
- subject
- (if (eq query 'ask)
- (if (message-y-or-n-p
- "Strip `(was: <old subject>)' in subject? " t
- (concat
- "Strip `(was: <old subject>)' in subject "
- "and use the new one instead?\n\n"
- "Current subject is: \""
- subject "\"\n\n"
- "New subject would be: \""
- new "\"\n\n"
- "See the variable `message-subject-trailing-was-query' "
- "to get rid of this query."
- ))
- new subject)
- new))))
+ (or
+ (let ((query message-subject-trailing-was-query) new)
+ (and query
+ (string-match (if (eq query 'ask)
+ message-subject-trailing-was-ask-regexp
+ message-subject-trailing-was-regexp)
+ subject)
+ (setq new (substring subject 0 (match-beginning 0)))
+ (or (not (eq query 'ask))
+ (message-y-or-n-p
+ "Strip `(was: <old subject>)' in subject? " t
+ (concat
+ "Strip `(was: <old subject>)' in subject "
+ "and use the new one instead?\n\n"
+ "Current subject is: \"" subject "\"\n\n"
+ "New subject would be: \"" new "\"\n\n"
+ "See the variable `message-subject-trailing-was-query' "
+ "to get rid of this query.")))
+ new))
+ subject))
;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
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)))
manual. With two \\[universal-argument]'s, display the EasyPG or
PGG manual, depending on the value of `mml2015-use'."
(interactive "p")
- ;; Don't use `info' because support for `(filename)nodename' is not
- ;; available in XEmacs < 21.5.12.
- (Info-goto-node (format "(%s)Top"
- (cond ((eq arg 16)
- (require 'mml2015)
- mml2015-use)
- ((eq arg 4) 'emacs-mime)
- ;; `booleanp' only available in Emacs 22+
- ((and (not (memq arg '(nil t)))
- (symbolp arg))
- arg)
- (t
- 'message)))))
+ (info (format "(%s)Top"
+ (cond ((eq arg 16)
+ (require 'mml2015)
+ mml2015-use)
+ ((eq arg 4) 'emacs-mime)
+ ((and (not (booleanp arg))
+ (symbolp arg))
+ arg)
+ (t
+ 'message)))))
\f
["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
["Elide Region" message-elide-region
:active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Replace text in region with an ellipsis"))]
+ :help "Replace text in region with an ellipsis"]
["Delete Outside Region" message-delete-not-region
:active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Delete all quoted text outside region"))]
+ :help "Delete all quoted text outside region"]
["Kill To Signature" message-kill-to-signature t]
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
- ["Spellcheck" ispell-message
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Spellcheck this message"))]
+ ["Spellcheck" ispell-message :help "Spellcheck this message"]
"----"
["Insert Region Marked" message-mark-inserted-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Mark region with enclosing tags"))]
+ :active (message-mark-active-p) :help "Mark region with enclosing tags"]
["Insert File Marked..." message-mark-insert-file
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert file at point marked with enclosing tags"))]
+ :help "Insert file at point marked with enclosing tags"]
"----"
- ["Send Message" message-send-and-exit
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Send this message"))]
+ ["Send Message" message-send-and-exit :help "Send this message"]
["Postpone Message" message-dont-send
- ,@(if (featurep 'xemacs) '(t)
- '(:help "File this draft message and exit"))]
+ :help "File this draft message and exit"]
["Send at Specific Time..." gnus-delay-article
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Ask, then arrange to send message at that time"))]
+ :help "Ask, then arrange to send message at that time"]
["Kill Message" message-kill-buffer
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Delete this message without sending"))]
+ :help "Delete this message without sending"]
"----"
- ["Message manual" message-info
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Display the Message manual"))]))
+ ["Message manual" message-info :help "Display the Message manual"]))
(easy-menu-define
message-mode-field-menu message-mode-map ""
["Fcc" message-goto-fcc t]
["Reply-To" message-goto-reply-to t]
["Flag As Important" message-insert-importance-high
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mark this message as important"))]
+ :help "Mark this message as important"]
["Flag As Unimportant" message-insert-importance-low
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mark this message as unimportant"))]
+ :help "Mark this message as unimportant"]
["Request Receipt"
message-insert-disposition-notification-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Request a receipt notification"))]
+ :help "Request a receipt notification"]
"----"
;; (typical) news stuff
["Summary" message-goto-summary t]
"----"
;; (typical) mailing-lists stuff
["Fetch To" message-insert-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert a To header that points to the author."))]
+ :help "Insert a To header that points to the author."]
["Fetch To and Cc" message-insert-wide-reply
- ,@(if (featurep 'xemacs) '(t)
- '(:help
- "Insert To and Cc headers as if you were doing a wide reply."))]
+ :help "Insert To and Cc headers as if you were doing a wide reply."]
"----"
["Send to list only" message-to-list-only t]
["Mail-Followup-To" message-goto-mail-followup-to t]
["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert a reasonable `Mail-Followup-To:' header."))]
+ :help "Insert a reasonable `Mail-Followup-To:' header."]
["Reduce To: to Cc:" message-reduce-to-to-cc t]
"----"
["Sort Headers" message-sort-headers t]
;; category, face, display: probably doesn't do any harm.
;; fontified: is used by font-lock.
;; syntax-table, local-map: I dunno.
- ;; We need to add XEmacs names to the list.
"Property list of with properties forbidden in message buffers.
The values of the properties are ignored, only the property names are used.")
(inhibit-read-only t))
(remove-text-properties begin end message-forbidden-properties))))
-(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
-
(defvar message-smileys '(":-)" ":)"
":-(" ":("
";-)" ";)")
(set (make-local-variable 'comment-start) message-yank-prefix)
(set (make-local-variable 'comment-start-skip)
(concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
- (if (featurep 'xemacs)
- (message-setup-toolbar)
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))
+ (set (make-local-variable 'font-lock-defaults)
+ '(message-font-lock-keywords t))
+ (if (boundp 'tool-bar-map)
+ (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
- (gnus-make-local-hook 'after-change-functions)
;; Mmmm... Forbidden properties...
(add-hook 'after-change-functions 'message-strip-forbidden-properties
nil 'local)
;; Allow mail alias things.
(cond
((message-mail-alias-type-p 'abbrev)
- (if (fboundp 'mail-abbrevs-setup)
- (mail-abbrevs-setup)
- (if (fboundp 'mail-aliases-setup) ; warning avoidance
- (mail-aliases-setup))))
+ (mail-abbrevs-setup))
((message-mail-alias-type-p 'ecomplete)
(ecomplete-setup)))
(add-hook 'completion-at-point-functions 'message-completion-function nil t)
(make-local-variable 'paragraph-separate)
(make-local-variable 'paragraph-start)
(make-local-variable 'adaptive-fill-regexp)
- (unless (boundp 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp nil))
(make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
(setq adaptive-fill-first-line-regexp
(concat quote-prefix-regexp "\\|"
adaptive-fill-first-line-regexp)))
- (make-local-variable 'auto-fill-inhibit-regexp)
- ;;(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")
- (setq auto-fill-inhibit-regexp nil)
- (make-local-variable 'normal-auto-fill-function)
- (setq normal-auto-fill-function 'message-do-auto-fill)
- ;; KLUDGE: auto fill might already be turned on in `text-mode-hook'.
- ;; In that case, ensure that it uses the right function. The real
- ;; solution would be not to use `define-derived-mode', and run
- ;; `text-mode-hook' ourself at the end of the mode.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-19.
- ;; This kludge is unneeded in Emacs>=21 since define-derived-mode is
- ;; now careful to run parent hooks after the body. --Stef
- (when auto-fill-function
- (setq auto-fill-function normal-auto-fill-function)))
+ (setq-local auto-fill-inhibit-regexp nil)
+ (setq-local normal-auto-fill-function 'message-do-auto-fill))
\f
(defun message-goto-body ()
"Move point to the beginning of the message body."
(interactive)
- (when (and (gmm-called-interactively-p 'any)
+ (when (and (called-interactively-p 'any)
(looking-at "[ \t]*\n"))
(expand-abbrev))
(push-mark)
This function is used as the value of `fill-paragraph-function' in
Message buffers and is not meant to be called directly."
(interactive (list (if current-prefix-arg 'full)))
- (if (if (boundp 'filladapt-mode) filladapt-mode)
- nil
- (if (message-point-in-header-p)
- (message-fill-field)
- (message-newline-and-reformat arg t))
- t))
+ (if (message-point-in-header-p)
+ (message-fill-field)
+ (message-newline-and-reformat arg t))
+ t)
(defun message-point-in-header-p ()
"Return t if point is in the header."
(save-excursion
- (and
- (not
- (re-search-backward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
+ (save-restriction
+ (widen)
+ (let ((bound (+ (point-at-eol) 1)) case-fold-search)
+ (goto-char (point-min))
+ (not (search-forward (concat "\n" mail-header-separator "\n")
+ bound t))))))
(defun message-do-auto-fill ()
"Like `do-auto-fill', but don't fill in message header."
To use this automatically, you may add this function to
`gnus-message-setup-hook'."
(interactive "P")
- (let ((citexp
- (concat
- "^\\("
- (when (boundp 'message-yank-cited-prefix)
- (concat message-yank-cited-prefix "\\|"))
- message-yank-prefix
- "\\)+ *\n"
- )))
- (gnus-message 8 "removing `%s'" citexp)
+ (let ((citexp (concat "^\\("
+ (concat message-yank-cited-prefix "\\|")
+ message-yank-prefix
+ "\\)+ *\n")))
+ (message "Removing `%s'" citexp)
(save-excursion
(message-goto-body)
(while (re-search-forward citexp nil t)
(defun message-insert-formatted-citation-line (&optional from date tz)
"Function that inserts a formatted citation line.
The optional FROM, and DATE are strings containing the contents of
-the From header and the Date header respectively. The optional TZ
-is a number of seconds, overrides the time zone of DATE.
+the From header and the Date header respectively.
+
+The optional TZ is omitted or nil for Emacs local time, t for
+Universal Time, `wall' for system wall clock time, or a string as
+in the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time')
+applied without consideration for daylight saving time.
See `message-citation-line-format'."
;; The optional args are for testing/debugging. They will disappear later.
(>= i ?a)))
(push i lst)
(push (condition-case nil
- (gmm-format-time-string (format "%%%c" i) time tz)
+ (format-time-string (format "%%%c" i) time tz)
(error (format ">%c<" i)))
lst))
(setq i (1+ i)))
(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? ")
(or (eq message-allow-no-recipients 'always)
(and (not (eq message-allow-no-recipients 'never))
(setq dont-barf-on-no-method
- (gnus-y-or-n-p
+ (y-or-n-p
(format "No receiver, perform %s anyway? "
(cond ((and fcc gcc) "Fcc and Gcc")
(fcc "Fcc")
(const "invalid")
(const :tag "duplicate @" "@@")
(const :tag "non-ascii local part" "[^[:ascii:]].*@")
- ;; Already caught by `message-valid-fqdn-regexp'
- ;; (const :tag "`_' in domain part" "@.*_")
+ (const :tag "`_' in domain part" "@.*_")
(const :tag "whitespace" "[ \t]"))
(repeat :inline t
:tag "Other"
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")))))
(point) 'no-illegible-text)
(point-max))))
(setq char (char-after)))
- (when (or (< (mm-char-int char) 128)
+ (when (or (< char 128)
(and (mm-multibyte-p)
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
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
(setq choice
- (gnus-multiple-choice
- (if nul-chars
- "NUL characters found, which may cause problems. Continue sending?"
- "Non-printable characters found. Continue sending?")
- `((?d "Remove non-printable characters and send")
- (?r ,(format
- "Replace non-printable characters with \"%s\" and send"
- message-replacement-char))
- (?s "Send as is without removing anything")
- (?e "Continue editing"))))
+ (car
+ (read-multiple-choice
+ (if nul-chars
+ "NUL characters found, which may cause problems. Continue sending?"
+ "Non-printable characters found. Continue sending?")
+ `((?d "delete" "Remove non-printable characters and send")
+ (?r "replace"
+ ,(format
+ "Replace non-printable characters with \"%s\" and send"
+ message-replacement-char))
+ (?s "send" "Send as is without removing anything")
+ (?e "edit" "Continue editing")))))
(if (eq choice ?e)
(error "Non-printable characters"))
(message-goto-body)
(skip-chars-forward mm-7bit-chars)
(while (not (eobp))
(when (let ((char (char-after)))
- (or (< (mm-char-int char) 128)
+ (or (< char 128)
(and (mm-multibyte-p)
;; FIXME: Wrong for Emacs 23 (unicode) and for
;; things like undecodable utf-8 (in Emacs 21?).
RECIPIENTS is a mail header. Return a list of potentially bogus
addresses. If none is found, return nil.
-An address might be bogus if the domain part is not fully
-qualified, see `message-valid-fqdn-regexp', or if there's a
-matching entry in `message-bogus-addresses'."
+An address might be bogus if if there's a matching entry in
+`message-bogus-addresses'."
;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"?
(let (found)
(mapc (lambda (address)
(setq address (or (cadr address) ""))
- (when
- (or (string= "" address)
- (not
- (or
+ (when (or (string= "" address)
(not (string-match "@" address))
- (string-match
- (concat ".@.*\\("
- message-valid-fqdn-regexp "\\)\\'") address)))
- (and message-bogus-addresses
- (let ((re
- (if (listp message-bogus-addresses)
- (mapconcat 'identity
- message-bogus-addresses
- "\\|")
- message-bogus-addresses)))
- (string-match re address))))
+ (string-match "@.*@" address)
+ (and message-bogus-addresses
+ (let ((re
+ (if (listp message-bogus-addresses)
+ (mapconcat 'identity
+ message-bogus-addresses
+ "\\|")
+ message-bogus-addresses)))
+ (string-match re address))))
(push address found)))
- ;;
(mail-extract-address-components recipients t))
found))
(dolist (bog (message-bogus-recipient-p addr))
(and bog
(not (y-or-n-p
- (format
+ (format-message
"Address `%s'%s might be bogus. Continue? "
bog
;; If the encoded version of the email address
;; Check for control characters.
(message-check 'control-chars
(if (re-search-forward
- (mm-string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
+ (string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
nil t)
(y-or-n-p
"The article contains control characters. Really post? ")
"Make a From header."
(let* ((style message-from-style)
(login (or address (message-make-address)))
- (fullname (or name
- (and (boundp 'user-full-name)
- user-full-name)
- (user-full-name))))
+ (fullname (or name user-full-name (user-full-name))))
(when (string= fullname "&")
(setq fullname (user-login-name)))
(with-temp-buffer
(cond
((and message-user-fqdn
(stringp message-user-fqdn)
- (string-match message-valid-fqdn-regexp message-user-fqdn)
(not (string-match message-bogus-system-names message-user-fqdn)))
;; `message-user-fqdn' seems to be valid
message-user-fqdn)
- ((and (string-match message-valid-fqdn-regexp sysname)
- (not (string-match message-bogus-system-names sysname)))
+ ((and (string-match message-bogus-system-names sysname))
;; `system-name' returned the right result.
sysname)
;; Try `mail-host-address'.
- ((and (boundp 'mail-host-address)
- (stringp mail-host-address)
- (string-match message-valid-fqdn-regexp mail-host-address)
+ ((and (stringp mail-host-address)
(not (string-match message-bogus-system-names mail-host-address)))
mail-host-address)
;; We try `user-mail-address' as a backup.
((and user-domain
(stringp user-domain)
- (string-match message-valid-fqdn-regexp user-domain)
(not (string-match message-bogus-system-names user-domain)))
user-domain)
;; Default to this bogus thing.
ace)
(when field
(dolist (rhs
- (mm-delete-duplicates
+ (delete-dups
(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
(mapcar 'downcase
(mapcar
;; the domain part, i.e., if it is a local user's address.
(setq ace (if (string-match "\\`[[:ascii:]]*\\'" rhs)
rhs
- (downcase (idna-to-ascii rhs))))
+ (downcase (puny-encode-domain rhs))))
(when (and (not (equal rhs ace))
(or (not (eq message-use-idna 'ask))
(y-or-n-p (format "Replace %s with %s in %s:? "
(message-idna-to-ascii-rhs-1 "Mail-Followup-To")
(message-idna-to-ascii-rhs-1 "Cc")))))
-(defvar Date)
-(defvar Message-ID)
-(defvar Organization)
-(defvar From)
-(defvar Path)
-(defvar Subject)
-(defvar Newsgroups)
-(defvar In-Reply-To)
-(defvar References)
-(defvar To)
-(defvar Distribution)
-(defvar Lines)
-(defvar User-Agent)
-(defvar Expires)
-
(defun message-generate-headers (headers)
"Prepare article HEADERS.
Headers already prepared in the buffer are not modified."
(setq headers (append headers message-required-headers))
(save-restriction
(message-narrow-to-headers)
- (let* ((Date (message-make-date))
- (Message-ID (message-make-message-id))
- (Organization (message-make-organization))
- (From (message-make-from))
- (Path (message-make-path))
- (Subject nil)
- (Newsgroups nil)
- (In-Reply-To (message-make-in-reply-to))
- (References (message-make-references))
- (To nil)
- (Distribution (message-make-distribution))
- (Lines (message-make-lines))
- (User-Agent message-newsreader)
- (Expires (message-make-expires))
+ (let* ((header-values
+ (list 'Date (message-make-date)
+ 'Message-ID (message-make-message-id)
+ 'Organization (message-make-organization)
+ 'From (message-make-from)
+ 'Path (message-make-path)
+ 'Subject nil
+ 'Newsgroups nil
+ 'In-Reply-To (message-make-in-reply-to)
+ 'References (message-make-references)
+ 'To nil
+ 'Distribution (message-make-distribution)
+ 'Lines (message-make-lines)
+ 'User-Agent message-newsreader
+ 'Expires (message-make-expires)))
(case-fold-search t)
(optionalp nil)
header value elem header-string)
(setq header (cdr elem))
(or (and (functionp (cdr elem))
(funcall (cdr elem)))
- (and (boundp (cdr elem))
- (symbol-value (cdr elem)))))
+ (and (symbolp (cdr elem))
+ (plist-get header-values (cdr elem)))))
((consp elem)
;; The element is a cons. Either the cdr is a
;; string to be inserted verbatim, or it is a
(cdr elem))
(and (functionp (cdr elem))
(funcall (cdr elem)))))
- ((and (boundp header)
- (symbol-value header))
- ;; The element is a symbol. We insert the value
- ;; of this symbol, if any.
- (symbol-value header))
+ ((and (symbolp header)
+ (plist-member header-values header))
+ ;; The element is a symbol. We insert the value of
+ ;; this symbol, if any.
+ (plist-get header-values header))
((not (message-check-element
(intern (downcase (symbol-name header)))))
;; We couldn't generate a value for this header,
"Split current line, moving portion beyond point vertically down.
If the current line has `message-yank-prefix', insert it on the new line."
(interactive "*")
- (condition-case nil
- (split-line message-yank-prefix) ;; Emacs 22.1+ supports arg.
- (error
- (split-line))))
+ (split-line message-yank-prefix))
(defun message-insert-header (header value)
(insert (capitalize (symbol-name header))
(defvar visual-line-mode)
(declare-function beginning-of-visual-line "simple" (&optional n))
+(defun message-beginning-of-header (handle-folded)
+ "Move point to beginning of header’s value.
+
+When point is at the first header line, moves it after the colon
+and spaces separating header name and header value.
+
+When point is in a continuation line of a folded header (i.e. the
+line starts with a space), the behaviour depends on HANDLE-FOLDED
+argument. If it’s nil, function moves the point to the start of
+the header continuation; otherwise, function locates the
+beginning of the header and moves point past the colon as is the
+case of single-line headers.
+
+No check whether point is inside of a header or body of the
+message is performed.
+
+Returns point or nil if beginning of header’s value could not be
+found. In the latter case, the point is still moved to the
+beginning of line (possibly after attempting to move it to the
+beginning of a folded header)."
+ ;; https://www.rfc-editor.org/rfc/rfc2822.txt, section 2.2.3. says that when
+ ;; unfolding a single WSP should be consumed. WSP is defined as a space
+ ;; character or a horizontal tab.
+ (beginning-of-line)
+ (when handle-folded
+ (while (and (> (point) (point-min))
+ (or (eq (char-after) ?\s) (eq (char-after) ?\t)))
+ (beginning-of-line 0)))
+ (when (or (eq (char-after) ?\s) (eq (char-after) ?\t)
+ (search-forward ":" (point-at-eol) t))
+ ;; We are a bit more lacks than the RFC and allow any positive number of WSP
+ ;; characters.
+ (skip-chars-forward " \t" (point-at-eol))
+ (point)))
+
(defun message-beginning-of-line (&optional n)
"Move point to beginning of header value or to beginning of line.
The prefix argument N is passed directly to `beginning-of-line'.
This command is identical to `beginning-of-line' if point is
-outside the message header or if the option `message-beginning-of-line'
-is nil.
-
-If point is in the message header and on a (non-continued) header
-line, move point to the beginning of the header value or the beginning of line,
-whichever is closer. If point is already at beginning of line, move point to
-beginning of header value. Therefore, repeated calls will toggle point
-between beginning of field and beginning of line."
+outside the message header or if the option
+`message-beginning-of-line' is nil.
+
+If point is in the message header and on a header line, move
+point to the beginning of the header value or the beginning of
+line, whichever is closer. If point is already at beginning of
+line, move point to beginning of header value. Therefore,
+repeated calls will toggle point between beginning of field and
+beginning of line.
+
+When called without a prefix argument, header value spanning
+multiple lines is treated as a single line. Otherwise, even if
+N is 1, when point is on a continuation header line, it will be
+moved to the beginning "
(interactive "p")
- (let ((zrs 'zmacs-region-stays))
- (when (and (featurep 'xemacs) (interactive-p) (boundp zrs))
- (set zrs t)))
- (if (and message-beginning-of-line
- (message-point-in-header-p))
- (let* ((here (point))
- (bol (progn (beginning-of-line n) (point)))
- (eol (point-at-eol))
- (eoh (re-search-forward ": *" eol t)))
- (goto-char
- (if (and eoh (or (< eoh here) (= bol here)))
- eoh bol)))
- (if (and (boundp 'visual-line-mode) visual-line-mode)
- (beginning-of-visual-line n)
- (beginning-of-line n))))
+ (cond
+ ;; Go to beginning of header or beginning of line.
+ ((and message-beginning-of-line (message-point-in-header-p))
+ (let* ((point (point))
+ (bol (progn (beginning-of-line n) (point)))
+ (boh (message-beginning-of-header visual-line-mode)))
+ (goto-char (if (and boh (or (< boh point) (= bol point))) boh bol))))
+ ;; Go to beginning of visual line
+ (visual-line-mode
+ (beginning-of-visual-line n))
+ ;; Go to beginning of line.
+ ((beginning-of-line n))))
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
(if window
;; Raise the frame already displaying the message buffer.
(progn
- (gnus-select-frame-set-input-focus (window-frame window))
+ (select-frame-set-input-focus (window-frame window))
(select-window window))
(funcall (or switch-function #'pop-to-buffer) buffer)
(set-buffer buffer))
"Message already being composed; erase? ")
(message nil))))
(error "Message being composed")))
- (funcall (or switch-function
- (if (fboundp #'pop-to-buffer-same-window)
- #'pop-to-buffer-same-window
- #'pop-to-buffer))
+ (funcall (or switch-function 'pop-to-buffer-same-window)
name)
(set-buffer name))
(erase-buffer)
;; Squeeze whitespace.
(while (string-match "[ \t][ \t]+" recipients)
(setq recipients (replace-match " " t t recipients)))
- ;; Remove addresses that match `mail-dont-reply-to-names'.
- (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
- (setq recipients (mail-dont-reply-to recipients)))
+ ;; Remove addresses that match `message-dont-reply-to-names'.
+ (setq recipients
+ (cond ((functionp message-dont-reply-to-names)
+ (mapconcat
+ 'identity
+ (delq nil
+ (mapcar (lambda (mail)
+ (unless (funcall message-dont-reply-to-names
+ (mail-strip-quoted-names mail))
+ mail))
+ (message-tokenize-header recipients)))
+ ", "))
+ (t (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
+ (mail-dont-reply-to recipients)))))
;; Perhaps "Mail-Copies-To: never" removed the only address?
(if (string-equal recipients "")
(setq recipients author))
(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."
+to match all of yours addresses."
;; Canlock-logic as suggested by Per Abrahamsen
;; <abraham@dina.kvl.dk>
;;
(downcase (car (mail-header-parse-address
(message-make-from))))))
;; Email address in From field matches
- ;; 'message-alternative-emails' regexp
+ ;; 'message-alternative-emails' regexp or function.
(and from
message-alternative-emails
- (string-match
- message-alternative-emails
- (car (mail-header-parse-address from))))))))))
+ (cond ((functionp message-alternative-emails)
+ (funcall message-alternative-emails
+ (mail-header-parse-address from)))
+ (t (string-match message-alternative-emails
+ (car (mail-header-parse-address from))))))))))))
;;;###autoload
(defun message-cancel-news (&optional arg)
(cond ((save-window-excursion
(with-output-to-temp-buffer "*Directory*"
(with-current-buffer standard-output
- (fundamental-mode)) ; for Emacs 20.4+
+ (fundamental-mode))
(buffer-disable-undo standard-output)
(let ((default-directory "/"))
(call-process
(let ((b (point))
(contents (with-current-buffer forward-buffer (buffer-string)))
e)
- (unless (featurep 'xemacs)
- (unless (mm-multibyte-string-p contents)
- (error "Attempt to insert unibyte string from the buffer \"%s\"\
+ (unless (multibyte-string-p contents)
+ (error "Attempt to insert unibyte string from the buffer \"%s\"\
to the multibyte buffer \"%s\""
- (if (bufferp forward-buffer)
- (buffer-name forward-buffer)
- forward-buffer)
- (buffer-name))))
+ (if (bufferp forward-buffer)
+ (buffer-name forward-buffer)
+ forward-buffer)
+ (buffer-name)))
(insert (mm-with-multibyte-buffer
(insert contents)
(mime-to-mml)
(let ((b (point)) e)
(if (not message-forward-decoded-p)
(let ((contents (with-current-buffer forward-buffer (buffer-string))))
- (unless (featurep 'xemacs)
- (unless (mm-multibyte-string-p contents)
- (error "Attempt to insert unibyte string from the buffer \"%s\"\
+ (unless (multibyte-string-p contents)
+ (error "Attempt to insert unibyte string from the buffer \"%s\"\
to the multibyte buffer \"%s\""
- (if (bufferp forward-buffer)
- (buffer-name forward-buffer)
- forward-buffer)
- (buffer-name))))
+ (if (bufferp forward-buffer)
+ (buffer-name forward-buffer)
+ forward-buffer)
+ (buffer-name)))
(insert (mm-with-multibyte-buffer
(insert contents)
(mime-to-mml)
(defun message-forward-rmail-make-body (forward-buffer)
(save-window-excursion
(set-buffer forward-buffer)
- (if (rmail-msg-is-pruned)
- (if (fboundp 'rmail-msg-restore-non-pruned-header)
- (rmail-msg-restore-non-pruned-header) ; Emacs 22
- (rmail-toggle-header 0)))) ; Emacs 23
+ (when (rmail-msg-is-pruned)
+ (rmail-toggle-header 0)))
(message-forward-make-body forward-buffer))
;; Fixme: Should have defcustom.
(let ((case-fold-search t))
(re-search-forward "^mime-version:" nil t)))
(message-inhibit-ecomplete t)
+ ;; We don't want smtpmail.el to encode anything, either.
+ (sendmail-coding-system 'raw-text)
+ (select-safe-coding-system-function nil)
message-required-mail-headers
message-generate-hashcash
rfc2047-encode-encoded-words)
(defcustom message-tool-bar-gnome
'((ispell-message "spell" nil
:vert-only t
- :visible (or (not (boundp 'flyspell-mode))
- (not flyspell-mode)))
+ :visible (not flyspell-mode))
(flyspell-buffer "spell" t
:vert-only t
- :visible (and (boundp 'flyspell-mode)
- flyspell-mode)
+ :visible flyspell-mode
:help "Flyspell whole buffer")
(message-send-and-exit "mail/send" t :label "Send")
(message-dont-send "mail/save-draft")
(defun message-make-tool-bar (&optional force)
"Make a message mode tool bar from `message-tool-bar-list'.
When FORCE, rebuild the tool bar."
- (when (and (not (featurep 'xemacs))
- (boundp 'tool-bar-mode)
+ (when (and (boundp 'tool-bar-mode)
tool-bar-mode
(or (not message-tool-bar-map) force))
(setq message-tool-bar-map
(let* ((load-path
- (gmm-image-load-path-for-library "message"
- "mail/save-draft.xpm"
- nil t))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path))))
+ (image-load-path-for-library
+ "message" "mail/save-draft.xpm" nil t))
+ (image-load-path (cons (car load-path) image-load-path)))
(gmm-tool-bar-from-list message-tool-bar
message-tool-bar-zap-list
'message-mode-map))))
regular text mode tabbing command."
(interactive)
(cond
- ((if (and (boundp 'completion-fail-discreetly)
- (fboundp 'completion-at-point))
- (let ((completion-fail-discreetly t)) (completion-at-point))
- (funcall (or (message-completion-function) #'ignore)))
+ ((let ((completion-fail-discreetly t))
+ (completion-at-point))
;; Completion was performed; nothing else to do.
nil)
(message-tab-body-function (funcall message-tab-body-function))
group)
collection))
gnus-active-hashtb))
- (message-completion-in-region b e collection)))
-
-(defalias 'message-completion-in-region
- (if (fboundp 'completion-in-region)
- 'completion-in-region
- (lambda (b e hashtb)
- (let* ((string (buffer-substring b e))
- (completions (all-completions string hashtb))
- comp)
- (delete-region b (point))
- (cond
- ((= (length completions) 1)
- (if (string= (car completions) string)
- (progn
- (insert string)
- (message "Only matching group"))
- (insert (car completions))))
- ((and (setq comp (try-completion string hashtb))
- (not (string= comp string)))
- (insert comp))
- (t
- (insert string)
- (if (not comp)
- (message "No matching groups")
- (save-selected-window
- (pop-to-buffer "*Completions*")
- (buffer-disable-undo)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
- (setq buffer-read-only nil)
- (goto-char (point-min))
- (delete-region (point)
- (progn (forward-line 3) (point))))))))))))
+ (completion-in-region b e collection)))
(defun message-expand-name ()
(cond ((and (memq 'eudc message-expand-name-databases)
(save-window-excursion
(with-output-to-temp-buffer " *MESSAGE information message*"
(with-current-buffer " *MESSAGE information message*"
- (fundamental-mode) ; for Emacs 20.4+
+ (fundamental-mode)
(mapc 'princ text)
(goto-char (point-min))))
(funcall ask question))
(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)))
(defun message-read-from-minibuffer (prompt &optional initial-contents)
"Read from the minibuffer while providing abbrev expansion."
- (if (fboundp 'mail-abbrevs-setup)
- (let ((minibuffer-setup-hook 'mail-abbrevs-setup)
- (minibuffer-local-map message-minibuffer-local-map))
- (read-from-minibuffer prompt initial-contents))
- (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
- (minibuffer-local-map message-minibuffer-local-map))
- (read-string prompt initial-contents))))
+ (let ((minibuffer-setup-hook 'mail-abbrevs-setup)
+ (minibuffer-local-map message-minibuffer-local-map))
+ (read-from-minibuffer prompt initial-contents)))
(defun message-use-alternative-email-as-from ()
"Set From field of the outgoing message to the first matching
(require 'mail-utils)
(let* ((fields '("To" "Cc" "From"))
(emails
- (split-string
+ (message-tokenize-header
(mail-strip-quoted-names
- (mapconcat 'message-fetch-reply-field fields ","))
- "[ \f\t\n\r\v,]+"))
- email)
- (while emails
- (if (string-match message-alternative-emails (car emails))
- (setq email (car emails)
- emails nil))
- (pop emails))
+ (mapconcat 'message-fetch-reply-field fields ","))))
+ (email (cond ((functionp message-alternative-emails)
+ (car (cl-remove-if-not message-alternative-emails emails)))
+ (t (loop for email in emails
+ if (string-match-p message-alternative-emails email)
+ return email)))))
(unless (or (not email) (equal email user-mail-address))
(message-remove-header "From")
(goto-char (point-max))
(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
(let ((value (message-field-value header)))
(dolist (string (mail-header-parse-addresses value 'raw))
(setq string
- (gnus-replace-in-string
- (gnus-replace-in-string string "^ +\\| +$" "") "\n" ""))
+ (replace-regexp-in-string
+ "\n" ""
+ (replace-regexp-in-string "^ +\\| +$" "" string)))
(ecomplete-add-item 'mail (car (mail-header-parse-address string))
string))))
(ecomplete-save))
(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 (format-message "Send message to `%s'? " to)))
(progn
(setq sent (1+ sent))
(message-send-and-exit))
(defun message-toggle-image-thumbnails ()
"For any included image files, insert a thumbnail of that image."
(interactive)
- (let ((overlays (message-overlays-in (point-min) (point-max)))
+ (let ((overlays (overlays-in (point-min) (point-max)))
(displayed nil))
(while overlays
(let ((overlay (car overlays)))
- (when (message-overlay-get overlay 'put-image)
- (message-delete-overlay overlay)
+ (when (overlay-get overlay 'put-image)
+ (delete-overlay overlay)
(setq displayed t)))
(setq overlays (cdr overlays)))
(unless displayed
(goto-char (point-min))
(while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t)
(let ((file (match-string 1))
- (edges (message-window-inside-pixel-edges
+ (edges (window-inside-pixel-edges
(get-buffer-window (current-buffer)))))
(put-image
(create-image
(match-beginning 0)
" ")))))))
-(when (featurep 'xemacs)
- (require 'messagexmas)
- (message-xmas-redefine))
-
(provide 'message)
(run-hooks 'message-load-hook)