(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
: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
- (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names)
- "*Addresses to prune when doing wide replies.
+(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.
(repeat :tag "Regexp List" regexp)))
(defsubst message-dont-reply-to-names ()
- (cond ((functionp message-dont-reply-to-names)
- message-dont-reply-to-names)
- ((stringp 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.
: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)
(autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'gnus-request-post "gnus-int")
(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
- (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)))
+(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
+ (read-coding-system
(format-message "\
Decoded Subject \"%s\"
contains an encoded word. The charset `%s' is unknown or invalid.
"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/
(require 'mml2015)
mml2015-use)
((eq arg 4) 'emacs-mime)
- ;; `booleanp' only available in Emacs 22+
- ((and (not (memq arg '(nil t)))
+ ((and (not (booleanp arg))
(symbolp arg))
arg)
(t
(inhibit-read-only t))
(remove-text-properties begin end message-forbidden-properties))))
-(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
-
(defvar message-smileys '(":-)" ":)"
":-(" ":("
";-)" ";)")
;; 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
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."
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)))
(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")
(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
(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?).
;; 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
;; `system-name' returned the right result.
sysname)
;; Try `mail-host-address'.
- ((and (boundp 'mail-host-address)
- (stringp 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.
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))
((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 (and (boundp 'visual-line-mode)
- visual-line-mode))))
+ (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
- ((and (boundp 'visual-line-mode) visual-line-mode)
+ (visual-line-mode
(beginning-of-visual-line n))
;; Go to beginning of line.
((beginning-of-line n))))
"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)
(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 (mm-multibyte-string-p contents)
+ (unless (multibyte-string-p contents)
(error "Attempt to insert unibyte string from the buffer \"%s\"\
to the multibyte buffer \"%s\""
(if (bufferp forward-buffer)
(let ((b (point)) e)
(if (not message-forward-decoded-p)
(let ((contents (with-current-buffer forward-buffer (buffer-string))))
- (unless (mm-multibyte-string-p contents)
+ (unless (multibyte-string-p contents)
(error "Attempt to insert unibyte string from the buffer \"%s\"\
to the multibyte buffer \"%s\""
(if (bufferp forward-buffer)
(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")
(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-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
(dolist (string (mail-header-parse-addresses value 'raw))
(setq string
(replace-regexp-in-string
- (replace-regexp-in-string string "^ +\\| +$" "") "\n" ""))
+ "\n" ""
+ (replace-regexp-in-string "^ +\\| +$" "" string)))
(ecomplete-add-item 'mail (car (mail-header-parse-address string))
string))))
(ecomplete-save))
(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