(eval-when-compile
(require 'cl)
(defvar gnus-message-group-art)
- (defvar gnus-list-identifiers) ; gnus-sum is required where necessary
- (require 'hashcash))
+ (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+(require 'hashcash)
(require 'canlock)
(require 'mailheader)
+(require 'gmm-utils)
(require 'nnheader)
;; This is apparently necessary even though things are autoloaded.
;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
+(require 'ecomplete)
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
:group 'message-interface
:type 'regexp)
-;;;###autoload
(defcustom message-from-style 'default
"*Specifies how \"From\" headers look.
Don't touch this variable unless you really know what you're doing.
-Checks include `subject-cmsg', `multiple-headers', `sendsys',
-`message-id', `from', `long-lines', `control-chars', `size',
-`new-text', `quoting-style', `redirected-followup', `signature',
-`approved', `sender', `empty', `empty-headers', `message-id', `from',
-`subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups', `reply-to',
-`continuation-headers', `long-header-lines', `invisible-text' and
-`illegible-text'."
+Checks include `approved', `continuation-headers', `control-chars',
+`empty', `existing-newsgroups', `from', `illegible-text',
+`invisible-text', `long-header-lines', `long-lines', `message-id',
+`multiple-headers', `new-text', `newsgroups', `quoting-style',
+`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
+`shorten-followup-to', `signature', `size', `subject', `subject-cmsg'
+and `valid-newsgroups'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
-(defcustom message-draft-headers '(References From)
+(defcustom message-draft-headers '(References From Date)
"*Headers to be generated when saving a draft message."
:version "22.1"
:group 'message-news
;;; End of variables adopted from `message-utils.el'.
-;;;###autoload
(defcustom message-signature-separator "^-- *$"
"Regexp matching the signature separator."
:type 'regexp
:type '(choice string
(const :tag "consult file" t)))
-;;;###autoload
-(defcustom message-user-organization-file "/usr/lib/news/organization"
+(defcustom message-user-organization-file
+ (let (orgfile)
+ (dolist (f (list "/etc/organization"
+ "/etc/news/organization"
+ "/usr/lib/news/organization"))
+ (when (file-readable-p f)
+ (setq orgfile f)))
+ orgfile)
"*Local news organization file."
:type 'file
:link '(custom-manual "(message)News Headers")
:type 'string)
;; Useful to set in site-init.el
-;;;###autoload
(defcustom message-send-mail-function
(let ((program (if (boundp 'sendmail-program)
;; see paths.el
:link '(custom-manual "(message)Mail Variables")
:group 'message-sending)
+(defcustom message-sendmail-extra-arguments nil
+ "Additional arguments to `sendmail-program'."
+ ;; E.g. '("-a" "account") for msmtp
+ :version "23.0" ;; No Gnus
+ :type '(repeat string)
+ ;; :link '(custom-manual "(message)Mail Variables")
+ :group 'message-sending)
+
;; qmail-related stuff
(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
"Location of the qmail-inject program."
:version "22.1"
:group 'message-various)
-;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
"*Function called to insert the \"Whomever writes:\" line.
+Predefined functions include `message-insert-citation-line' and
+`message-insert-formated-citation-line' (see the variable
+`message-citation-line-format').
+
Note that Gnus provides a feature where the reader can click on
`writes:' to hide the cited text. If you change this line too much,
people who read your message will have to change their Gnus
configuration. See the variable `gnus-cite-attribution-suffix'."
- :type 'function
+ :type '(choice
+ (function-item :tag "plain" message-insert-citation-line)
+ (function-item :tag "formatted" message-insert-formated-citation-line)
+ (function :tag "Other"))
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
+(defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:"
+ "Format of the \"Whomever writes:\" line.
+
+The string is formatted using `format-spec'. The following
+constructs are replaced:
+
+ %f The full From, e.g. \"John Doe <john.doe@example.invalid>\".
+ %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\".
+ %L The last name if present, e.g.: \"Doe\".
+
+All other format specifiers are passed to `format-time-string'
+which is called using the date from the article your replying to.
+Extracting the first (%F) and last name (%L) is done
+heuristically, so you should always check it yourself.
+
+Please also read the note in the documentation of
+`message-citation-line-function'."
+ :type '(choice (const :tag "Plain" "%f writes:")
+ (const :tag "Include date" "On %a, %b %d %Y, %n wrote:")
+ string)
+ :link '(custom-manual "(message)Insertion Variables")
+ :version "23.0" ;; No Gnus
+ :group 'message-insertion)
+
(defcustom message-yank-prefix "> "
"*Prefix inserted on the lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
-;;;###autoload
(defcustom message-cite-function 'message-cite-original
"*Function for citing an original message.
Predefined functions include `message-cite-original' and
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
(defcustom message-indent-citation-function 'message-indent-citation
"*Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
(defcustom message-signature t
"*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
(defcustom message-signature-file "~/.signature"
"*Name of file containing the text inserted at end of message buffer.
Ignored if the named file doesn't exist.
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
(defcustom message-signature-insert-empty-line t
"*If non-nil, insert an empty line before the signature separator."
:version "22.1"
(defcustom message-mail-alias-type 'abbrev
"*What alias expansion type to use in Message buffers.
-The default is `abbrev', which uses mailabbrev. nil switches
-mail aliases off."
+The default is `abbrev', which uses mailabbrev. `ecomplete' uses
+an electric completion mode. nil switches mail aliases off.
+This can also be a list of values."
:group 'message
:link '(custom-manual "(message)Mail Aliases")
:type '(choice (const :tag "Use Mailabbrev" abbrev)
+ (const :tag "Use ecomplete" ecomplete)
(const :tag "No expansion" nil)))
+(defcustom message-self-insert-commands '(self-insert-command)
+ "List of `self-insert-command's used to trigger ecomplete.
+When one of those commands is invoked to enter a character in To or Cc
+header, ecomplete will suggest the candidates of recipients (see also
+`message-mail-alias-type'). If you use some tool to enter non-ASCII
+text and it replaces `self-insert-command' with the other command, e.g.
+`egg-self-insert-command', you may want to add it to this list."
+ :group 'message-various
+ :type '(repeat function))
+
(defcustom message-auto-save-directory
(file-name-as-directory (nnheader-concat message-directory "drafts"))
"*Directory where Message auto-saves buffers if Gnus isn't running.
(defcustom message-dont-reply-to-names
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
- "*A regexp specifying addresses to prune when doing wide replies.
-A value of nil means exclude your own user name only."
+ "*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."
:version "21.1"
:group 'message
:link '(custom-manual "(message)Wide Reply")
:type '(choice (const :tag "Yourself" nil)
- regexp))
+ regexp
+ (repeat :tag "Regexp List" regexp)))
+
+;; #### FIXME: this might become a generally usefull function at some point
+;; --dlv.
+(defsubst message-dont-reply-to-names ()
+ "Potentially convert a list of regexps into a single one."
+ (cond ((null message-dont-reply-to-names)
+ nil)
+ ((stringp message-dont-reply-to-names)
+ message-dont-reply-to-names)
+ ((listp message-dont-reply-to-names)
+ (mapconcat (lambda (elt) (concat "\\(" elt "\\)"))
+ message-dont-reply-to-names
+ "\\|"))))
(defvar message-shoot-gnksa-feet nil
"*A list of GNKSA feet you are allowed to shoot.
(or (not (listp message-shoot-gnksa-feet))
(memq feature message-shoot-gnksa-feet)))
-(defcustom message-hidden-headers "^References:"
+(defcustom message-hidden-headers '("^References:" "^Face:" "^X-Face:"
+ "^X-Draft-From:")
"Regexp of headers to be hidden when composing new messages.
This can also be a list of regexps to match headers. Or a list
starting with `not' and followed by regexps."
(const :tag "Never" nil)
(const :tag "Always" t)))
-(defcustom message-generate-hashcash nil
+(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
"*Whether to generate X-Hashcash: headers.
+If `t', always generate hashcash headers. If `opportunistic',
+only generate hashcash headers if it can be done without the user
+waiting (i.e., only asynchronously).
+
You must have the \"hashcash\" binary installed, see `hashcash-path'."
:group 'message-headers
:link '(custom-manual "(message)Mail Headers")
- :type 'boolean)
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Opportunistic" opportunistic)))
;;; Internal variables.
(defvar message-send-mail-real-function nil
"Internal send mail function.")
-(defvar message-bogus-system-names "^localhost\\."
+(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
- "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
- "\\|aero\\|coop\\|info\\|name\\|museum"
- "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
- "\\)")
+ "\\([a-z][a-z]\\|" ;; two letter country TDLs
+ "aero\\|arpa\\|bitnet\\|biz\\|bofh\\|"
+ "cat\\|com\\|coop\\|edu\\|gov\\|"
+ "info\\|int\\|jobs\\|"
+ "mil\\|mobi\\|museum\\|name\\|net\\|"
+ "org\\|pro\\|travel\\|uucp\\)")
+ ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
+ ;; http://en.wikipedia.org/wiki/GTLD
+ ;; `in the process of being approved': .asia .post .tel .sex
+ ;; "dead" nato bitnet uucp
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
:version "22.1"
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-server-string "gnus")
(autoload 'idna-to-ascii "idna")
- (autoload 'gmm-tool-bar-from-list "gmm-utils")
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
(substring subject (match-end 0))
subject))
+(defcustom message-replacement-char "."
+ "Replacement character used instead of unprintable or not decodable chars."
+ :group 'message-various
+ :version "22.1" ;; Gnus 5.10.9
+ :type '(choice string
+ (const ".")
+ (const "?")))
+
+;; FIXME: We also should call `message-strip-subject-encoded-words'
+;; when forwarding. Probably in `message-make-forward-subject' and
+;; `message-forward-make-body'.
+
+(defun message-strip-subject-encoded-words (subject)
+ "Fix non-decodable words in SUBJECT."
+ ;; Cf. `gnus-simplify-subject-fully'.
+ (let* ((case-fold-search t)
+ (replacement-chars (format "[%s%s%s]"
+ message-replacement-char
+ message-replacement-char
+ message-replacement-char))
+ (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)")
+ cs-string
+ (have-marker
+ (with-temp-buffer
+ (insert subject)
+ (goto-char (point-min))
+ (when (re-search-forward enc-word-re nil t)
+ (setq cs-string (match-string 1)))))
+ cs-coding q-or-b word-beg word-end)
+ (if (or (not have-marker) ;; No encoded word found...
+ ;; ... or double encoding was correct:
+ (and (stringp cs-string)
+ (setq cs-string (downcase cs-string))
+ (mm-coding-system-p (intern cs-string))
+ (not (prog1
+ (y-or-n-p
+ (format "\
+Decoded Subject \"%s\"
+contains a valid encoded word. Decode again? "
+ subject))
+ (setq cs-coding (intern cs-string))))))
+ subject
+ (with-temp-buffer
+ (insert subject)
+ (goto-char (point-min))
+ (while (re-search-forward enc-word-re nil t)
+ (setq cs-string (downcase (match-string 1))
+ q-or-b (match-string 2)
+ word-beg (match-beginning 0)
+ word-end (match-end 0))
+ (setq cs-coding
+ (if (mm-coding-system-p (intern cs-string))
+ (setq cs-coding (intern cs-string))
+ nil))
+ ;; No double encoded subject? => bogus charset.
+ (unless cs-coding
+ (setq cs-coding
+ (mm-read-coding-system
+ (format "\
+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
+charset: "
+ subject cs-string message-replacement-char)))
+ (if cs-coding
+ (replace-match (concat "=?" (symbol-name cs-coding)
+ "?\\2?\\3\\4\\5"))
+ (save-excursion
+ (goto-char word-beg)
+ (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t)
+ (replace-match "")
+ ;; QP or base64
+ (if (string-match "\\`Q\\'" q-or-b)
+ ;; QP
+ (progn
+ (message "Replacing non-decodable characters with \"%s\"."
+ message-replacement-char)
+ (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+"
+ word-end t)
+ (replace-match message-replacement-char)))
+ ;; base64
+ (message "Replacing non-decodable characters with \"%s\"."
+ replacement-chars)
+ (re-search-forward "[^?]+" word-end t)
+ (replace-match replacement-chars))
+ (re-search-forward "\\?=")
+ (replace-match "")))))
+ (rfc2047-decode-region (point-min) (point-max))
+ (buffer-string)))))
+
;;; Start of functions adopted from `message-utils.el'.
(defun message-strip-subject-trailing-was (subject)
(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-;" 'comment-region))
+ (define-key message-mode-map "\M-;" 'comment-region)
+
+ (define-key message-mode-map "\M-n" 'message-display-abbrev))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
(get-text-property pos 'egg-lang)
(get-text-property pos 'egg-start)))))
+(defsubst message-mail-alias-type-p (type)
+ (if (atom message-mail-alias-type)
+ (eq message-mail-alias-type type)
+ (memq type message-mail-alias-type)))
+
(defun message-strip-forbidden-properties (begin end &optional old-length)
"Strip forbidden properties between BEGIN and END, ignoring the third arg.
This function is intended to be called from `after-change-functions'.
See also `message-forbidden-properties'."
+ (when (and (message-mail-alias-type-p 'ecomplete)
+ (memq this-command message-self-insert-commands))
+ (message-display-abbrev))
(when (and message-strip-special-text-properties
(message-tamago-not-in-use-p begin))
(let ((buffer-read-only nil)
(add-hook 'after-change-functions 'message-strip-forbidden-properties
nil 'local)
;; Allow mail alias things.
- (when (eq message-mail-alias-type 'abbrev)
+ (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))))
+ ((message-mail-alias-type-p 'ecomplete)
+ (ecomplete-setup)))
(unless buffer-file-name
(message-set-auto-save-file-name))
(unless (buffer-base-buffer)
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
(search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
+(defun message-in-body-p ()
+ "Return t if point is in the message body."
+ (let ((body (save-excursion (message-goto-body) (point))))
+ (>= (point) body)))
+
(defun message-goto-eoh ()
"Move point to the end of the headers."
(interactive)
(message-goto-body)
(forward-line -1))
-(defun message-in-body-p ()
- "Return t if point is in the message body."
- (let ((body (save-excursion (message-goto-body) (point))))
- (>= (point) body)))
-
(defun message-goto-signature ()
"Move point to the beginning of the message signature.
If there is no signature in the article, go to the end and
(message-carefully-insert-headers headers)))
(defcustom message-header-synonyms
- '((To Cc Bcc))
+ '((To Cc Bcc)
+ (Original-To))
"List of lists of header synonyms.
E.g., if this list contains a member list with elements `Cc' and `To',
then `message-carefully-insert-headers' will not insert a `To' header
(message-newline-and-reformat arg t))
t))
-;; Is it better to use `mail-header-end'?
(defun message-point-in-header-p ()
"Return t if point is in the header."
(save-excursion
- (let ((p (point)))
- (goto-char (point-min))
- (not (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n")
- p t)))))
+ (not (re-search-backward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
(defun message-do-auto-fill ()
"Like `do-auto-fill', but don't fill in message header."
(substring table ?a (+ ?a n))
(substring table (+ ?a 26) 255))))
-(defun message-caesar-buffer-body (&optional rotnum)
+(defun message-caesar-buffer-body (&optional rotnum wide)
"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."
+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)))
(save-excursion
(save-restriction
- (when (message-goto-body)
+ (when (and (not wide) (message-goto-body))
(narrow-to-region (point) (point-max)))
(message-caesar-region (point-min) (point-max) rotnum))))
(let ((fill-prefix message-yank-prefix))
(fill-individual-paragraphs (point) (point-max) justifyp))))
-(defun message-indent-citation ()
+(defun message-indent-citation (&optional start end yank-only)
"Modify text just inserted from a message to be cited.
The inserted text should be the region.
When this function returns, the region is again around the modified text.
Normally, indent each nonblank line `message-indentation-spaces' spaces.
However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
- (let ((start (point)))
+ (unless start (setq start (point)))
+ (unless yank-only
;; Remove unwanted headers.
(when message-ignored-cited-headers
(let (all-removed)
(insert "\n"))
(while (and (zerop (forward-line -1))
(looking-at "$"))
- (message-delete-line))
- ;; Do the indentation.
- (if (null message-yank-prefix)
- (indent-rigidly start (mark t) message-indentation-spaces)
- (save-excursion
- (goto-char start)
- (while (< (point) (mark t))
- (cond ((looking-at ">")
- (insert message-yank-cited-prefix))
- ((looking-at "^$")
- (insert message-yank-empty-prefix))
- (t
- (insert message-yank-prefix)))
- (forward-line 1))))
- (goto-char start)))
+ (message-delete-line)))
+ ;; Do the indentation.
+ (if (null message-yank-prefix)
+ (indent-rigidly start (or end (mark t)) message-indentation-spaces)
+ (save-excursion
+ (goto-char start)
+ (while (< (point) (or end (mark t)))
+ (cond ((looking-at ">")
+ (inser
projects / gnus / blobdiff