Mercurial > hg > xemacs-beta

comparison lisp/gnus/message.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents d95e72db5c07
children 4103f0995bd7
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
245 :type 'boolean) 245 :type 'boolean)
246 246
247 (defvar gnus-local-organization) 247 (defvar gnus-local-organization)
248 (defcustom message-user-organization 248 (defcustom message-user-organization
249 (or (and (boundp 'gnus-local-organization) 249 (or (and (boundp 'gnus-local-organization)
250 (stringp gnus-local-organization)
250 gnus-local-organization) 251 gnus-local-organization)
251 (getenv "ORGANIZATION") 252 (getenv "ORGANIZATION")
252 t) 253 t)
253 "*String to be used as an Organization header. 254 "*String to be used as an Organization header.
254 If t, use `message-user-organization-file'." 255 If t, use `message-user-organization-file'."
581 (ignore-errors 582 (ignore-errors
582 (define-mail-user-agent 'message-user-agent 583 (define-mail-user-agent 'message-user-agent
583 'message-mail 'message-send-and-exit 584 'message-mail 'message-send-and-exit
584 'message-kill-buffer 'message-send-hook)) 585 'message-kill-buffer 'message-send-hook))
585 586
586 (defvar message-delete-mh-headers t 587 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
587 "If non-nil, delete the deletable headers before feeding to mh.") 588 "If non-nil, delete the deletable headers before feeding to mh.")
588 589
589 ;;; Internal variables. 590 ;;; Internal variables.
590 ;;; Well, not really internal. 591 ;;; Well, not really internal.
591 592
792 ((and (= (following-char) ?\)) 793 ((and (= (following-char) ?\))
793 (not quoted)) 794 (not quoted))
794 (setq paren nil)))) 795 (setq paren nil))))
795 (nreverse elems))))) 796 (nreverse elems)))))
796 797
797 (defun message-fetch-field (header) 798 (defun message-fetch-field (header &optional not-all)
798 "The same as `mail-fetch-field', only remove all newlines." 799 "The same as `mail-fetch-field', only remove all newlines."
799 (let ((value (mail-fetch-field header nil t))) 800 (let ((value (mail-fetch-field header nil (not not-all))))
800 (when value 801 (when value
801 (nnheader-replace-chars-in-string value ?\n ? )))) 802 (nnheader-replace-chars-in-string value ?\n ? ))))
802 803
803 (defun message-fetch-reply-field (header) 804 (defun message-fetch-reply-field (header)
804 "Fetch FIELD from the message we're replying to." 805 "Fetch FIELD from the message we're replying to."
1050 C-c C-r message-caesar-buffer-body (rot13 the message body)." 1051 C-c C-r message-caesar-buffer-body (rot13 the message body)."
1051 (interactive) 1052 (interactive)
1052 (kill-all-local-variables) 1053 (kill-all-local-variables)
1053 (make-local-variable 'message-reply-buffer) 1054 (make-local-variable 'message-reply-buffer)
1054 (setq message-reply-buffer nil) 1055 (setq message-reply-buffer nil)
1055 (make-local-variable 'message-send-actions) 1056 (set (make-local-variable 'message-send-actions) nil)
1056 (make-local-variable 'message-exit-actions) 1057 (set (make-local-variable 'message-exit-actions) nil)
1057 (make-local-variable 'message-kill-actions) 1058 (set (make-local-variable 'message-kill-actions) nil)
1058 (make-local-variable 'message-postpone-actions) 1059 (set (make-local-variable 'message-postpone-actions) nil)
1059 (set-syntax-table message-mode-syntax-table) 1060 (set-syntax-table message-mode-syntax-table)
1060 (use-local-map message-mode-map) 1061 (use-local-map message-mode-map)
1061 (setq local-abbrev-table message-mode-abbrev-table) 1062 (setq local-abbrev-table message-mode-abbrev-table)
1062 (setq major-mode 'message-mode) 1063 (setq major-mode 'message-mode)
1063 (setq mode-name "Message") 1064 (setq mode-name "Message")
1764 (concat (file-name-as-directory 1765 (concat (file-name-as-directory
1765 (expand-file-name message-autosave-directory)) 1766 (expand-file-name message-autosave-directory))
1766 "msg.")))) 1767 "msg."))))
1767 (setq buffer-file-name name) 1768 (setq buffer-file-name name)
1768 ;; MH wants to generate these headers itself. 1769 ;; MH wants to generate these headers itself.
1769 (when message-delete-mh-headers 1770 (when message-mh-deletable-headers
1770 (let ((headers message-deletable-headers)) 1771 (let ((headers message-mh-deletable-headers))
1771 (while headers 1772 (while headers
1772 (goto-char (point-min)) 1773 (goto-char (point-min))
1773 (and (re-search-forward 1774 (and (re-search-forward
1774 (concat "^" (symbol-name (car headers)) ": *") nil t) 1775 (concat "^" (symbol-name (car headers)) ": *") nil t)
1775 (message-delete-line)) 1776 (message-delete-line))
1943 (y-or-n-p "The article contains an Approved header. Really post? ") 1944 (y-or-n-p "The article contains an Approved header. Really post? ")
1944 t)) 1945 t))
1945 ;; Check the Message-ID header. 1946 ;; Check the Message-ID header.
1946 (message-check 'message-id 1947 (message-check 'message-id
1947 (let* ((case-fold-search t) 1948 (let* ((case-fold-search t)
1948 (message-id (message-fetch-field "message-id"))) 1949 (message-id (message-fetch-field "message-id" t)))
1949 (or (not message-id) 1950 (or (not message-id)
1950 (and (string-match "@" message-id) 1951 (and (string-match "@" message-id)
1951 (string-match "@[^\\.]*\\." message-id)) 1952 (string-match "@[^\\.]*\\." message-id))
1952 (y-or-n-p 1953 (y-or-n-p
1953 (format "The Message-ID looks strange: \"%s\". Really post? " 1954 (format "The Message-ID looks strange: \"%s\". Really post? "
2838 to (message-fetch-field "to") 2839 to (message-fetch-field "to")
2839 cc (message-fetch-field "cc") 2840 cc (message-fetch-field "cc")
2840 mct (message-fetch-field "mail-copies-to") 2841 mct (message-fetch-field "mail-copies-to")
2841 reply-to (unless ignore-reply-to (message-fetch-field "reply-to")) 2842 reply-to (unless ignore-reply-to (message-fetch-field "reply-to"))
2842 references (message-fetch-field "references") 2843 references (message-fetch-field "references")
2843 message-id (message-fetch-field "message-id")) 2844 message-id (message-fetch-field "message-id" t))
2844 ;; Remove any (buggy) Re:'s that are present and make a 2845 ;; Remove any (buggy) Re:'s that are present and make a
2845 ;; proper one. 2846 ;; proper one.
2846 (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) 2847 (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
2847 (setq subject (substring subject (match-end 0)))) 2848 (setq subject (substring subject (match-end 0))))
2848 (setq subject (concat "Re: " subject)) 2849 (setq subject (concat "Re: " subject))
2873 (insert (if cc (concat (if (bolp) "" ", ") cc) "")) 2874 (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
2874 ;; Remove addresses that match `rmail-dont-reply-to-names'. 2875 ;; Remove addresses that match `rmail-dont-reply-to-names'.
2875 (insert (prog1 (rmail-dont-reply-to (buffer-string)) 2876 (insert (prog1 (rmail-dont-reply-to (buffer-string))
2876 (erase-buffer))) 2877 (erase-buffer)))
2877 (goto-char (point-min)) 2878 (goto-char (point-min))
2879 ;; Perhaps Mail-Copies-To: never removed the only address?
2880 (when (eobp)
2881 (insert (or reply-to from "")))
2878 (setq ccalist 2882 (setq ccalist
2879 (mapcar 2883 (mapcar
2880 (lambda (addr) 2884 (lambda (addr)
2881 (cons (mail-strip-quoted-names addr) addr)) 2885 (cons (mail-strip-quoted-names addr) addr))
2882 (message-tokenize-header (buffer-string)))) 2886 (message-tokenize-header (buffer-string))))
2936 (funcall message-followup-to-function))) 2940 (funcall message-followup-to-function)))
2937 (setq from (message-fetch-field "from") 2941 (setq from (message-fetch-field "from")
2938 date (message-fetch-field "date") 2942 date (message-fetch-field "date")
2939 subject (or (message-fetch-field "subject") "none") 2943 subject (or (message-fetch-field "subject") "none")
2940 references (message-fetch-field "references") 2944 references (message-fetch-field "references")
2941 message-id (message-fetch-field "message-id") 2945 message-id (message-fetch-field "message-id" t)
2942 followup-to (message-fetch-field "followup-to") 2946 followup-to (message-fetch-field "followup-to")
2943 newsgroups (message-fetch-field "newsgroups") 2947 newsgroups (message-fetch-field "newsgroups")
2944 reply-to (message-fetch-field "reply-to") 2948 reply-to (message-fetch-field "reply-to")
2945 distribution (message-fetch-field "distribution") 2949 distribution (message-fetch-field "distribution")
2946 mct (message-fetch-field "mail-copies-to")) 2950 mct (message-fetch-field "mail-copies-to"))
3032 ;; Get header info. from original article. 3036 ;; Get header info. from original article.
3033 (save-restriction 3037 (save-restriction
3034 (message-narrow-to-head) 3038 (message-narrow-to-head)
3035 (setq from (message-fetch-field "from") 3039 (setq from (message-fetch-field "from")
3036 newsgroups (message-fetch-field "newsgroups") 3040 newsgroups (message-fetch-field "newsgroups")
3037 message-id (message-fetch-field "message-id") 3041 message-id (message-fetch-field "message-id" t)
3038 distribution (message-fetch-field "distribution"))) 3042 distribution (message-fetch-field "distribution")))
3039 ;; Make sure that this article was written by the user. 3043 ;; Make sure that this article was written by the user.
3040 (unless (string-equal 3044 (unless (string-equal
3041 (downcase (cadr (mail-extract-address-components from))) 3045 (downcase (cadr (mail-extract-address-components from)))
3042 (downcase (message-make-address))) 3046 (downcase (message-make-address)))