;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
(require 'mml)
(require 'rfc822)
(require 'format-spec)
+(require 'dired)
(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
:type 'sexp)
(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:\\|^X-Gnus-Delayed:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
(setq orgfile f)))
orgfile)
"*Local news organization file."
- :type 'file
+ :type '(choice (const nil) file)
:link '(custom-manual "(message)News Headers")
:group 'message-headers)
;; comes back to you (e.g. a mailing-list to which you subscribe, in which
;; case you may be removed from the list on the grounds that mail to you
;; bounced with a "mailing loop" error).
- "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:"
+ "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\
+\\|^X-Content-Length:\\|^X-UIDL:"
"*All headers that match this regexp will be deleted when resending a message."
+ :version "24.4"
:group 'message-interface
:link '(custom-manual "(message)Resending")
:type '(repeat :value-to-internal (lambda (widget value)
regexp))
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
- "*All headers that match this regexp will be deleted when forwarding a message."
+ "*All headers that match this regexp will be deleted when forwarding a message.
+This may also be a list of regexps."
:version "21.1"
:group 'message-forwarding
:type '(repeat :value-to-internal (lambda (widget value)
(widget-editable-list-match widget value)))
regexp))
+(defcustom message-forward-included-headers nil
+ "If non-nil, delete non-matching headers when forwarding a message.
+Only headers that match this regexp will be included. This
+variable should be a regexp or a list of regexps."
+ :version "25.1"
+ :group 'message-forwarding
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
+
(defcustom message-ignored-cited-headers "."
"*Delete these headers from the messages you yank."
:group 'message-insertion
(set-keymap-parent map minibuffer-local-map)
map)
"Keymap for `message-read-from-minibuffer'."
+ ;; FIXME improve type.
+ :type '(restricted-sexp :match-alternatives (symbolp keymapp))
:version "22.1"
:group 'message-various)
(defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
"Format of the \"Whomever writes:\" line.
-The string is formatted using `format-spec'. The following
-constructs are replaced:
+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\".
back to the mail address.
%F The first name if present, e.g.: \"John\".
%L The last name if present, e.g.: \"Doe\".
+ %Z, %z The time zone in the numeric form, e.g.:\"+0000\".
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.
+which is called using the date from the article your replying to, but
+the date in the formatted string will be expressed in the author's
+time zone as much as possible.
+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'."
(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)
- (const :tag "Reply below" 'below))
+ :type '(choice (const :tag "Reply inline" traditional)
+ (const :tag "Reply above" above)
+ (const :tag "Reply below" below))
:group 'message-insertion)
(defcustom message-cite-style nil
"*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 "24.2"
+ :version "24.3"
:group 'message
:link '(custom-manual "(message)Wide Reply")
:type '(choice (const :tag "Yourself" nil)
:type '(radio (const :format "%v " nil)
(string :format "FQDN: %v")))
-(defcustom message-use-idna (and (condition-case nil (require 'idna)
- (file-error))
- (mm-coding-system-p 'utf-8)
- (executable-find idna-program)
- (string= (idna-to-ascii "räksmörgås")
- "xn--rksmrgs-5wao1o")
- t)
+(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))
+ 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
"cat\\|com\\|coop\\|edu\\|gov\\|"
"info\\|int\\|jobs\\|"
"mil\\|mobi\\|museum\\|name\\|net\\|"
- "org\\|pro\\|tel\\|travel\\|uucp\\)")
+ "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
"Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
If FIRST, only remove the first instance of the header.
+If REVERSE, remove headers that doesn't match HEADER.
Return the number of headers removed."
(goto-char (point-min))
(let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))
C-c M-m `message-mark-inserted-region' (mark region with enclosing tags).
C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags).
M-RET `message-newline-and-reformat' (break the line and reformat)."
- (setq local-abbrev-table text-mode-abbrev-table)
(set (make-local-variable 'message-reply-buffer) nil)
(set (make-local-variable 'message-inserted-headers) nil)
(set (make-local-variable 'message-send-actions) nil)
(push-mark)
(message-position-on-field "Summary" "Subject"))
-(eval-when-compile
- (defmacro message-called-interactively-p (kind)
- (condition-case nil
- (progn
- (eval '(called-interactively-p 'any))
- ;; Emacs >=23.2
- `(called-interactively-p ,kind))
- ;; Emacs <23.2
- (wrong-number-of-arguments '(called-interactively-p))
- ;; XEmacs
- (void-function '(interactive-p)))))
-
(defun message-goto-body ()
"Move point to the beginning of the message body."
(interactive)
- (when (and (message-called-interactively-p 'any)
+ (when (and (gmm-called-interactively-p 'any)
(looking-at "[ \t]*\n"))
(expand-abbrev))
(push-mark)
(defun message-in-body-p ()
"Return t if point is in the message body."
- (let ((body (save-excursion (message-goto-body))))
- (>= (point) body)))
+ (>= (point)
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
+ (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))
+ (point))))
(defun message-goto-eoh ()
"Move point to the end of the headers."
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
- (when (and (message-position-on-field "Newsgroups")
- (mail-fetch-field "newsgroups")
- (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
- (insert ","))
- (insert (or (message-fetch-reply-field "newsgroups") "")))
+ (let ((old-newsgroups (mail-fetch-field "newsgroups"))
+ (new-newsgroups (message-fetch-reply-field "newsgroups"))
+ (first t)
+ insert-newsgroups)
+ (message-position-on-field "Newsgroups")
+ (cond
+ ((not new-newsgroups)
+ (error "No Newsgroups to insert"))
+ ((not old-newsgroups)
+ (insert new-newsgroups))
+ (t
+ (setq new-newsgroups (split-string new-newsgroups "[, ]+")
+ old-newsgroups (split-string old-newsgroups "[, ]+"))
+ (dolist (group new-newsgroups)
+ (unless (member group old-newsgroups)
+ (push group insert-newsgroups)))
+ (if (null insert-newsgroups)
+ (error "Newgroup%s already in the header"
+ (if (> (length new-newsgroups) 1)
+ "s" ""))
+ (when old-newsgroups
+ (setq first nil))
+ (dolist (group insert-newsgroups)
+ (unless first
+ (insert ","))
+ (setq first nil)
+ (insert group)))))))
\f
(goto-char (point-max))
;; Insert the signature.
(unless (bolp)
- (insert "\n"))
+ (newline))
(when message-signature-insert-empty-line
- (insert "\n"))
- (insert "-- \n")
+ (newline))
+ (insert "-- ")
+ (newline)
(if (eq signature t)
(insert-file-contents signature-file)
(insert signature))
(goto-char (point-max))
- (or (bolp) (insert "\n")))))
+ (or (bolp) (newline)))))
(defun message-insert-importance-high ()
"Insert header to mark message as important."
(interactive "P")
;; eval the let forms contained in message-cite-style
(eval
- `(let ,message-cite-style
+ `(let ,(if (symbolp message-cite-style)
+ (symbol-value message-cite-style)
+ message-cite-style)
(message--yank-original-internal ',arg))))
(defun message-yank-buffer (buffer)
(defvar gnus-extract-address-components)
(autoload 'format-spec "format-spec")
+(autoload 'gnus-date-get-time "gnus-util")
-(defun message-insert-formatted-citation-line (&optional from date)
+(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.
See `message-citation-line-format'."
;; The optional args are for testing/debugging. They will disappear later.
;; (with-temp-buffer
;; (message-insert-formatted-citation-line
;; "John Doe <john.doe@example.invalid>"
- ;; (current-time))
+ ;; (message-make-date))
;; (buffer-string))
(when (or message-reply-headers (and from date))
(unless from
(net (car (cdr data)))
(name-or-net (or (car data)
(car (cdr data)) from))
- (replydate
- (or
- date
- ;; We need Gnus functionality if the user wants date or time from
- ;; the original article:
- (when (string-match "%[^fnNFL]" message-citation-line-format)
- (autoload 'gnus-date-get-time "gnus-util")
- (gnus-date-get-time (mail-header-date message-reply-headers)))))
+ (time
+ (when (string-match "%[^fnNFL]" message-citation-line-format)
+ (cond ((numberp (car-safe date)) date) ;; backward compatibility
+ (date (gnus-date-get-time date))
+ (t
+ (gnus-date-get-time
+ (setq date (mail-header-date message-reply-headers)))))))
+ (tz (or tz
+ (when (stringp date)
+ (nth 8 (parse-time-string date)))))
(flist
(let ((i ?A) lst)
(when (stringp name)
;; Guess first name and last name:
- (cond ((string-match
- "\\`\\(\\w\\|[-.]\\)+ \\(\\w\\|[-.]\\)+\\'" name)
- (setq fname (nth 0 (split-string name "[ \t]+"))
- lname (nth 1 (split-string name "[ \t]+"))))
- ((string-match
- "\\`\\(\\w\\|[-.]\\)+, \\(\\w\\|[-.]\\)+\\'" name)
- (setq fname (nth 1 (split-string name "[ \t,]+"))
- lname (nth 0 (split-string name "[ \t,]+"))))
- ((string-match
- "\\`\\(\\w\\|[-.]\\)+\\'" name)
- (setq fname name
- lname ""))))
+ (let* ((names (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'"
+ x)
+ x
+ nil))
+ (split-string name "[ \t]+"))))
+ (count (length names)))
+ (cond ((= count 1)
+ (setq fname (car names)
+ lname ""))
+ ((or (= count 2) (= count 3))
+ (setq fname (car names)
+ lname (mapconcat 'identity (cdr names) " ")))
+ ((> count 3)
+ (setq fname (mapconcat 'identity
+ (butlast names (- count 2))
+ " ")
+ lname (mapconcat 'identity
+ (nthcdr 2 names)
+ " "))))
+ (when (string-match "\\(.*\\),\\'" fname)
+ (let ((newlname (match-string 1 fname)))
+ (setq fname lname lname newlname)))))
;; The following letters are not used in `format-time-string':
(push ?E lst) (push "<E>" lst)
(push ?F lst) (push fname lst)
(>= i ?a)))
(push i lst)
(push (condition-case nil
- (format-time-string (format "%%%c" i) replydate)
+ (gmm-format-time-string (format "%%%c" i) time tz)
(error (format ">%c<" i)))
lst))
(setq i (1+ i)))
(defun message-bury (buffer)
"Bury this mail BUFFER."
+ ;; Note that this is not quite the same as (bury-buffer buffer),
+ ;; since bury-buffer does extra stuff with a nil argument.
+ ;; Eg http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg00539.html
+ (with-current-buffer buffer (bury-buffer))
(if message-return-action
- (progn
- (bury-buffer buffer)
- (apply (car message-return-action) (cdr message-return-action)))
- (with-current-buffer buffer (bury-buffer))))
+ (apply (car message-return-action) (cdr message-return-action))))
(defun message-send (&optional arg)
"Send the message in the current buffer.
(list resend-to-addresses)
'("-t"))))))
(unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
- (if errbuf (pop-to-buffer errbuf))
+ (when errbuf
+ (pop-to-buffer errbuf)
+ (setq errbuf nil))
(error "Sending...failed with exit value %d" cpr)))
(when message-interactive
(with-current-buffer errbuf
(require 'sha1)
(let (sha1-maximum-internal-length)
(sha1 (concat (message-unique-id)
- (format "%x%x%x" (random)
- (progn (random t) (random))
- (random))
+ (format "%x%x%x" (random) (random) (random))
(prin1-to-string (recent-keys))
(prin1-to-string (garbage-collect))))))
"Make date string for the Expires header. Expiry in DAYS days.
In posting styles use `(\"Expires\" (make-expires-date 30))'."
- (let* ((cur (decode-time (current-time)))
+ (let* ((cur (decode-time))
(nday (+ days (nth 3 cur))))
(setf (nth 3 cur) nday)
(message-make-date (apply 'encode-time cur))))
;; You might for example insert a "." somewhere (not next to another dot
;; or string boundary), or modify the "fsf" string.
(defun message-unique-id ()
- (random t)
;; Don't use microseconds from (current-time), they may be unsupported.
;; Instead we use this randomly inited counter.
(setq message-unique-id-char
:link '(custom-manual "(message)Movement")
:type 'boolean)
+(defvar visual-line-mode)
+(declare-function beginning-of-visual-line "simple" (&optional n))
+
(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'.
(goto-char
(if (and eoh (or (< eoh here) (= bol here)))
eoh bol)))
- (beginning-of-line n)))
+ (if (and (boundp 'visual-line-mode) visual-line-mode)
+ (beginning-of-visual-line n)
+ (beginning-of-line n))))
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
", "))
mct (message-fetch-field "mail-copies-to")
author (or (message-fetch-field "mail-reply-to")
- (message-fetch-field "reply-to")
- (message-fetch-field "from")
- "")
+ (message-fetch-field "reply-to"))
mft (and message-use-mail-followup-to
- (message-fetch-field "mail-followup-to"))))
+ (message-fetch-field "mail-followup-to")))
+ ;; Make sure this message goes to the author if this is a wide
+ ;; reply, since Reply-To address may be a list address a mailing
+ ;; list server added.
+ (when (and wide author)
+ (setq cc (concat author ", " cc)))
+ (when (or wide (not author))
+ (setq author (or (message-fetch-field "from") ""))))
;; Handle special values of Mail-Copies-To.
(when mct
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
"From: " from "\n"
- "Subject: cmsg cancel " message-id "\n"
+ "Subject: cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
(concat "Distribution: " distribution "\n")
(let ((buffer-read-only nil))
(erase-buffer)
(insert-file-contents file-name nil)))
- (t (error "message-recover cancelled")))))
+ (t (error "message-recover canceled")))))
;;; Washing Subject:
(message-remove-ignored-headers b e)))
(defun message-remove-ignored-headers (b e)
- (when message-forward-ignored-headers
+ (when (or message-forward-ignored-headers
+ message-forward-included-headers)
(save-restriction
(narrow-to-region b e)
(goto-char b)
(narrow-to-region (point)
(or (search-forward "\n\n" nil t) (point)))
- (let ((ignored (if (stringp message-forward-ignored-headers)
- (list message-forward-ignored-headers)
- message-forward-ignored-headers)))
- (dolist (elem ignored)
- (message-remove-header elem t))))))
-
-(defun message-forward-make-body-mime (forward-buffer)
+ (when message-forward-ignored-headers
+ (let ((ignored (if (stringp message-forward-ignored-headers)
+ (list message-forward-ignored-headers)
+ message-forward-ignored-headers)))
+ (dolist (elem ignored)
+ (message-remove-header elem t))))
+ (when message-forward-included-headers
+ (message-remove-header
+ (if (listp message-forward-included-headers)
+ (regexp-opt message-forward-included-headers)
+ message-forward-included-headers)
+ t nil t)))))
+
+(defun message-forward-make-body-mime (forward-buffer &optional beg end)
(let ((b (point)))
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
(save-restriction
(narrow-to-region (point) (point))
- (mml-insert-buffer forward-buffer)
+ (insert-buffer-substring forward-buffer beg end)
+ (mml-quote-region (point-min) (point-max))
(goto-char (point-min))
(when (looking-at "From ")
(replace-match "X-From-Line: "))
(goto-char (point-max))))
(setq e (point))
(insert "<#/mml>\n")
- (when (and (not message-forward-decoded-p)
- message-forward-ignored-headers)
+ (when (not message-forward-decoded-p)
(message-remove-ignored-headers b e))))
(defun message-forward-make-body-digest-plain (forward-buffer)
(defun message-tab ()
"Complete names according to `message-completion-alist'.
-Execute function specified by `message-tab-body-function' when not in
-those headers."
+Execute function specified by `message-tab-body-function' when
+not in those headers. If that variable is nil, indent with the
+regular text mode tabbing command."
(interactive)
(cond
((if (and (boundp 'completion-fail-discreetly)
;; falling back to message-tab-body-function.
(lambda () (funcall fun) 'completion-attempted)))))
-(eval-and-compile
- (condition-case nil
- (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (eval '(display-completion-list nil "")))
- (defalias 'message-display-completion-list 'display-completion-list))
- (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
- (defun message-display-completion-list (completions &optional ignore)
- "Display the list of completions, COMPLETIONS, using `standard-output'."
- (display-completion-list completions)))))
-
(defun message-expand-group ()
"Expand the group name under point."
- (let* ((b (save-excursion
- (save-restriction
- (narrow-to-region
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward "^:")
- (1+ (point)))
- (point))
- (skip-chars-backward "^, \t\n") (point))))
- (completion-ignore-case t)
- (e (progn (skip-chars-forward "^,\t\n ") (point)))
- (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)))
- (message-completion-in-region e b hashtb)))
+ (let ((b (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "^:")
+ (1+ (point)))
+ (point))
+ (skip-chars-backward "^, \t\n") (point))))
+ (completion-ignore-case t)
+ (e (progn (skip-chars-forward "^,\t\n ") (point)))
+ group collection)
+ (when (and (boundp 'gnus-active-hashtb)
+ gnus-active-hashtb)
+ (mapatoms
+ (lambda (symbol)
+ (setq group (symbol-name symbol))
+ (push (if (string-match "[^\000-\177]" group)
+ (gnus-group-decoded-name group)
+ 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 (e b hashtb)
+ (lambda (b e hashtb)
(let* ((string (buffer-substring b e))
(completions (all-completions string hashtb))
comp)
(let ((buffer-read-only nil))
(erase-buffer)
(let ((standard-output (current-buffer)))
- (message-display-completion-list (sort completions 'string<)
- string))
+ (display-completion-list (sort completions 'string<)))
(setq buffer-read-only nil)
(goto-char (point-min))
(delete-region (point)
(if (fboundp 'mail-abbrevs-setup)
(let ((minibuffer-setup-hook 'mail-abbrevs-setup)
(minibuffer-local-map message-minibuffer-local-map))
- (flet ((mail-abbrev-in-expansion-header-p nil t))
+ (gmm-flet ((mail-abbrev-in-expansion-header-p nil t))
(read-from-minibuffer prompt initial-contents)))
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
(minibuffer-local-map message-minibuffer-local-map))
(message-fetch-field hdr) t))
", "))))
+;;; multipart/related and HTML support.
+
+(defun message-make-html-message-with-image-files (files)
+ (interactive (list (dired-get-marked-files nil current-prefix-arg)))
+ (message-mail)
+ (message-goto-body)
+ (insert "<#part type=text/html>\n\n")
+ (dolist (file files)
+ (insert (format "<img src=%S>\n\n" file)))
+ (message-goto-to))
+
(when (featurep 'xemacs)
(require 'messagexmas)
(message-xmas-redefine))
(run-hooks 'message-load-hook)
;; Local Variables:
-;; coding: iso-8859-1
+;; coding: utf-8
;; End:
;;; message.el ends here
projects / gnus / blobdiff