X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=314e5462423b0cde28082dc3d4aa240a9b31a6be;hb=89f56733a4665ec857c04c45ebf14ddacf82747e;hp=f28daafafa1a5ea777ae6b49a18064ea85467893;hpb=88dfd27d0ea493d180e919e716c7880b9818ddfb;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index f28daaf..314e546 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -414,7 +414,7 @@ included. Organization and User-Agent are optional." :link '(custom-manual "(message)Mail Headers") :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." @@ -1867,7 +1867,6 @@ see `message-narrow-to-headers-or-head'." (when value (while (string-match "\n[\t ]+" value) (setq value (replace-match " " t t value))) - (set-text-properties 0 (length value) nil value) value))) (defun message-field-value (header &optional not-all) @@ -2623,11 +2622,10 @@ See also `message-forbidden-properties'." (message-tamago-not-in-use-p begin) ;; Check whether the invisible MIME part is not inserted. (not (text-property-any begin end 'mime-edit-invisible t))) - (while (not (= begin end)) - (when (not (get-text-property begin 'message-hidden)) - (remove-text-properties begin (1+ begin) - message-forbidden-properties)) - (incf begin)))) + (dolist (from-to (message-text-with-property 'message-hidden + begin end t)) + (remove-text-properties (car from-to) (cdr from-to) + message-forbidden-properties)))) ;;;###autoload (define-derived-mode message-mode text-mode "Message" @@ -3908,16 +3906,31 @@ used to distinguish whether the invisible text is a MIME part or not." '(invisible t mime-edit-invisible t)) (put-text-property start end 'invisible t)))))) -(defun message-text-with-property (prop) - "Return a list of all points where the text has PROP." - (let ((points nil) - (point (point-min))) - (save-excursion - (while (< point (point-max)) - (when (get-text-property point prop) - (push point points)) - (incf point))) - (nreverse points))) +(defun message-text-with-property (prop &optional start end reverse) + "Return a list of start and end positions where the text has PROP. +START and END bound the search, they default to `point-min' and +`point-max' respectively. If REVERSE is non-nil, find text which does +not have PROP." + (unless start + (setq start (point-min))) + (unless end + (setq end (point-max))) + (let (next regions) + (if reverse + (while (and start + (setq start (text-property-any start end prop nil))) + (setq next (next-single-property-change start prop nil end)) + (push (cons start (or next end)) regions) + (setq start next)) + (while (and start + (or (get-text-property start prop) + (and (setq start (next-single-property-change + start prop nil end)) + (get-text-property start prop)))) + (setq next (text-property-any start end prop nil)) + (push (cons start (or next end)) regions) + (setq start next))) + (nreverse regions))) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -3927,12 +3940,9 @@ used to distinguish whether the invisible text is a MIME part or not." (unless (bolp) (insert "\n")) ;; Make the hidden headers visible. - (let ((points (message-text-with-property 'message-hidden))) - (when points - (goto-char (car points)) - (dolist (point points) - (add-text-properties point (1+ point) - '(invisible nil intangible nil))))) + (dolist (from-to (message-text-with-property 'message-hidden)) + (add-text-properties (car from-to) (cdr from-to) + '(invisible nil intangible nil))) ;; Make invisible text visible except for mime parts which may be ;; inserted by the MIME-Edit. ;; It doesn't seem as if this is useful, since the invisible property @@ -4273,8 +4283,7 @@ This sub function is for exclusive use of `message-send-mail'." (when (eval message-mailer-swallows-blank-line) (newline)) (when message-interactive - (save-excursion - (set-buffer errbuf) + (with-current-buffer errbuf (erase-buffer)))) (let* ((default-directory "/") (cpr (as-binary-process @@ -5119,24 +5128,8 @@ Otherwise, generate and save a value for `canlock-password' first." (defun message-make-date (&optional now) "Make a valid data header. If NOW, use that time instead." - (let* ((now (or now (current-time))) - (zone (nth 8 (decode-time now))) - (sign "+")) - (when (< zone 0) - (setq sign "-") - (setq zone (- zone))) - (concat - ;; The day name of the %a spec is locale-specific. Pfff. - (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now)) - parse-time-weekdays)))) - (format-time-string "%d" now) - ;; The month name of the %b spec is locale-specific. Pfff. - (format " %s " - (capitalize (car (rassoc (nth 4 (decode-time now)) - parse-time-months)))) - (format-time-string "%Y %H:%M:%S " now) - ;; We do all of this because XEmacs doesn't have the %z spec. - (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60))))) + (let ((system-time-locale "C")) + (format-time-string "%a, %d %b %Y %T %z" now))) (defun message-make-followup-subject (subject) "Make a followup Subject." @@ -5506,7 +5499,7 @@ subscribed address (and not the additional To and Cc header contents)." (when field (dolist (address (mail-header-parse-addresses field)) (setq address (car address) - rhs (downcase (cadr (split-string address "@"))) + rhs (downcase (or (cadr (split-string address "@")) "")) ace (downcase (idna-to-ascii rhs))) (when (and (not (equal rhs ace)) (or (not (eq message-use-idna 'ask)) @@ -7449,8 +7442,7 @@ regexp VARSTR." (let ((locals (save-excursion (set-buffer buffer) (buffer-local-variables))) - (regexp - "^\\(gnus\\|nn\\|message\\|user-\\(mail-address\\|full-name\\)\\)")) + (regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address\\|^user-full-name")) (mapcar (lambda (local) (when (and (consp local)