X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=50099c59c05c721a0d26a6a252266d4e5b8592cc;hb=cb974d1ba2e1ca8772a023a6073434ca2854aea5;hp=8a36f513d7b4fc7a0bbf773a5adeb3beef0fdb68;hpb=368248701a9f61fef9145a01267eca6ab60cca13;p=gnus diff --git a/lisp/message.el b/lisp/message.el index 8a36f513d..50099c59c 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,5 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -47,10 +47,11 @@ (require 'mml) (require 'rfc822) (eval-and-compile - (autoload 'sha1 "sha1-el") (autoload 'gnus-find-method-for-group "gnus") (autoload 'nnvirtual-find-group-art "nnvirtual") (autoload 'gnus-group-decoded-name "gnus-group")) +(eval-when-compile + (autoload 'sha1 "sha1-el")) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -540,15 +541,13 @@ Done before generating the new subject of a forward." (if (string-match "[[:digit:]]" "1") ;; support POSIX? "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+" ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. - (let ((old-table (syntax-table)) - non-word-constituents) - (set-syntax-table text-mode-syntax-table) - (setq non-word-constituents - (concat - (if (string-match "\\w" "-") "" "-") - (if (string-match "\\w" "_") "" "_") - (if (string-match "\\w" ".") "" "."))) - (set-syntax-table old-table) + (let (non-word-constituents) + (with-syntax-table text-mode-syntax-table + (setq non-word-constituents + (concat + (if (string-match "\\w" "-") "" "-") + (if (string-match "\\w" "_") "" "_") + (if (string-match "\\w" ".") "" ".")))) (if (equal non-word-constituents "") "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+" (concat "\\([ \t]*\\(\\w\\|[" @@ -762,7 +761,7 @@ variable isn't used." ;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 (defcustom message-generate-headers-first '(references) "Which headers should be generated before starting to compose a message. -If `t', generate all required headers. This can also be a list of headers to +If t, generate all required headers. This can also be a list of headers to generate. The variables `message-required-news-headers' and `message-required-mail-headers' specify which headers to generate. @@ -1535,8 +1534,6 @@ no, only reply back to the author." (autoload 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") (autoload 'mh-send-letter "mh-comp") - (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-point-at-bol "gnus-util") (autoload 'gnus-output-to-rmail "gnus-util") (autoload 'gnus-output-to-mail "gnus-util") (autoload 'nndraft-request-associate-buffer "nndraft") @@ -1631,7 +1628,6 @@ is used by default." 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)))) (when value (while (string-match "\n[\t ]+" value) @@ -1654,9 +1650,7 @@ see `message-narrow-to-headers-or-head'." (progn (forward-line 1) (if (re-search-forward "^[^ \n\t]" nil t) - (progn - (beginning-of-line) - (point)) + (point-at-bol) (point-max)))) (goto-char (point-min))) @@ -2673,17 +2667,23 @@ prefix FORCE is given." (message-get-reply-headers t)))) (message-carefully-insert-headers headers))) -(defvar message-header-synonyms +(defcustom message-header-synonyms '((To Cc Bcc)) "List of lists of header synonyms. 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.") +when the message is already `Cc'ed to the recipient." + :group 'message-headers + :link '(custom-manual "(message)Message Headers") + :type '(repeat sexp)) (defun message-carefully-insert-headers (headers) "Insert the HEADERS, an alist, into the message buffer. Does not insert the headers when they are already present there or in the synonym headers, defined by `message-header-synonyms'." + ;; FIXME: Should compare only the address and not the full name. Comparison + ;; should be done case-folded (and with `string=' rather than + ;; `string-match'). (dolist (header headers) (let* ((header-name (symbol-name (car header))) (new-header (cdr header)) @@ -2758,16 +2758,23 @@ or in the synonym headers, defined by `message-header-synonyms'." (when (message-goto-signature) (forward-line -2))) -(defun message-kill-to-signature () - "Deletes all text up to the signature." - (interactive) - (let ((point (point))) - (message-goto-signature) - (unless (eobp) - (end-of-line -1)) - (kill-region point (point)) - (unless (bolp) - (insert "\n")))) +(defun message-kill-to-signature (&optional arg) + "Kill all text up to the signature. +If a numberic argument or prefix arg is given, leave that number +of lines before the signature intact." + (interactive "p") + (save-excursion + (save-restriction + (let ((point (point))) + (narrow-to-region point (point-max)) + (message-goto-signature) + (unless (eobp) + (if (and arg (numberp arg)) + (forward-line (- -1 arg)) + (end-of-line -1))) + (unless (= point (point)) + (kill-region point (point)) + (insert "\n")))))) (defun message-newline-and-reformat (&optional arg not-break) "Insert four newlines, and then reformat if inside quoted text. @@ -3892,6 +3899,7 @@ documentation for the function `mail-source-touch-pop'." (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) (let (sha1-maximum-internal-length) (sha1 (concat (message-unique-id) (format "%x%x%x" (random) (random t) (random)) @@ -5049,7 +5057,7 @@ Headers already prepared in the buffer are not modified." (forward-line -1))) ;; The value of this header was empty, so we clear ;; totally and insert the new value. - (delete-region (point) (gnus-point-at-eol)) + (delete-region (point) (point-at-eol)) ;; If the header is optional, and the header was ;; empty, we con't insert it anyway. (unless optionalp @@ -5149,7 +5157,6 @@ If the current line has `message-yank-prefix', insert it on the new line." (error (split-line)))) - (defun message-fill-header (header value) (let ((begin (point)) (fill-column 78) @@ -5276,7 +5283,7 @@ beginning of line." (message-point-in-header-p)) (let* ((here (point)) (bol (progn (beginning-of-line n) (point))) - (eol (gnus-point-at-eol)) + (eol (point-at-eol)) (eoh (re-search-forward ": *" eol t))) (if (or (not eoh) (equal here eoh)) (goto-char bol) @@ -5585,7 +5592,13 @@ OTHER-HEADERS is an alist of header/value pairs." ;; Find all relevant headers we need. (save-restriction (message-narrow-to-headers-or-head) - (setq to (message-fetch-field "to") + ;; Gmane renames "To". Look at "Original-To", too, if it is present in + ;; message-header-synonyms. + (setq to (or (message-fetch-field "to") + (and (loop for synonym in message-header-synonyms + when (memq 'Original-To synonym) + return t) + (message-fetch-field "original-to"))) cc (message-fetch-field "cc") mct (message-fetch-field "mail-copies-to") author (or (message-fetch-field "mail-reply-to") @@ -6619,9 +6632,12 @@ those headers." (delete-region (point) (progn (forward-line 3) (point)))))))))) (defun message-expand-name () - (if (fboundp 'bbdb-complete-name) - (bbdb-complete-name) - (expand-abbrev))) + (cond ((when (boundp 'eudc-protocol) eudc-protocol) + (eudc-expand-inline)) + ((fboundp 'bbdb-complete-name) + (bbdb-complete-name)) + (t + (expand-abbrev)))) ;;; Help stuff.