: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."
:link '(custom-manual "(message)Message Headers")
:type '(repeat regexp))
+(defcustom message-cite-articles-with-x-no-archive t
+ "If non-nil, cite text from articles that has X-No-Archive set."
+ :group 'message
+ :type 'boolean)
+
;;; Internal variables.
;;; Well, not really internal.
(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"
(insert "\n"))
(funcall message-citation-line-function))
(when (and x-no-archive
+ message-cite-articles-with-x-no-archive
(string-match "yes" x-no-archive))
(undo-boundary)
(delete-region (point) (mark t))
'(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."
(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
(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
:group 'message
:type '(alist :key-type regexp :value-type function))
+(defcustom message-expand-name-databases
+ (list 'bbdb 'eudc 'lsdb)
+ "List of databases to try for name completion (`message-expand-name').
+Each element is a symbol and can be `bbdb', `eudc' or `lsdb'."
+ :group 'message
+ :type '(set (const bbdb) (const eudc) (const lsdb)))
+
(defcustom message-expand-name-function
(cond ((and (boundp 'eudc-protocol)
eudc-protocol)
((fboundp 'lsdb-complete-name)
'lsdb-complete-name)
(t 'expand-abbrev))
- "*A function called to expand addresses in field body."
+ "*A function called to expand addresses in field body.
+This variable is semi-obsolete, set it as nil and use
+`message-expand-name-databases' instead."
:group 'message
- :type 'function)
+ :type '(radio (const :format "Invalidate it: %v\n" nil)
+ (function-item :format "eudc: %v\n" eudc-expand-inline)
+ (function-item :format "bbdb: %v\n" bbdb-complete-name)
+ (function-item :format "lsdb: %v\n" lsdb-complete-name)
+ (function :size 0 :value expand-abbrev)))
(defcustom message-tab-body-function nil
"*Function to execute when `message-tab' (TAB) is executed in the body.
(delete-region (point) (progn (forward-line 3) (point))))))))))
(defun message-expand-name ()
- (funcall message-expand-name-function))
+ (cond (message-expand-name-function
+ (funcall message-expand-name-function))
+ ((and (memq 'eudc message-expand-name-databases)
+ (boundp 'eudc-protocol)
+ eudc-protocol)
+ (eudc-expand-inline))
+ ((and (memq 'bbdb message-expand-name-databases)
+ (fboundp 'bbdb-complete-name))
+ (bbdb-complete-name))
+ ((and (memq 'lsdb message-expand-name-databases)
+ (fboundp 'lsdb-complete-name))
+ (lsdb-complete-name))
+ (t 'expand-abbrev)))
;;; Help stuff.
projects / elisp / gnus.git- / blobdiff