X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=69f61f486accc22732195bdf2764e13c8a3ca513;hb=7d3cebb22d43e3ae26e7b1ab3b40c12ec80be154;hp=91452c92f0ce5de350ec77a9b35ddf20ddfb8d0a;hpb=aa5128c389ce456d803dc54ed86912c6c29ebdaa;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index 91452c9..69f61f4 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -40,7 +40,8 @@ (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) @@ -418,7 +419,12 @@ included. Organization and User-Agent are optional." :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:" @@ -434,7 +440,12 @@ It's best to delete old Path and Date headers before posting to avoid 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 @@ -651,13 +662,22 @@ Done before generating the new subject of a forward." "*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 "." @@ -683,6 +703,7 @@ Done before generating the new subject of a forward." 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) @@ -869,6 +890,7 @@ Doing so would be even more evil than leaving it out." "*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)) @@ -988,7 +1010,8 @@ The function `message-supersede' runs this hook." (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 @@ -1618,6 +1641,7 @@ no, only reply back to the author." (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) @@ -1636,6 +1660,13 @@ no, only reply back to the author." (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...") @@ -1844,11 +1875,11 @@ is used by default." (if (not header) nil (let ((regexp (format "[%s]+" (or separator ","))) - (beg (point-min)) (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)) @@ -3598,8 +3629,7 @@ be added to the \"References\" field." ;; 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")) @@ -3630,14 +3660,13 @@ be added to the \"References\" field." "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)) @@ -3762,8 +3791,15 @@ Instead, just auto-save the buffer and then bury it." (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)) @@ -3806,8 +3842,7 @@ Instead, just auto-save the buffer and then bury it." "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)))) @@ -4079,16 +4114,15 @@ not have PROP." (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. @@ -4215,6 +4249,13 @@ This sub function is for exclusive use of `message-send-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... @@ -4959,7 +5000,9 @@ Otherwise, generate and save a value for `canlock-password' first." 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)) @@ -5858,7 +5901,7 @@ they are." ;; 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. @@ -6856,18 +6899,17 @@ the message." 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 @@ -7323,6 +7365,7 @@ which specify the range to operate on." '("^\\(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)) @@ -7591,7 +7634,7 @@ regexp VARSTR." (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 @@ -7605,7 +7648,8 @@ regexp VARSTR." (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)))