X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=992e237b45ca2da08237f42c68e749db69bde550;hb=1d6b09cfca805e5becddda685a0340efd6034fda;hp=755cc8c5394b4e556dc65b6efb7e01e4459b29c9;hpb=8f7476d4cfadb358d635238ae62c48a89efc6db2;p=gnus diff --git a/lisp/message.el b/lisp/message.el index 755cc8c53..992e237b4 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,6 +1,6 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news @@ -28,9 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) @@ -50,6 +47,7 @@ (require 'mml) (require 'rfc822) (require 'format-spec) +(require 'dired) (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ @@ -268,7 +266,7 @@ This is a list of regexps and regexp matches." :type 'sexp) (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:" + "^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 @@ -535,7 +533,7 @@ If t, use `message-user-organization-file'." (setq orgfile f))) orgfile) "*Local news organization file." - :type 'file + :type '(choice (const nil) file) :link '(custom-manual "(message)News Headers") :group 'message-headers) @@ -614,7 +612,8 @@ Done before generating the new subject of a forward." 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) @@ -624,6 +623,19 @@ Done before generating the new subject of a forward." (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 @@ -972,6 +984,8 @@ the signature is inserted." (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) @@ -996,20 +1010,24 @@ configuration. See the variable `gnus-cite-attribution-suffix'." (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 \". %n The mail address, e.g. \"john.doe@example.invalid\". %N The real name if present, e.g.: \"John Doe\", else fall back to the mail address. - %F The first name if present, e.g.: \"John\". + %F The first name if present, e.g.: \"John\", else fall + back to the mail address. %L The last name if present, e.g.: \"Doe\". + %Z, %z The time zone in the numeric form, e.g.:\"+0000\". 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'." @@ -1142,9 +1160,9 @@ e.g. using `gnus-posting-styles': (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 @@ -1783,13 +1801,17 @@ no, only reply back to the author." :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 @@ -1946,14 +1968,52 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." "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 ;; "dead" nato bitnet uucp "Regular expression that matches a valid FQDN." ;; see also: gnus-button-valid-fqdn-regexp - :version "22.1" + :version "25.1" :group 'message-headers :type 'regexp) @@ -2291,7 +2351,7 @@ Leading \"Re: \" is not stripped by this function. Use the function ((not (string-match (concat "^[ \t]*" (regexp-quote new-subject) - " \t]*$") + "[ \t]*$") old-subject)) ; yes, it really is a new subject ;; delete eventual Re: prefix (setq old-subject @@ -2493,6 +2553,7 @@ With prefix-argument just set Follow-Up, don't cross-post." "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) ":"))) @@ -2983,7 +3044,6 @@ C-c M-n `message-insert-disposition-notification-to' (request receipt). 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) @@ -3558,15 +3618,16 @@ Message buffers and is not meant to be called directly." (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." @@ -3950,9 +4011,13 @@ This function uses `mail-citation-hook' if that is non-nil." (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. @@ -3960,7 +4025,7 @@ See `message-citation-line-format'." ;; (with-temp-buffer ;; (message-insert-formatted-citation-line ;; "John Doe " - ;; (current-time)) + ;; (message-make-date)) ;; (buffer-string)) (when (or message-reply-headers (and from date)) (unless from @@ -3977,33 +4042,49 @@ See `message-citation-line-format'." (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 "" lst) - (push ?F lst) (push fname lst) + (push ?F lst) (push (or fname name-or-net) lst) ;; We might want to use "" instead of "" later. (push ?J lst) (push "" lst) (push ?K lst) (push "" lst) @@ -4027,7 +4108,7 @@ See `message-citation-line-format'." (>= 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))) @@ -4141,11 +4222,12 @@ Instead, just auto-save the buffer and then bury it." (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. @@ -4783,7 +4865,9 @@ that instead." (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 @@ -4867,6 +4951,11 @@ evaluates `message-send-mail-hook' just before sending a message. It is useful if your ISP requires the POP-before-SMTP authentication. See the Gnus manual for details." (run-hooks 'message-send-mail-hook) + ;; Change header-delimiter to be what smtpmail expects. + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n")) (smtpmail-send-it)) (defun message-send-mail-with-mailclient () @@ -5553,7 +5642,7 @@ If NOW, use that time instead." "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)))) @@ -5810,7 +5899,7 @@ give as trustworthy answer as possible." (defun message-make-fqdn () "Return user's fully qualified domain name." - (let* ((system-name (system-name)) + (let* ((sysname (system-name)) (user-mail (message-user-mail-address)) (user-domain (if (and user-mail @@ -5824,10 +5913,10 @@ give as trustworthy answer as possible." (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 system-name) - (not (string-match message-bogus-system-names system-name))) + ((and (string-match message-valid-fqdn-regexp sysname) + (not (string-match message-bogus-system-names sysname))) ;; `system-name' returned the right result. - system-name) + sysname) ;; Try `mail-host-address'. ((and (boundp 'mail-host-address) (stringp mail-host-address) @@ -5842,7 +5931,7 @@ give as trustworthy answer as possible." user-domain) ;; Default to this bogus thing. (t - (concat system-name + (concat sysname ".i-did-not-set--mail-host-address--so-tickle-me"))))) (defun message-make-domain () @@ -6315,6 +6404,9 @@ they are." :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'. @@ -6341,7 +6433,9 @@ between beginning of field and 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." @@ -7189,7 +7283,7 @@ If ARG, allow editing of the cancellation message." (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") @@ -7249,7 +7343,7 @@ header line with the old Message-ID." (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: @@ -7408,24 +7502,33 @@ Optional DIGEST will use digest to forward." (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: ")) @@ -7465,8 +7568,7 @@ Optional DIGEST will use digest to forward." (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) @@ -7961,8 +8063,9 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed." (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) @@ -7990,37 +8093,36 @@ those headers." ;; 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) @@ -8045,8 +8147,7 @@ those headers." (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) @@ -8456,6 +8557,17 @@ Used in `message-simplify-recipients'." (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 "\n\n" file))) + (message-goto-to)) + (when (featurep 'xemacs) (require 'messagexmas) (message-xmas-redefine)) @@ -8465,7 +8577,7 @@ Used in `message-simplify-recipients'." (run-hooks 'message-load-hook) ;; Local Variables: -;; coding: iso-8859-1 +;; coding: utf-8 ;; End: ;;; message.el ends here