(require 'cl)
(require 'smtp)
(defvar gnus-message-group-art)
- (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+ (defvar gnus-list-identifiers) ; gnus-sum is required where necessary
+ (require 'hashcash))
(require 'canlock)
(require 'mailheader)
(require 'nnheader)
(defcustom message-fcc-externalize-attachments nil
"If non-nil, attachments are included as external parts in Fcc copies."
+ :version "21.4"
:type 'boolean
:group 'message-sending)
`message-subject-trailing-was-query' is t, always strip the trailing
old subject. In this case, `message-subject-trailing-was-regexp' is
used."
+ :version "21.4"
:type '(choice (const :tag "never" nil)
(const :tag "always strip" t)
(const ask))
`message-subject-trailing-was-regexp' instead.
It is okay to create some false positives here, as the user is asked."
+ :version "21.4"
:group 'message-various
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
matched against `message-subject-trailing-was-regexp' in
`message-strip-subject-trailing-was'. You should use a regexp creating very
few false positives here."
+ :version "21.4"
:group 'message-various
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
(defcustom message-mark-insert-begin
"--8<---------------cut here---------------start------------->8---\n"
"How to mark the beginning of some inserted text."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
(defcustom message-mark-insert-end
"--8<---------------cut here---------------end--------------->8---\n"
"How to mark the end of some inserted text."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
"X-No-Archive: Yes\n"
"Header to insert when you don't want your article to be archived.
Archives \(such as groups.google.com\) respect this header."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Header Commands")
: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."
+ :version "21.4"
:type '(radio (string :format "%t: %v\n" :size 0)
(const nil))
:link '(custom-manual "(message)Header Commands")
If nil, `message-cross-post-followup-to' will only do a followup. Note that
you can explicitly override this setting by calling
`message-cross-post-followup-to' with a prefix."
+ :version "21.4"
:type 'boolean
:group 'message-various)
(defcustom message-cross-post-note
"Crosspost & Followup-To: "
"Note to insert before signature to notify of xpost and follow-up."
+ :version "21.4"
:type 'string
:group 'message-various)
(defcustom message-followup-to-note
"Followup-To: "
"Note to insert before signature to notify of follow-up only."
+ :version "21.4"
:type 'string
:group 'message-various)
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
for `message-cross-post-insert-note'."
+ :version "21.4"
:type 'function
:group 'message-various)
(defcustom message-insert-canlock t
"Whether to insert a Cancel-Lock header in news postings."
- :version "21.3"
+ :version "21.4"
:group 'message-headers
:type 'boolean)
"*Headers to be generated or prompted for when sending a message.
Also see `message-required-news-headers' and
`message-required-mail-headers'."
+ :version "21.4"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
(defcustom message-draft-headers '(References From)
"*Headers to be generated when saving a draft message."
+ :version "21.4"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
- :type 'regexp)
+ :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-mail-headers
"^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
any confusion."
:group 'message-interface
:link '(custom-manual "(message)Superseding")
- :type 'regexp)
+ :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-supersede-setup-function
'message-supersede-setup-for-mime-edit
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:link '(custom-manual "(message)Resending")
- :type 'regexp)
+ :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-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"*All headers that match this regexp will be deleted when forwarding a message."
:version "21.1"
:group 'message-forwarding
- :type '(choice (const :tag "None" nil)
+ :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 "."
non-word-constituents
"]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
+ :version "21.4"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'regexp)
If nil, always ignore the header. If it is the symbol `ask', always
query the user whether to use the value. If it is t or the symbol
`use', always use the value."
+ :version "21.4"
:group 'message-interface
:type '(choice (const :tag "ignore" nil)
(const :tag "maybe" t)
regular expressions to match lists. These functions can be used in
conjunction with `message-subscribed-regexps' and
`message-subscribed-addresses'."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat sexp))
"*A file containing addresses the user is subscribed to.
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."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(radio (file :format "%t: %v\n" :size 0)
If nil, do not use any predefined list subscriptions. This list of
addresses can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-regexps'."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat string))
If nil, do not use any predefined list subscriptions. This list of
regular expressions can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-addresses'."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat regexp))
If it is the symbol `always', the posting is allowed. If it is the
symbol `never', the posting is not allowed. If it is the symbol
`ask', you are prompted."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Message Headers")
:type '(choice (const always)
"*Envelope-from when sending mail with sendmail.
If this is nil, use `user-mail-address'. If it is the symbol
`header', use the From: header of the message."
+ :version "21.4"
:type '(choice (string :tag "From name")
(const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
(let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
(set-keymap-parent map minibuffer-local-map)
map)
- "Keymap for `message-read-from-minibuffer'.")
+ "Keymap for `message-read-from-minibuffer'."
+ :version "21.4")
;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
"*Prefix inserted on cited or empty lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
See also `message-yank-prefix'."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
(defcustom message-signature-insert-empty-line t
"*If non-nil, insert an empty line before the signature separator."
+ :version "21.4"
:type 'boolean
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
"Regexp of headers to be hidden when composing new messages.
This can also be a list of regexps to match headers. Or a list
starting with `not' and followed by regexps."
+ :version "21.4"
:group 'message
:link '(custom-manual "(message)Message Headers")
:type '(repeat regexp))
for a message, the subaddresses will be removed (if present) before
the mail is sent. All addresses in this structure should be
downcased."
+ :version "21.4"
:group 'message-headers
:type '(repeat (repeat string)))
"Like `mail-user-agent'.
Except if it is nil, use Gnus native MUA; if it is t, use
`mail-user-agent'."
+ :version "21.4"
:type '(radio (const :tag "Gnus native"
:format "%t\n"
nil)
recipients?\" before a wide reply to multiple recipients. If the user
answers yes, reply to all recipients as usual. If the user answers
no, only reply back to the author."
- :version "21.3"
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)Wide Reply")
:type 'boolean)
(defcustom message-user-fqdn nil
"*Domain part of Messsage-Ids."
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)News Headers")
:type '(radio (const :format "%v " nil)
(executable-find idna-program)
'ask)
"Whether to encode non-ASCII in domain names into ASCII according to IDNA."
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)IDNA")
:type '(choice (const :tag "Ask" ask)
(const :tag "Never" nil)
(const :tag "Always" t)))
+(defcustom message-generate-hashcash nil
+ "*Whether to generate X-Hashcash: headers.
+You must have the \"hashcash\" binary installed, see `hashcash-path'."
+ :group 'message-headers
+ :link '(custom-manual "(message)Mail Headers")
+ :type 'boolean)
+
;;; Internal variables.
(defvar message-sending-message "Sending...")
"\\)")
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
+ :version "21.4"
:group 'message-headers
:type 'regexp)
(autoload 'rmail-msg-restore-non-pruned-header "rmail")
(autoload 'rmail-output "rmailout"))
-(eval-when-compile
- (autoload 'sha1 "sha1-el"))
-
\f
;;;
(if (not header)
nil
(let ((regexp (format "[%s]+" (or separator ",")))
- (beg 1)
(first t)
- quoted elems paren)
+ beg quoted elems paren)
(with-temp-buffer
(set-buffer-multibyte t)
+ (setq beg (point-min))
(insert header)
(goto-char (point-min))
(while (not (eobp))
packages requires these properties to be present in order to work.
If you use one of these packages, turn this option off, and hope the
message composition doesn't break too bad."
+ :version "21.4"
:group 'message-various
:link '(custom-manual "(message)Various Message Variables")
:type 'boolean)
E.g., if this list contains a member list with elements `Cc' and `To',
then `message-carefully-insert-headers' will not insert a `To' header
when the message is already `Cc'ed to the recipient."
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
;; Insert a blank line if it is peeled off.
(insert "\n")))
(goto-char start)
- (while functions
- (funcall (pop functions)))
+ (mapc 'funcall functions)
(when message-citation-line-function
(unless (bolp)
(insert "\n"))
"unknown sender"))
(setq x-no-archive (message-fetch-field "x-no-archive")))
(goto-char start)
- (while functions
- (funcall (pop functions)))
+ (mapc 'funcall functions)
(when message-citation-line-function
(unless (bolp)
(insert "\n"))
(funcall message-citation-line-function))
(when (and x-no-archive
- message-cite-articles-with-x-no-archive
+ (not message-cite-articles-with-x-no-archive)
(string-match "yes" x-no-archive))
(undo-boundary)
(delete-region (point) (mark t))
(file-exists-p auto-save-file-name))
(and file-name
(file-exists-p file-name)))
- (yes-or-no-p (format "Remove the backup file%s? "
- (if modified " too" ""))))
+ (progn
+ ;; If the message buffer has lived in a dedicated window,
+ ;; `kill-buffer' has killed the frame. Thus the
+ ;; `yes-or-no-p' may show up in a lowered frame. Make sure
+ ;; that the user can see the question by raising the
+ ;; current frame:
+ (raise-frame)
+ (yes-or-no-p (format "Remove the backup file%s? "
+ (if modified " too" "")))))
(ignore-errors
(delete-file auto-save-file-name))
(let ((message-draft-article draft-article))
"Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
- (if (and (fboundp 'frame-parameters)
- (cdr (assq 'dedicated (frame-parameters)))
+ (if (and (window-dedicated-p (selected-window))
(not (null (delq (selected-frame) (visible-frame-list)))))
(delete-frame (selected-frame))
(switch-to-buffer newbuf))))
(defun message-do-actions (actions)
"Perform all actions in ACTIONS."
;; Now perform actions on successful sending.
- (while actions
+ (dolist (action actions)
(ignore-errors
(cond
;; A simple function.
- ((functionp (car actions))
- (funcall (car actions)))
+ ((functionp action)
+ (funcall action))
;; Something to be evaled.
(t
- (eval (car actions)))))
- (pop actions)))
+ (eval action))))))
(defsubst message-maybe-split-and-send-mail ()
"Split a message if necessary, and send it via mail.
(message-this-is-mail t)
(headers message-required-mail-headers)
failure)
+ (when message-generate-hashcash
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "X-Hashcash"))
+ (message "Generating hashcash...")
+ (mail-add-payment)
+ (message "Generating hashcash...done"))
(save-restriction
(message-narrow-to-headers)
;; Generate the Mail-Followup-To header if the header is not there...
(case
(as-binary-process
(apply
- 'call-process-region 1 (point-max) message-qmail-inject-program
- nil nil nil
+ 'call-process-region (point-min) (point-max)
+ message-qmail-inject-program nil nil nil
;; qmail-inject's default behaviour is to look for addresses on the
;; command line; if there're none, it scans the headers.
;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
(defun message-canlock-generate ()
"Return a string that is non-trivial to guess.
Do not use this for anything important, it is cryptographically weak."
- (require 'sha1-el)
+ (require 'sha1)
(let (sha1-maximum-internal-length)
(sha1 (concat (message-unique-id)
(format "%x%x%x" (random) (random t) (random))
nil))))
;; Check for control characters.
(message-check 'control-chars
- (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
+ (if (re-search-forward
+ (string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
+ nil t)
(y-or-n-p
"The article contains control characters. Really post? ")
t))
;; When sending via news, make sure the total folded length will
;; be less than 998 characters. This is to cater to broken INN
;; 2.3 which counts the total number of characters in a header
- ;; rather than the physical line length of each line, as it shuld.
+ ;; rather than the physical line length of each line, as it should.
;;
;; This hack should be removed when it's believed than INN 2.3 is
;; no longer widely used.
(defcustom message-beginning-of-line t
"Whether \\<message-mode-map>\\[message-beginning-of-line]\
goes to beginning of header values."
+ :version "21.4"
:group 'message-buffers
:link '(custom-manual "(message)Movement")
:type 'boolean)
subject
(nnheader-decode-subject subject))
""))
- (if message-wash-forwarded-subjects
- (setq subject (message-wash-subject subject)))
+ (when message-wash-forwarded-subjects
+ (setq subject (message-wash-subject subject)))
;; Make sure funcs is a list.
(and funcs
(not (listp funcs))
(setq funcs (list funcs)))
;; Apply funcs in order, passing subject generated by previous
;; func to the next one.
- (while funcs
- (when (functionp (car funcs))
- (setq subject (funcall (car funcs) subject)))
- (setq funcs (cdr funcs)))
+ (dolist (func funcs)
+ (when (functionp func)
+ (setq subject (funcall func subject))))
subject))))
;;;###autoload
'("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
. message-expand-name))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
+ :version "21.4"
:group 'message
:type '(alist :key-type regexp :value-type function))
(defcustom message-tab-body-function nil
"*Function to execute when `message-tab' (TAB) is executed in the body.
If nil, the function bound in `text-mode-map' or `global-map' is executed."
+ :version "21.4"
:group 'message
:link '(custom-manual "(message)Various Commands")
:type 'function)
(defun message-use-alternative-email-as-from ()
(require 'mail-utils)
- (let* ((fields '("To" "Cc"))
+ (let* ((fields '("To" "Cc" "From"))
(emails
(split-string
(mail-strip-quoted-names
(pop emails))
(unless (or (not email) (equal email user-mail-address))
(goto-char (point-max))
- (insert "From: " email "\n"))))
+ (insert "From: " (let ((user-mail-address email)) (message-make-from))
+ "\n"))))
(defun message-options-get (symbol)
(cdr (assq symbol message-options)))
projects / elisp / gnus.git- / blobdiff