(eval-when-compile
(require 'cl)
+ (defvar gnus-message-group-art)
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
(require 'canlock)
(require 'mailheader)
(require 'mml)
(require 'rfc822)
(eval-and-compile
- (autoload 'sha1 "sha1-el"))
+ (autoload 'sha1 "sha1-el")
+ (autoload 'gnus-find-method-for-group "gnus")
+ (autoload 'nnvirtual-find-group-art "nnvirtual"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
the article has been posted to will be inserted there.
If this variable is nil, no such courtesy message will be added."
:group 'message-sending
- :type 'string)
+ :type '(radio (string :format "%t: %v\n" :size 0) (const nil)))
(defcustom message-ignored-bounced-headers
"^\\(Received\\|Return-Path\\|Delivered-To\\):"
`approved', `sender', `empty', `empty-headers', `message-id', `from',
`subject', `shorten-followup-to', `existing-newsgroups',
`buffer-file-name', `unchanged', `newsgroups', `reply-to',
-'continuation-headers', and `long-header-lines'."
+`continuation-headers', `long-header-lines', `invisible-text' and
+`illegible-text'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
(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.googgle.com\) respect this header."
+Archives \(such as groups.google.com\) respect this header."
:type 'string
:group 'message-various)
"X-No-Archive: Yes - save http://groups.google.com/"
"Note to insert why you wouldn't want this posting archived.
If nil, don't insert any text in the body."
- :type 'string
+ :type '(radio (string :format "%t: %v\n" :size 0)
+ (const nil))
:group 'message-various)
;;; Crossposts and Followups
:group 'message-forwarding
:type '(radio (function-item message-forward-subject-author-subject)
(function-item message-forward-subject-fwd)
+ (function-item message-forward-subject-name-subject)
(repeat :tag "List of functions" function)))
(defcustom message-forward-as-mime t
- "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message."
+ "*Non-nil means forward messages as an inline/rfc822 MIME section.
+Otherwise, directly inline the old message in the forwarded message."
:version "21.1"
:group 'message-forwarding
:type 'boolean)
(defcustom message-forward-show-mml t
- "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged."
+ "*Non-nil means show forwarded messages as mml.
+Otherwise, forwarded messages are unchanged."
:version "21.1"
:group 'message-forwarding
:type 'boolean)
(defcustom message-forward-before-signature t
- "*If non-nil, put forwarded message before signature, else after."
+ "*Non-nil means put forwarded message before signature, else after."
:group 'message-forwarding
:type 'boolean)
(defcustom message-wash-forwarded-subjects nil
- "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
+ "*Non-nil means try to remove as much cruft as possible from the subject.
+Done before generating the new subject of a forward."
:group 'message-forwarding
:type 'boolean)
(defcustom message-subscribed-address-functions nil
"*Specifies functions for determining list subscription.
-If nil, do not attempt to determine list subscribtion with functions.
+If nil, do not attempt to determine list subscription with functions.
If non-nil, this variable contains a list of functions which return
regular expressions to match lists. These functions can be used in
conjunction with `message-subscribed-regexps' and
If nil, do not look at any files to determine list subscriptions. If
non-nil, each line of this file should be a mailing list address."
:group 'message-interface
- :type 'string)
+ :type '(radio (file :format "%t: %v\n" :size 0)
+ (const nil)))
(defcustom message-subscribed-addresses nil
"*Specifies a list of addresses the user is subscribed to.
If nil, do not use any predefined list subscriptions. This list of
-addresses can be used in conjuction with
+addresses can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-regexps'."
:group 'message-interface
:type '(repeat string))
(defcustom message-subscribed-regexps nil
"*Specifies a list of addresses the user is subscribed to.
If nil, do not use any predefined list subscriptions. This list of
-regular expressions can be used in conjuction with
+regular expressions can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-addresses'."
:group 'message-interface
:type '(repeat regexp))
"*Domain part of Messsage-Ids."
:group 'message-headers
:link '(custom-manual "(message)News Headers")
- :type 'string)
+ :type '(radio (const :format "%v " nil)
+ (string :format "FQDN: %v\n" :size 0)))
(defcustom message-use-idna (and (condition-case nil (require 'idna)
(file-error))
(mm-coding-system-p 'utf-8)
+ (executable-find idna-program)
'ask)
"Whether to encode non-ASCII in domain names into ASCII according to IDNA."
:group 'message-headers
(looking-at message-unix-mail-delimiter))))
(defun message-fetch-field (header &optional not-all)
- "The same as `mail-fetch-field', only remove all newlines."
+ "The same as `mail-fetch-field', only remove all newlines.
+The buffer is expected to be narrowed to just the header of the message;
+see `message-narrow-to-headers-or-head'."
(let* ((inhibit-point-motion-hooks t)
(case-fold-search t)
(value (mail-fetch-field header nil (not not-all))))
(mail-narrow-to-head)
(message-fetch-field header))))
-(defun message-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))
- (byte-code-function-p form)))
-
(defun message-strip-list-identifiers (subject)
"Remove list identifiers in `gnus-list-identifiers' from string SUBJECT."
(require 'gnus-sum) ; for gnus-list-identifiers
(zerop (string-width new-subject))
(string-match "^[ \t]*$" new-subject))))
(save-excursion
- (let ((old-subject (message-fetch-field "Subject")))
+ (let ((old-subject
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "Subject"))))
(cond ((not old-subject)
(error "No current subject"))
((not (string-match
(defun message-reduce-to-to-cc ()
"Replace contents of To: header with contents of Cc: or Bcc: header."
(interactive)
- (let ((cc-content (message-fetch-field "cc"))
+ (let ((cc-content
+ (save-restriction (message-narrow-to-headers)
+ (message-fetch-field "cc")))
(bcc nil))
(if (and (not cc-content)
- (setq cc-content (message-fetch-field "bcc")))
+ (setq cc-content
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "bcc"))))
(setq bcc t))
(cond (cc-content
(save-excursion
(message-goto-to)
(message-delete-line)
(insert (concat "To: " cc-content "\n"))
- (message-remove-header (if bcc
- "bcc"
- "cc")))))))
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header (if bcc
+ "bcc"
+ "cc"))))))))
;;; End of functions adopted from `message-utils.el'.
["Insert Signature" message-insert-signature t]
["Caesar (rot13) Message" message-caesar-buffer-body t]
["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
- ["Elide Region" message-elide-region
+ ["Elide Region" message-elide-region
:active (message-mark-active-p)
,@(if (featurep 'xemacs) nil
'(:help "Replace text in region with an ellipsis"))]
- ["Delete Outside Region" message-delete-not-region
+ ["Delete Outside Region" message-delete-not-region
:active (message-mark-active-p)
,@(if (featurep 'xemacs) nil
'(:help "Delete all quoted text outside region"))]
(when (eq message-mail-alias-type 'abbrev)
(if (fboundp 'mail-abbrevs-setup)
(mail-abbrevs-setup)
- (mail-aliases-setup)))
+ (if (fboundp 'mail-aliases-setup) ; warning avoidance
+ (mail-aliases-setup))))
(unless buffer-file-name
(message-set-auto-save-file-name))
(unless (buffer-base-buffer)
Cc: header are also put into the MFT."
(interactive "P")
- (message-remove-header "Mail-Followup-To")
- (let* ((cc (and include-cc (message-fetch-field "Cc")))
- (tos (if cc
- (concat (message-fetch-field "To") "," cc)
- (message-fetch-field "To"))))
+ (let* (cc tos)
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Mail-Followup-To")
+ (setq cc (and include-cc (message-fetch-field "Cc")))
+ (setq tos (if cc
+ (concat (message-fetch-field "To") "," cc)
+ (message-fetch-field "To"))))
(message-goto-mail-followup-to)
(insert (concat tos ", " user-mail-address))))
((and (null message-signature)
force)
t)
- ((message-functionp message-signature)
+ ((functionp message-signature)
(funcall message-signature))
((listp message-signature)
(eval message-signature))
"Insert header to mark message as important."
(interactive)
(save-excursion
- (message-remove-header "Importance")
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Importance"))
(message-goto-eoh)
(insert "Importance: high\n")))
"Insert header to mark message as unimportant."
(interactive)
(save-excursion
- (message-remove-header "Importance")
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Importance"))
(message-goto-eoh)
(insert "Importance: low\n")))
(let ((valid '("high" "normal" "low"))
(new "high")
cur)
- (when (setq cur (message-fetch-field "Importance"))
- (message-remove-header "Importance")
- (setq new (cond ((string= cur "high")
- "low")
- ((string= cur "low")
- "normal")
- (t
- "high"))))
+ (save-restriction
+ (message-narrow-to-headers)
+ (when (setq cur (message-fetch-field "Importance"))
+ (message-remove-header "Importance")
+ (setq new (cond ((string= cur "high")
+ "low")
+ ((string= cur "low")
+ "normal")
+ (t
+ "high")))))
(message-goto-eoh)
(insert (format "Importance: %s\n" new)))))
Note that this should not be used in newsgroups."
(interactive)
(save-excursion
- (message-remove-header "Disposition-Notification-To")
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Disposition-Notification-To"))
(message-goto-eoh)
(insert (format "Disposition-Notification-To: %s\n"
- (or (message-fetch-field "From") (message-make-from))))))
+ (or (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "From")))
+ (message-make-from))))))
(defun message-elide-region (b e)
"Elide the text in the region.
(add-text-properties point (1+ point)
'(invisible nil intangible nil)))))
;; Make invisible text visible.
+ ;; It doesn't seem as if this is useful, since the invisible property
+ ;; is clobbered by an after-change hook anyhow.
(message-check 'invisible-text
(let ((points (message-text-with-property 'invisible)))
(when points
(goto-char (car points))
(dolist (point points)
- (add-text-properties point (1+ point)
- '(invisible nil face highlight
- font-lock-face highlight)))
+ (put-text-property point (1+ point) 'invisible nil)
+ (message-overlay-put (message-make-overlay point (1+ point))
+ 'face 'highlight))
(unless (yes-or-no-p
- "Invisible text found and made visible; continue posting? ")
+ "Invisible text found and made visible; continue sending? ")
(error "Invisible text found and made visible")))))
(message-check 'illegible-text
(let (found choice)
(when (let ((char (char-after)))
(or (< (mm-char-int char) 128)
(and (mm-multibyte-p)
- (memq (char-charset char)
- '(eight-bit-control eight-bit-graphic
- control-1)))))
- (add-text-properties (point) (1+ (point))
- '(font-lock-face highlight face highlight))
+ (> (length (mm-find-mime-charset-region
+ (point) (point-max)))
+ 1))))
+ (message-overlay-put (message-make-overlay (point) (1+ (point)))
+ 'face 'highlight)
(setq found t))
(forward-char)
(skip-chars-forward mm-7bit-chars))
(when found
(setq choice
(gnus-multiple-choice
- "Illegible text found. Continue posting?"
- '((?d "Remove and continue posting")
- (?r "Replace with dots and continue posting")
- (?i "Ignore and continue posting")
+ "Non-printable characters found. Continue sending?"
+ '((?d "Remove non-printable characters and send")
+ (?r "Replace non-printable characters with dots and send")
+ (?i "Ignore non-printable characters and send")
(?e "Continue editing"))))
(if (eq choice ?e)
- (error "Illegible text found"))
+ (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)
(and (mm-multibyte-p)
+ ;; Fixme: Wrong for Emacs 22 and for things
+ ;; like undecable utf-8. Should at least
+ ;; use find-coding-systems-region.
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
control-1)))))
(if (eq choice ?i)
- (remove-text-properties (point) (1+ (point))
- '(font-lock-face highlight face highlight))
+ (message-kill-all-overlays)
(delete-char 1)
(when (eq choice ?r)
(insert "."))))
(ignore-errors
(cond
;; A simple function.
- ((message-functionp (car actions))
+ ((functionp (car actions))
(funcall (car actions)))
;; Something to be evaled.
(t
(or (= (preceding-char) ?\n)
(insert ?\n))
(message-cleanup-headers)
+ ;; FIXME: we're inserting the courtesy copy after encoding.
+ ;; This is wrong if the courtesy copy string contains
+ ;; non-ASCII characters. -- jh
(when
(save-restriction
(message-narrow-to-headers)
(or (message-fetch-field "cc")
(message-fetch-field "bcc")
(message-fetch-field "to"))
- (let ((content-type (message-fetch-field "content-type")))
- (or
- (not content-type)
- (string= "text/plain"
- (car
- (mail-header-parse-content-type
- content-type)))))))
+ (let ((content-type (message-fetch-field
+ "content-type")))
+ (and
+ (or
+ (not content-type)
+ (string= "text/plain"
+ (car
+ (mail-header-parse-content-type
+ content-type))))
+ (not
+ (string= "base64"
+ (message-fetch-field
+ "content-transfer-encoding")))))))
(message-insert-courtesy-copy))
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
(if resend-to-addresses
(list resend-to-addresses)
'("-t"))))))
- (unless (or (null cpr) (zerop cpr))
+ (unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
(error "Sending...failed with exit value %d" cpr)))
(when message-interactive
(save-excursion
;; free for -inject-arguments -- a big win for the user and for us
;; since we don't have to play that double-guessing game and the user
;; gets full control (no gestapo'ish -f's, for instance). --sj
- (if (message-functionp message-qmail-inject-args)
+ (if (functionp message-qmail-inject-args)
(funcall message-qmail-inject-args)
message-qmail-inject-args)))
;; qmail-inject doesn't say anything on it's stdout/stderr,
(smtpmail-send-it))
(defun message-canlock-generate ()
- "Return a string that is non-trival to guess.
+ "Return a string that is non-trivial to guess.
Do not use this for anything important, it is cryptographically weak."
(let (sha1-maximum-internal-length)
(sha1 (concat (message-unique-id)
(defun message-send-news (&optional arg)
(let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
(case-fold-search nil)
- (method (if (message-functionp message-post-method)
+ (method (if (functionp message-post-method)
(funcall message-post-method arg)
message-post-method))
(newsgroups-field (save-restriction
(if followup-to
(concat newsgroups "," followup-to)
newsgroups)))
- (post-method (if (message-functionp message-post-method)
+ (post-method (if (functionp message-post-method)
(funcall message-post-method)
message-post-method))
;; KLUDGE to handle nnvirtual groups. Doing this right
"Make an Organization header."
(let* ((organization
(when message-user-organization
- (if (message-functionp message-user-organization)
+ (if (functionp message-user-organization)
(funcall message-user-organization)
message-user-organization))))
(with-temp-buffer
(defun message-make-distribution ()
"Make a Distribution header."
(let ((orig-distribution (message-fetch-reply-field "distribution")))
- (cond ((message-functionp message-distribution-function)
+ (cond ((functionp message-distribution-function)
(funcall message-distribution-function))
(t orig-distribution))))
(aset tmp (1- (match-end 0)) ?-))
(string-match "[\\()]" tmp)))))
(insert fullname)
+ (goto-char (point-min))
+ ;; Look for a character that cannot appear unquoted
+ ;; according to RFC 822.
+ (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
+ ;; Quote fullname, escaping specials.
+ (goto-char (point-min))
+ (insert "\"")
+ (while (re-search-forward "[\"\\]" nil 1)
+ (replace-match "\\\\\\&" t))
+ (insert "\""))
(insert " <" login ">"))
(t ; 'parens or default
(insert login " (")
user-domain)
;; Default to this bogus thing.
(t
- (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me")))))
+ (concat system-name
+ ".i-did-not-set--mail-host-address--so-tickle-me")))))
(defun message-make-host-name ()
"Return the name of the host."
;; is something that is nil, then we do not insert
;; this header.
(setq header (cdr elem))
- (or (and (message-functionp (cdr elem))
+ (or (and (functionp (cdr elem))
(funcall (cdr elem)))
(and (boundp (cdr elem))
(symbol-value (cdr elem)))))
;; this function.
(or (and (stringp (cdr elem))
(cdr elem))
- (and (message-functionp (cdr elem))
+ (and (functionp (cdr elem))
(funcall (cdr elem)))))
((and (boundp header)
(symbol-value header))
(sit-for 0)))
(defcustom message-beginning-of-line t
- "Whether C-a goes to beginning of header values."
+ "Whether \\<message-mode-map>\\[message-beginning-of-line]\
+ goes to beginning of header values."
:group 'message-buffers
:type 'boolean)
(defun message-beginning-of-line (&optional n)
- "Move point to beginning of header value or to beginning of line."
+ "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. If point
+is already there, move point to beginning of line. Therefore,
+repeated calls will toggle point between beginning of field and
+beginning of line."
(interactive "p")
(let ((zrs 'zmacs-region-stays))
(when (and (interactive-p) (boundp zrs))
"*")))
;; Check whether `message-generate-new-buffers' is a function,
;; and if so, call it.
- ((message-functionp message-generate-new-buffers)
+ ((functionp message-generate-new-buffers)
(funcall message-generate-new-buffers type to group))
((eq message-generate-new-buffers 'unsent)
(generate-new-buffer-name
;; Allow customizations to have their say.
(if (not wide)
;; This is a regular reply.
- (when (message-functionp message-reply-to-function)
+ (when (functionp message-reply-to-function)
(save-excursion
(setq follow-to (funcall message-reply-to-function))))
;; This is a followup.
- (when (message-functionp message-wide-reply-to-function)
+ (when (functionp message-wide-reply-to-function)
(save-excursion
(setq follow-to
(funcall message-wide-reply-to-function)))))
(if (search-forward "\n\n" nil t)
(1- (point))
(point-max)))
- (when (message-functionp message-followup-to-function)
+ (when (functionp message-followup-to-function)
(setq follow-to
(funcall message-followup-to-function)))
(setq from (message-fetch-field "from")
cur)))
+(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
+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."
+ ;; Canlock-logic as suggested by Per Abrahamsen
+ ;; <abraham@dina.kvl.dk>
+ ;;
+ ;; IF article has cancel-lock THEN
+ ;; IF we can verify it THEN
+ ;; issue cancel
+ ;; ELSE
+ ;; error: cancellock: article is not yours
+ ;; ELSE
+ ;; Use old rules, comparing sender...
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head-1)
+ (if (message-fetch-field "Cancel-Lock")
+ (if (null (canlock-verify))
+ t
+ (error "Failed to verify Cancel-lock: This article is not yours"))
+ (let (sender from)
+ (or
+ (message-gnksa-enable-p 'cancel-messages)
+ (and (setq sender (message-fetch-field "sender"))
+ (string-equal (downcase sender)
+ (downcase (message-make-sender))))
+ ;; Email address in From field equals to our address
+ (and (setq from (message-fetch-field "from"))
+ (string-equal
+ (downcase (cadr (mail-extract-address-components from)))
+ (downcase (cadr (mail-extract-address-components
+ (message-make-from))))))
+ ;; Email address in From field matches
+ ;; 'message-alternative-emails' regexp
+ (and from
+ message-alternative-emails
+ (string-match
+ message-alternative-emails
+ (cadr (mail-extract-address-components from))))))))))
;;;###autoload
(defun message-cancel-news (&optional arg)
(interactive "P")
(unless (message-news-p)
(error "This is not a news article; canceling is impossible"))
- (let (from newsgroups message-id distribution buf sender)
+ (let (from newsgroups message-id distribution buf)
(save-excursion
;; Get header info from original article.
(save-restriction
(message-narrow-to-head-1)
(setq from (message-fetch-field "from")
- sender (message-fetch-field "sender")
newsgroups (message-fetch-field "newsgroups")
message-id (message-fetch-field "message-id" t)
distribution (message-fetch-field "distribution")))
;; Make sure that this article was written by the user.
- (unless (or
- ;; Canlock-logic as suggested by Per Abrahamsen
- ;; <abraham@dina.kvl.dk>
- ;;
- ;; IF article has cancel-lock THEN
- ;; IF we can verify it THEN
- ;; issue cancel
- ;; ELSE
- ;; error: cancellock: article is not yours
- ;; ELSE
- ;; Use old rules, comparing sender...
- (if (message-fetch-field "Cancel-Lock")
- (if (null (canlock-verify))
- t
- (error "Failed to verify Cancel-lock: This article is not yours"))
- nil)
- (message-gnksa-enable-p 'cancel-messages)
- (and sender
- (string-equal
- (downcase sender)
- (downcase (message-make-sender))))
- (string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
- (message-make-from))))))
+ (unless (message-is-yours-p)
(error "This article is not yours"))
(when (yes-or-no-p "Do you really want to cancel this article? ")
;; Make control message.
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
(interactive)
- (let ((cur (current-buffer))
- (sender (message-fetch-field "sender"))
- (from (message-fetch-field "from")))
+ (let ((cur (current-buffer)))
;; Check whether the user owns the article that is to be superseded.
- (unless (or
- ;; Canlock-logic as suggested by Per Abrahamsen
- ;; <abraham@dina.kvl.dk>
- ;;
- ;; IF article has cancel-lock THEN
- ;; IF we can verify it THEN
- ;; issue cancel
- ;; ELSE
- ;; error: cancellock: article is not yours
- ;; ELSE
- ;; Use old rules, comparing sender...
- (if (message-fetch-field "Cancel-Lock")
- (if (null (canlock-verify))
- t
- (error "Failed to verify Cancel-lock: This article is not yours"))
- nil)
- (message-gnksa-enable-p 'cancel-messages)
- (and sender
- (string-equal
- (downcase sender)
- (downcase (message-make-sender))))
- (string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
- (message-make-from))))))
+ (unless (message-is-yours-p)
(error "This article is not yours"))
;; Get a normal message buffer.
(message-pop-to-buffer (message-buffer-name "supersede"))
;; Apply funcs in order, passing subject generated by previous
;; func to the next one.
(while funcs
- (when (message-functionp (car funcs))
+ (when (functionp (car funcs))
(setq subject (funcall (car funcs) subject)))
(setq funcs (cdr funcs)))
subject))))
(rmail-msg-restore-non-pruned-header)))
(message-forward-make-body forward-buffer))
+(eval-when-compile (defvar rmail-enable-mime-composing))
+
+;; Fixme: Should have defcustom.
;;;###autoload
(defun message-insinuate-rmail ()
- "Let RMAIL uses message to forward."
+ "Let RMAIL use message to forward."
(interactive)
(setq rmail-enable-mime-composing t)
(setq rmail-insert-mime-forwarded-message-function
(defalias 'message-make-overlay 'make-overlay)
(defalias 'message-delete-overlay 'delete-overlay)
(defalias 'message-overlay-put 'overlay-put)
+(defun message-kill-all-overlays ()
+ (if (featurep 'xemacs)
+ (map-extents (lambda (extent ignore) (delete-extent extent)))
+ (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))))
;; Support for toolbar
(eval-when-compile
(list list))))
(defun message-generate-new-buffer-clone-locals (name &optional varstr)
- "Create and return a buffer with name based on NAME using `generate-new-buffer.'
+ "Create and return a buffer with name based on NAME using `generate-new-buffer'.
Then clone the local variables and values from the old buffer to the
new one, cloning only the locals having a substring matching the
-regexp varstr."
+regexp VARSTR."
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (generate-new-buffer name))
projects / gnus / blobdiff