*** pub/sgnus/lisp/gnus-cache.el Sun Mar 24 03:42:12 1996 --- sgnus/lisp/gnus-cache.el Tue Mar 26 06:04:03 1996 *************** *** 111,116 **** --- 111,118 ---- (defun gnus-cache-possibly-enter-article (group article headers ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) + (numberp article) + (> article 0) (vectorp headers)) ; This might be a dummy article. ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) *************** *** 256,264 **** ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) ! (setq type (and articles ! (gnus-retrieve-headers ! uncached-articles group fetch-old)))) (gnus-cache-save-buffers) ;; Then we insert the cached headers. (save-excursion --- 258,267 ---- ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) ! (when uncached-articles ! (setq type (and articles ! (gnus-retrieve-headers ! uncached-articles group fetch-old))))) (gnus-cache-save-buffers) ;; Then we insert the cached headers. (save-excursion *** pub/sgnus/lisp/gnus-msg.el Sun Mar 24 03:42:14 1996 --- sgnus/lisp/gnus-msg.el Wed Mar 27 04:38:59 1996 *************** *** 29,34 **** --- 29,35 ---- (require 'gnus) (require 'sendmail) (require 'gnus-ems) + (require 'message) (eval-when-compile (require 'cl)) ;; Added by Sudish Joseph . *************** *** 44,129 **** the case, the user will be queried for what select method to use when posting.") - (defvar gnus-organization-file "/usr/lib/news/organization" - "*Local news organization file.") - - (defvar gnus-prepare-article-hook nil - "*A hook called after preparing body, but before preparing header headers.") - - (defvar gnus-post-prepare-function nil - "*Function that is run after a post buffer has been prepared. - It is called with the name of the newsgroup that is posted to. It - might be used, for instance, for inserting signatures based on the - newsgroup name. (In that case, `gnus-signature-file' and - `mail-signature' should both be set to nil).") - - (defvar gnus-post-prepare-hook nil - "*Hook that is run after a post buffer has been prepared. - If you want to insert the signature, you might put - `gnus-inews-insert-signature' in this hook.") - - (defvar gnus-use-followup-to 'ask - "*Specifies what to do with Followup-To header. - If nil, ignore the header. If it is t, use its value, but ignore - \"poster\". If it is the symbol `ask', query the user whether to - ignore the \"poster\" value. If it is the symbol `use', always use - the value.") - - (defvar gnus-followup-to-function nil - "*A variable that contains a function that returns a followup address. - The function will be called in the buffer of the article that is being - followed up. The buffer will be narrowed to the headers of the - article. To pick header headers, one might use `mail-fetch-field'. The - function will be called with the name of the current newsgroup as the - argument. - - Here's an example `gnus-followup-to-function': - - (setq gnus-followup-to-function - (lambda (group) - (cond ((string= group \"mail.list\") - (or (mail-fetch-field \"sender\") - (mail-fetch-field \"from\"))) - (t - (or (mail-fetch-field \"reply-to\") - (mail-fetch-field \"from\"))))))") - - (defvar gnus-reply-to-function nil - "*A variable that contains a function that returns a reply address. - See the `gnus-followup-to-function' variable for an explanation of how - this variable is used. - - This function should return a string that will be used to fill in the - header. This function may also return a list. In that case, every - list element should be a cons where the first car should be a string - with the header name, and the cdr should be a string with the header - value.") - - (defvar gnus-author-copy (getenv "AUTHORCOPY") - "*Save outgoing articles in this file. - Initialized from the AUTHORCOPY environment variable. - - If this variable begins with the character \"|\", outgoing articles - will be piped to the named program. It is possible to save an article - in an MH folder as follows: - - \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\") - - If the first character is not a pipe, articles are saved using the - function specified by the `gnus-author-copy-saver' variable.") - - (defvar gnus-mail-self-blind nil - "*Non-nil means insert a BCC header in all outgoing articles. - This will result in having a copy of the article mailed to yourself. - The BCC header is inserted when the post buffer is initialized, so you - can remove or alter the BCC header to override the default.") - - (defvar gnus-author-copy-saver (function rmail-output) - "*A function called to save outgoing articles. - This function will be called with the same of the file to store the - article in. The default function is `rmail-output' which saves in Unix - mailbox format.") - (defvar gnus-outgoing-message-group nil "*All outgoing messages will be put in this group. If you want to store all your outgoing mail and articles in the group --- 45,50 ---- *************** *** 136,142 **** of names).") (defvar gnus-message-archive-group ! '((if (eq major-mode 'news-reply-mode) "misc-news" "misc-mail")) "*Name of the group in which to save the messages you've written. This can either be a string, a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list --- 57,63 ---- of names).") (defvar gnus-message-archive-group ! '((if (message-news-p) "misc-news" "misc-mail")) "*Name of the group in which to save the messages you've written. This can either be a string, a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list *************** *** 149,315 **** gatewayed to a newsgroup, and you want to followup to an article in the group.") - (defvar gnus-draft-group-directory - (expand-file-name - (concat (file-name-as-directory gnus-article-save-directory) - "drafts")) - "*The directory where draft messages will be stored.") - - (defvar gnus-use-draft t - "*Whether Gnus should use the draft group.") - - (defvar gnus-posting-styles nil - "*Alist of styles to use when posting.") - - (defvar gnus-posting-style-alist - '((organization . gnus-organization-file) - (signature . gnus-signature-file) - (from . gnus-user-from-line)) - "*Mapping from style parameters to Gnus variables.") - - (defvar gnus-user-login-name nil - "*The login name of the user. - Got from the function `user-login-name' if undefined.") - - (defvar gnus-user-full-name nil - "*The full name of the user. - Got from the NAME environment variable if undefined.") - - (defvar gnus-user-from-line nil - "*Your full, complete e-mail address. - Overrides the other Gnus variables if it is non-nil. - - Here are two example values of this variable: - - \"Lars Magne Ingebrigtsen \" - - and - - \"larsi@ifi.uio.no (Lars Magne Ingebrigtsen)\" - - The first version is recommended, but the name has to be quoted if it - contains non-alphanumerical characters.") - - (defvar gnus-signature-file "~/.signature" - "*Your signature file. - If the variable is a string that doesn't correspond to a file, the - string itself is inserted.") - - (defvar gnus-signature-function nil - "*A function that should return a signature file name. - The function will be called with the name of the newsgroup being - posted to. - If the function returns a string that doesn't correspond to a file, the - string itself is inserted. - If the function returns nil, the `gnus-signature-file' variable will - be used instead.") - - (defvar gnus-forward-start-separator - "------- Start of forwarded message -------\n" - "*Delimiter inserted before forwarded messages.") - - (defvar gnus-forward-end-separator - "------- End of forwarded message -------\n" - "*Delimiter inserted after forwarded messages.") - - (defvar gnus-signature-before-forwarded-message t - "*If non-nil, put the signature before any included forwarded message.") - - (defvar gnus-forward-included-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:" - "*Regexp matching headers to be included in forwarded messages.") - - (defvar gnus-required-headers - '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader) - "*Headers to be generated or prompted for when posting an article. - RFC977 and RFC1036 require From, Date, Newsgroups, Subject, - Message-ID. Organization, Lines, In-Reply-To, Expires, and - X-Newsreader are optional. If you want Gnus not to insert some - header, remove it from this list.") - - (defvar gnus-required-mail-headers - '(From Date To Subject (optional . In-Reply-To) Message-ID Organization Lines) - "*Headers to be generated or prompted for when mailing a message. - RFC822 required that From, Date, To, Subject and Message-ID be - included. Organization, Lines and X-Mailer are optional.") - - (defvar gnus-deletable-headers '(Message-ID Date) - "*Headers to be deleted if they already exists and were generated by Gnus previously.") - - (defvar gnus-removable-headers '(NNTP-Posting-Host Xref) - "*Headers to be removed unconditionally before posting.") - - (defvar gnus-ignored-resent-headers "^Return-receipt" - "*All headers that match this regexp will be deleted when resending a message.") - - (defvar gnus-article-expires 14 - "*Number of days before your article expires. - This variable isn't used unless you have the `Expires' element in - `gnus-required-headers'.") - - (defvar gnus-distribution-function nil - "*Function that should return the Distribution header for outgoing articles. - It will be called from the buffer where the outgoing article - is being prepared with the group name as the only parameter. - It should return a valid distribution. - - The function will only be called if you have the `Distribution' header in - `gnus-required-headers'.") - - (defvar gnus-check-before-posting - '(subject-cmsg multiple-headers sendsys message-id from - long-lines control-chars size new-text - redirected-followup signature approved sender - empty empty-headers) - "In non-nil, Gnus will attempt to run some checks on outgoing posts. - If this variable is t, Gnus will check everything it can. If it is a - list, then those elements in that list will be checked.") - - (defvar gnus-delete-supersedes-headers - "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:\\|^Xref:\\|^Lines:" - "*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.") - - (defvar gnus-auto-mail-to-author nil - "*If non-nil, mail the authors of articles a copy of your follow-ups. - If this variable is `ask', the user will be prompted for whether to - mail a copy. The string given by `gnus-mail-courtesy-message' will be - inserted at the beginning of the mail copy.") - - ;; Added by Ethan Bradford . - (defvar gnus-mail-courtesy-message - "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" - "*This is inserted at the start of a mailed copy of a posted message. - If this variable is nil, no such courtesy message will be added.") - - (defvar gnus-mail-method 'sendmail - "*Method to use for composing mail. - There are three legal values: `sendmail' (which is the default), `mh', - and `vm'.") - - (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail) - "*Function to compose a reply. - Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail); - `gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'.") - - (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail) - "*Function to forward the current message to another user. - Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail); - `gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'.") - - (defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail - "*Function to compose mail in the other window. - Three pre-made functions are `gnus-mail-other-window-using-mail' - (sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and - `gnus-mail-other-window-using-vm'.") - - (defvar gnus-inews-article-function 'gnus-inews-article - "*Function to post an article.") - - (defvar gnus-bounced-headers-junk "^\\(Received\\):" - "*Regexp that matches headers to be removed in resent bounced mail.") - (defvar gnus-sent-message-ids-file (concat (file-name-as-directory gnus-article-save-directory) "Sent-Message-IDs") --- 70,75 ---- *************** *** 318,350 **** (defvar gnus-sent-message-ids-length 1000 "The number of sent Message-IDs to save.") - (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc) - "*A hook called before finally posting an article. - The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves - the article to a file).") - - (defvar gnus-inews-article-header-hook nil - "*A hook called after inserting the headers in an article to be posted. - The hook is called from the *post-news* buffer, narrowed to the - headers.") - - (defvar gnus-mail-hook nil - "*A hook called as the last thing after setting up a mail buffer.") - - (defvar gnus-message-sent-hook nil - "*A hook run after an article has been sent (or attempted sent).") - ;;; Internal variables. ! (defvar gnus-post-news-buffer "*Post Gnus*") ! (defvar gnus-default-post-news-buffer gnus-post-news-buffer) ! (defvar gnus-mail-buffer "*Mail Gnus*") ! (defvar gnus-default-mail-buffer gnus-mail-buffer) (defvar gnus-article-copy nil) - (defvar gnus-reply-subject nil) - (defvar gnus-newsgroup-followup nil) - (defvar gnus-add-to-address nil) - (defvar gnus-in-reply-to nil) (defvar gnus-last-posting-server nil) (eval-and-compile --- 78,87 ---- (defvar gnus-sent-message-ids-length 1000 "The number of sent Message-IDs to save.") ;;; Internal variables. ! (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) (defvar gnus-last-posting-server nil) (eval-and-compile *************** *** 364,371 **** "p" gnus-summary-post-news "f" gnus-summary-followup "F" gnus-summary-followup-with-original - "b" gnus-summary-followup-and-reply - "B" gnus-summary-followup-and-reply-with-original "c" gnus-summary-cancel-article "s" gnus-summary-supersede-article "r" gnus-summary-reply --- 101,106 ---- *************** *** 385,408 **** ;;; Internal functions. ! (defun gnus-number-base36 (num len) ! (if (if (< len 0) (<= num 0) (= len 0)) ! "" ! (concat (gnus-number-base36 (/ num 36) (1- len)) ! (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" ! (% num 36)))))) ;;; Post news commands of Gnus group mode and summary mode (defun gnus-group-mail () "Start composing a mail." (interactive) ! (gnus-new-mail ! ;; We might want to prompt here. ! (when (and gnus-interactive-post ! (not gnus-expert-user)) ! (read-string "To: "))) ! (gnus-configure-windows 'group-mail 'force)) (defun gnus-group-post-news (&optional arg) "Post an article. --- 120,167 ---- ;;; Internal functions. ! (defvar gnus-article-reply nil) ! (defmacro gnus-setup-message (config &rest forms) ! (let ((winconf (make-symbol "winconf")) ! (buffer (make-symbol "buffer")) ! (article (make-symbol "article"))) ! `(let ((,winconf (current-window-configuration)) ! (,buffer (current-buffer)) ! (,article (and gnus-article-reply (gnus-summary-article-number))) ! message-header-setup-hook) ! (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) ! (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) ! ,@forms ! (gnus-inews-add-send-actions ,winconf ,buffer ,article) ! (setq gnus-message-buffer (current-buffer)) ! (gnus-configure-windows ,config t)))) ! ! (defun gnus-inews-add-send-actions (winconf buffer article) ! (make-local-hook 'message-sent-hook) ! (add-hook 'message-sent-hook 'gnus-inews-do-gcc) ! (setq message-post-method ! `(lambda (arg) ! (gnus-post-method arg ,gnus-newsgroup-name))) ! (setq message-newsreader (setq message-mailer (gnus-extended-version))) ! (let ((actions ! `((set-window-configuration ,winconf) ! ((lambda () ! (when (buffer-name ,buffer) ! (set-buffer ,buffer) ! ,(when article ! `(gnus-summary-mark-article-as-replied ,article)))))))) ! (setq message-send-actions (append message-send-actions actions)))) ! ! (put 'gnus-setup-message 'lisp-indent-function 1) ! (put 'gnus-setup-message 'lisp-indent-hook 1) ;;; Post news commands of Gnus group mode and summary mode (defun gnus-group-mail () "Start composing a mail." (interactive) ! (gnus-setup-message 'message ! (message-mail))) (defun gnus-group-post-news (&optional arg) "Post an article. *************** *** 412,430 **** also do this by calling this function from the bottom of the Group buffer." (interactive "P") ! (let ((gnus-newsgroup-name nil) ! (group (unless arg (gnus-group-group-name)))) ! ;; We might want to prompt here. ! (when (and gnus-interactive-post ! (not gnus-expert-user)) ! (setq gnus-newsgroup-name ! (setq group ! (completing-read "Group: " gnus-active-hashtb nil nil ! (cons (or group "") 0))))) ! (gnus-post-news 'post group nil gnus-article-buffer) ! (if (eq major-mode 'news-reply-mode) ! (gnus-configure-windows 'group-post t) ! (gnus-configure-windows 'group-mail t)))) (defun gnus-summary-post-news () "Post an article." --- 171,187 ---- also do this by calling this function from the bottom of the Group buffer." (interactive "P") ! (gnus-setup-message 'message ! (let ((gnus-newsgroup-name nil) ! (group (unless arg (gnus-group-group-name)))) ! ;; We might want to prompt here. ! (when (and gnus-interactive-post ! (not gnus-expert-user)) ! (setq gnus-newsgroup-name ! (setq group ! (completing-read "Group: " gnus-active-hashtb nil nil ! (cons (or group "") 0))))) ! (gnus-post-news 'post group)))) (defun gnus-summary-post-news () "Post an article." *************** *** 432,481 **** (gnus-set-global-variables) (gnus-post-news 'post gnus-newsgroup-name)) ! (defun gnus-summary-followup (yank &optional yank-articles force-news) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." ! (interactive "P") (gnus-set-global-variables) ! (if yank-articles (gnus-summary-goto-subject (car yank-articles))) (save-window-excursion (gnus-summary-select-article)) (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) (gnus-newsgroup-name gnus-newsgroup-name)) ! ;; Check Followup-To: poster. ! (set-buffer gnus-article-buffer) ! (if (and gnus-use-followup-to ! (string-equal "poster" (gnus-fetch-field "followup-to")) ! (or (not (memq gnus-use-followup-to '(t ask))) ! (not (gnus-y-or-n-p ! "Do you want to ignore `Followup-To: poster'? ")))) ! ;; Mail to the poster. ! (progn ! (set-buffer gnus-summary-buffer) ! (gnus-summary-reply yank)) ! ;; Send a followup. ! (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer ! (or yank-articles (not (not yank))) ! nil force-news)))) (defun gnus-summary-followup-with-original (n &optional force-news) "Compose a followup to an article and include the original article." (interactive "P") ! (gnus-summary-followup t (gnus-summary-work-articles n) force-news)) ! ! ;; Suggested by Daniel Quinlan . ! (defun gnus-summary-followup-and-reply (yank &optional yank-articles) ! "Compose a followup and do an auto mail to author." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-auto-mail-to-author 'force)) ! (gnus-summary-followup yank yank-articles))) ! (defun gnus-summary-followup-and-reply-with-original (n) ! "Compose a followup, include the original, and do an auto mail to author." ! (interactive "P") ! (gnus-summary-followup-and-reply t (gnus-summary-work-articles n))) (defun gnus-summary-cancel-article (n) "Cancel an article you posted." --- 189,232 ---- (gnus-set-global-variables) (gnus-post-news 'post gnus-newsgroup-name)) ! (defun gnus-summary-followup (yank &optional force-news) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg ! (gnus-summary-work-articles 1)))) (gnus-set-global-variables) ! (when yank ! (gnus-summary-goto-subject (car yank))) (save-window-excursion (gnus-summary-select-article)) (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) (gnus-newsgroup-name gnus-newsgroup-name)) ! ;; Send a followup. ! (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer ! yank nil force-news))) (defun gnus-summary-followup-with-original (n &optional force-news) "Compose a followup to an article and include the original article." (interactive "P") ! (gnus-summary-followup (gnus-summary-work-articles n) force-news)) ! (defun gnus-inews-yank-articles (articles) ! (let (beg article) ! (while (setq article (pop articles)) ! (save-window-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-select-article nil nil nil article) ! (gnus-summary-remove-process-mark article)) ! (gnus-copy-article-buffer) ! (let ((message-reply-buffer gnus-article-copy) ! (message-reply-headers gnus-current-headers)) ! (message-yank-original) ! (setq beg (or beg (mark t)))) ! (when articles (insert "\n"))) ! (set-marker (mark-marker) (point)) ! (goto-char beg))) (defun gnus-summary-cancel-article (n) "Cancel an article you posted." *************** *** 486,492 **** (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) (when (gnus-eval-in-buffer-window ! gnus-original-article-buffer (gnus-cancel-news)) (gnus-summary-mark-as-read article gnus-canceled-mark)) (gnus-article-hide-headers-if-wanted)) (gnus-summary-remove-process-mark article)))) --- 237,243 ---- (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) (when (gnus-eval-in-buffer-window ! gnus-original-article-buffer (message-cancel-news)) (gnus-summary-mark-as-read article gnus-canceled-mark)) (gnus-article-hide-headers-if-wanted)) (gnus-summary-remove-process-mark article)))) *************** *** 497,532 **** header line with the old Message-ID." (interactive) (gnus-set-global-variables) ! (gnus-summary-select-article t) ! ;; Check whether the user owns the article that is to be superseded. ! (unless (string-equal ! (downcase (gnus-mail-strip-quoted-names ! (mail-header-from gnus-current-headers))) ! (downcase (gnus-mail-strip-quoted-names (gnus-inews-user-name)))) ! (error "This article is not yours.")) ! ;; Get a normal *Post News* buffer. ! (gnus-new-news gnus-newsgroup-name t) ! (erase-buffer) ! (insert-buffer-substring gnus-original-article-buffer) ! (nnheader-narrow-to-headers) ! ;; Remove unwanted headers. ! (when gnus-delete-supersedes-headers ! (nnheader-remove-header gnus-delete-supersedes-headers t)) ! (goto-char (point-min)) ! (if (not (re-search-forward "^Message-ID: " nil t)) ! (error "No Message-ID in this article") ! (replace-match "Supersedes: " t t)) ! (goto-char (point-max)) ! (insert mail-header-separator) ! (widen) ! (forward-line 1)) - ;;;###autoload - (defalias 'sendnews 'gnus-post-news) - - ;;;###autoload - (defalias 'postnews 'gnus-post-news) (defun gnus-copy-article-buffer (&optional article-buffer) ;; make a copy of the article buffer with all text properties removed --- 248,259 ---- header line with the old Message-ID." (interactive) (gnus-set-global-variables) ! (gnus-setup-message 'reply-yank ! (gnus-summary-select-article t) ! (set-buffer gnus-original-article-buffer) ! (message-supersede))) (defun gnus-copy-article-buffer (&optional article-buffer) ;; make a copy of the article buffer with all text properties removed *************** *** 545,607 **** (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (gnus-set-text-properties (point-min) (point-max) ! nil gnus-article-copy))))) (defun gnus-post-news (post &optional group header article-buffer yank subject force-news) ! "Begin editing a new USENET news article to be posted. ! Type \\[describe-mode] in the buffer to get a list of commands." ! (interactive (list t)) ! (let* ((group (or group gnus-newsgroup-name)) ! (pgroup group) ! to-address to-group mailing-list to-list) ! (when group ! (setq to-address (gnus-group-get-parameter group 'to-address) ! to-group (gnus-group-get-parameter group 'to-group) ! to-list (gnus-group-get-parameter group 'to-list) ! mailing-list (when gnus-mailing-list-groups ! (string-match gnus-mailing-list-groups group)) ! group (gnus-group-real-name group))) ! (if (or (and to-group ! (gnus-news-group-p to-group)) ! force-news ! (and (gnus-news-group-p ! (or pgroup gnus-newsgroup-name) ! (if header (mail-header-number header) gnus-current-article)) ! (not mailing-list) ! (not to-list) ! (not to-address))) ! ;; This is news. ! (if post ! (gnus-new-news (or to-group group)) ! (gnus-news-followup yank (or to-group group))) ! ;; The is mail. ! (if post ! (progn ! (gnus-new-mail (or to-address to-list)) ! ;; Arrange for mail groups that have no `to-address' to ! ;; get that when the user sends off the mail. ! (unless to-address ! (make-local-variable 'gnus-add-to-address) ! (setq gnus-add-to-address group))) ! (gnus-mail-reply yank to-address 'followup))))) ! (defun gnus-post-method (group query-method &optional silent) ! "Return the posting method based on GROUP and query-method. If SILENT, don't prompt the user." ! (let ((group-method (if (stringp group) ! (gnus-find-method-for-group group) ! group))) (cond ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ! ((null group-method) ! (or gnus-post-method gnus-select-method)) ;; We want this group's method. ! ((and query-method (not (eq query-method 0))) group-method) ;; We query the user for a post method. ! ((or query-method (and gnus-post-method (listp (car gnus-post-method)))) (let* ((methods --- 272,340 ---- (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (gnus-set-text-properties (point-min) (point-max) ! nil gnus-article-copy))) ! gnus-article-copy)) (defun gnus-post-news (post &optional group header article-buffer yank subject force-news) ! (when article-buffer ! (gnus-copy-article-buffer)) ! (let ((gnus-article-reply article-buffer)) ! (gnus-setup-message (cond (yank 'reply-yank) ! (article-buffer 'reply) ! (t 'message)) ! (let* ((group (or group gnus-newsgroup-name)) ! (pgroup group) ! to-address to-group mailing-list to-list) ! (when group ! (setq to-address (gnus-group-get-parameter group 'to-address) ! to-group (gnus-group-get-parameter group 'to-group) ! to-list (gnus-group-get-parameter group 'to-list) ! mailing-list (when gnus-mailing-list-groups ! (string-match gnus-mailing-list-groups group)) ! group (gnus-group-real-name group))) ! (if (or (and to-group ! (gnus-news-group-p to-group)) ! force-news ! (and (gnus-news-group-p ! (or pgroup gnus-newsgroup-name) ! (if header (mail-header-number header) ! gnus-current-article)) ! (not mailing-list) ! (not to-list) ! (not to-address))) ! ;; This is news. ! (if post ! (message-news (or to-group group)) ! (set-buffer gnus-article-copy) ! (message-followup)) ! ;; The is mail. ! (if post ! (progn ! (message-mail (or to-address to-list)) ! ;; Arrange for mail groups that have no `to-address' to ! ;; get that when the user sends off the mail. ! (push (list 'gnus-inews-add-to-address group) ! message-send-actions)) ! (set-buffer gnus-article-copy) ! (message-wide-reply to-address))) ! (when yank ! (gnus-inews-yank-articles yank)))))) ! (defun gnus-post-method (arg group &optional silent) ! "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." ! (let ((group-method (gnus-find-method-for-group group))) (cond ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ! ((null arg) ! (or gnus-post-method gnus-select-method message-post-method)) ;; We want this group's method. ! ((and arg (not (eq arg 0))) group-method) ;; We query the user for a post method. ! ((or arg (and gnus-post-method (listp (car gnus-post-method)))) (let* ((methods *************** *** 656,713 **** (or (gnus-member-of-valid 'post group) ; Ordinary news group. (and (gnus-member-of-valid 'post-mail group) ; Combined group. (eq (gnus-request-type group article) 'news)))) - - (defun gnus-inews-news (&optional use-group-method) - "Send a news message. - - If given a non-zero prefix and the group is a foreign group, this - function will attempt to use the foreign server to post the article. - - If given an zero prefix, the user will be prompted for a posting - method to use." - (interactive "P") - (unless (gnus-alive-p) - (error "Gnus is dead; you can't post anything.")) - (or gnus-current-select-method - (setq gnus-current-select-method gnus-select-method)) - (let* ((case-fold-search nil) - (reply gnus-article-reply) - error post-result) - (save-excursion - (gnus-start-news-server) ;Use default server. - (widen) - (goto-char (point-min)) - (run-hooks 'news-inews-hook) - - ;; Send to server. - (gnus-message 5 "Posting to USENET...") - (setq post-result (funcall gnus-inews-article-function use-group-method)) - (cond - ((eq post-result 'illegal) - (setq error t) - (ding)) - (post-result - (gnus-message 5 "Posting to USENET...done") - (set-buffer-modified-p nil) - ;; We mark the article as replied. - (when (gnus-buffer-exists-p (car-safe reply)) - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-mark-article-as-replied (cdr reply))))) - (t - ;; We cannot signal an error. - (setq error t) - (ding) - (gnus-message - 1 "Article rejected: %s" - (gnus-status-message - (gnus-post-method gnus-newsgroup-name use-group-method t)))))) - - (let ((conf gnus-prev-winconf)) - (unless error - (bury-buffer) - ;; Restore last window configuration. - (and conf (set-window-configuration conf)))))) (defun gnus-inews-narrow-to-headers () (widen) --- 389,394 ---- *************** *** 719,1002 **** (point-max))) (goto-char (point-min))) ! (defun gnus-inews-send-mail-copy () ! ;; Mail the message if To, Bcc or Cc exists. ! (let* ((types '("to" "bcc" "cc")) ! (ty types) ! (buffer (current-buffer))) ! (save-restriction ! (widen) ! (gnus-inews-narrow-to-headers) ! ! (while ty ! (or (mail-fetch-field (car ty) nil t) ! (setq types (delete (car ty) types))) ! (setq ty (cdr ty))) ! ! (if (not types) ! ;; We do not want to send mail. ! () ! (gnus-message 5 "Sending via mail...") ! (widen) ! (save-excursion ! ;; We copy the article over to a temp buffer since we are ! ;; going to modify it a little. ! (nnheader-set-temp-buffer " *Gnus-mailing*") ! (insert-buffer-substring buffer) ! ;; We remove Fcc, because we don't want the mailer to see ! ;; that header. ! (gnus-inews-narrow-to-headers) ! (nnheader-remove-header "fcc") ! ! ;; Insert the X-Courtesy-Message header. ! (and (or (member "to" types) ! (member "cc" types)) ! (progn ! (goto-char (point-max)) ! (insert "Posted-To: " ! (mail-fetch-field "newsgroups") "\n"))) ! ! (widen) ! ! (if (and gnus-mail-courtesy-message ! (or (member "to" types) ! (member "cc" types))) ! ;; We only want to insert the courtesy mail message if ! ;; we use To or Cc; Bcc should not have one. Well, if ! ;; both Bcc and To are present, it will get one ! ;; anyway. ! (progn ! ;; Insert "courtesy" mail message. ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (forward-line 1) ! (insert gnus-mail-courtesy-message))) ! ! (gnus-mail-send t) ! (kill-buffer (current-buffer)) ! (gnus-message 5 "Sending via mail...done")))))) ! ! (defun gnus-inews-remove-headers-after-mail () ! (save-excursion ! (save-restriction ! (let ((case-fold-search t)) ! (gnus-inews-narrow-to-headers) ! ;; Remove Bcc completely. ! (nnheader-remove-header "bcc") ! ;; We transform To and Cc headers to avoid re-mailing if the user ! ;; accidentally (or purposefully) leans on the `C-c C-c' keys ! ;; and the news server rejects the posting. ! (while (re-search-forward "^\\(to\\|[bcf]cc\\|cc\\):" nil t) ! (beginning-of-line) ! (insert "X-")) ! (widen))))) ! ! (defun gnus-inews-dex-headers () ! "Remove \"X-\" prefixes from To and Cc headers." ! (save-excursion ! (save-restriction ! (let ((case-fold-search t)) ! (nnheader-narrow-to-headers) ! (while (re-search-forward "^X-\\(to\\|[bcf]cc\\|cc\\):" nil t) ! (beginning-of-line) ! (delete-char 2)) ! (widen))))) ! ! (defun gnus-inews-remove-empty-headers () ! "Remove empty headers from news and mail. ! The buffer should be narrowed to the headers before this function is ! called." ! (save-excursion ! (goto-char (point-min)) ! (while (re-search-forward "^[^ \t:]+:\\([ \t]*\n\\)+[^ \t]" nil t) ! (delete-region (match-beginning 0) (1- (match-end 0))) ! (beginning-of-line)))) ! ! (defun gnus-inews-check-post () ! "Check whether the post looks ok." ! (or ! (not gnus-check-before-posting) ! (and ! ;; We narrow to the headers and check them first. ! (save-excursion ! (save-restriction ! (gnus-inews-narrow-to-headers) ! (and ! ;; Check for commands in Subject. ! (or ! (gnus-check-before-posting 'subject-cmsg) ! (save-excursion ! (if (string-match "^cmsg " (mail-fetch-field "subject")) ! (gnus-y-or-n-p ! "The control code \"cmsg \" is in the subject. Really post? ") ! t))) ! ;; Check for multiple identical headers. ! (or (gnus-check-before-posting 'multiple-headers) ! (save-excursion ! (let (found) ! (while (and (not found) ! (re-search-forward "^[^ \t:]+: " nil t)) ! (save-excursion ! (or (re-search-forward ! (concat "^" (setq found ! (buffer-substring ! (match-beginning 0) ! (- (match-end 0) 2)))) ! nil t) ! (setq found nil)))) ! (if found ! (gnus-y-or-n-p ! (format "Multiple %s headers. Really post? " found)) ! t)))) ! ;; Check for Version and Sendsys. ! (or (gnus-check-before-posting 'sendsys) ! (save-excursion ! (if (re-search-forward "^Sendsys:\\|^Version:" nil t) ! (gnus-y-or-n-p ! (format "The article contains a %s command. Really post? " ! (buffer-substring (match-beginning 0) ! (1- (match-end 0))))) ! t))) ! ;; Check for Approved. ! (or (gnus-check-before-posting 'approved) ! (save-excursion ! (if (re-search-forward "^Approved:" nil t) ! (gnus-y-or-n-p ! "The article contains an Approved header. Really post? ") ! t))) ! ;; Check whether a Followup-To has redirected the newsgroup. ! (or ! (gnus-check-before-posting 'redirected-followup) ! (not gnus-newsgroup-followup) ! (save-excursion ! (let ((followups (gnus-tokenize-header ! (mail-fetch-field "Newsgroups"))) ! (newsgroups (gnus-tokenize-header ! (car gnus-newsgroup-followup)))) ! (while (and followups ! (member (car followups) newsgroups)) ! (setq followups (cdr followups))) ! (if (not followups) ! t ! (gnus-y-or-n-p ! "Followup redirected from original newsgroups. Really post? " ! ))))) ! ;; Check the Message-ID header. ! (or (gnus-check-before-posting 'message-id) ! (save-excursion ! (let* ((case-fold-search t) ! (message-id (mail-fetch-field "message-id"))) ! (or (not message-id) ! (and (string-match "@" message-id) ! (string-match "@[^\\.]*\\." message-id)) ! (gnus-y-or-n-p ! (format ! "The Message-ID looks strange: \"%s\". Really post? " ! message-id)))))) ! ;; Check whether any headers are empty. ! (or (gnus-check-before-posting 'empty-headers) ! (save-excursion ! (let ((post t)) ! (goto-char (point-min)) ! (while (and post (not (eobp))) ! (when (looking-at "\\([^ :]+\\):[ \t]\n[^ \t]") ! (setq post ! (gnus-y-or-n-p ! (format ! "The %s header is empty. Really post? " ! (match-string 1))))) ! (forward-line 1)) ! post))) ! ;; Check the From header. ! (or ! (gnus-check-before-posting 'from) ! (save-excursion ! (let* ((case-fold-search t) ! (from (mail-fetch-field "from"))) ! (cond ! ((not from) ! (gnus-y-or-n-p "There is no From line. Really post? ")) ! ((not (string-match "@[^\\.]*\\." from)) ! (gnus-y-or-n-p ! (format ! "The address looks strange: \"%s\". Really post? " from))) ! ((string-match "(.*).*(.*)" from) ! (gnus-y-or-n-p ! (format ! "The From header looks strange: \"%s\". Really post? " ! from))) ! ((string-match "<[^>]+> *$" from) ! (let ((name (substring from 0 (match-beginning 0)))) ! (or ! (string-match "^ *\"[^\"]*\" *$" name) ! (not (string-match "[][.!()<>@,;:\\]" name)) ! (gnus-y-or-n-p ! (format ! "The From header name has bogus characters. Really post? " ! from))))) ! (t t))))) ! ))) ! ;; Check for long lines. ! (or (gnus-check-before-posting 'long-lines) ! (save-excursion ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (while (and ! (progn ! (end-of-line) ! (< (current-column) 80)) ! (zerop (forward-line 1)))) ! (or (bolp) ! (eobp) ! (gnus-y-or-n-p ! "You have lines longer than 79 characters. Really post? ")))) ! ;; Check whether the article is empty. ! (or (gnus-check-before-posting 'empty) ! (save-excursion ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (forward-line 1) ! (or (re-search-forward "[^ \n\t]" nil t) ! (gnus-y-or-n-p "Empty article. Really post?")))) ! ;; Check for control characters. ! (or (gnus-check-before-posting 'control-chars) ! (save-excursion ! (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) ! (gnus-y-or-n-p ! "The article contains control characters. Really post? ") ! t))) ! ;; Check excessive size. ! (or (gnus-check-before-posting 'size) ! (if (> (buffer-size) 60000) ! (gnus-y-or-n-p ! (format "The article is %d octets long. Really post? " ! (buffer-size))) ! t)) ! ;; Use the (size . checksum) variable to see whether the ! ;; article is empty or has only quoted text. ! (or ! (gnus-check-before-posting 'new-text) ! (not gnus-article-check-size) ! (if (and (= (buffer-size) (car gnus-article-check-size)) ! (= (gnus-article-checksum) (cdr gnus-article-check-size))) ! (gnus-y-or-n-p ! "It looks like there's no new text in your article. Really post? ") ! t)) ! ;; Check the length of the signature. ! (or (gnus-check-before-posting 'signature) ! (progn ! (goto-char (point-max)) ! (if (not (re-search-backward gnus-signature-separator nil t)) ! t ! (if (> (count-lines (point) (point-max)) 5) ! (gnus-y-or-n-p ! (format ! "Your .sig is %d lines; it should be max 4. Really post? " ! (count-lines (point) (point-max)))) ! t))))))) (defvar gnus-inews-sent-ids nil) --- 400,408 ---- (point-max))) (goto-char (point-min))) ! ;;; ! ;;; Check whether the message has been sent already. ! ;;; (defvar gnus-inews-sent-ids nil) *************** *** 1026,1046 **** (current-buffer))) nil))))) - (defun gnus-tokenize-header (header &optional separator) - "Split HEADER into a list of header elements. - \",\" is used as the separator." - (let* ((beg 0) - (separator (or separator ",")) - (regexp - (format "[ \t]*\\([^%s]+\\)?\\([%s]+\\|\\'\\)" separator separator)) - elems) - (while (and (string-match regexp header beg) - (< beg (length header))) - (when (match-beginning 1) - (push (match-string 1 header) elems)) - (setq beg (match-end 0))) - (nreverse elems))) - (defun gnus-article-checksum () (let ((sum 0)) (save-excursion --- 432,437 ---- *************** *** 1049,1309 **** (forward-char 1))) sum)) - ;; Returns non-nil if this type is not to be checked. - (defun gnus-check-before-posting (type) - (not - (or (not gnus-check-before-posting) - (if (listp gnus-check-before-posting) - (memq type gnus-check-before-posting) - t)))) - - (defun gnus-cancel-news () - "Cancel an article you posted." - (interactive) - (if (or gnus-expert-user - (gnus-yes-or-no-p "Do you really want to cancel this article? ")) - (let ((from nil) - (newsgroups nil) - (message-id nil) - (distribution nil)) - (or (gnus-news-group-p gnus-newsgroup-name) - (error "This backend does not support canceling")) - (save-excursion - ;; Get header info. from original article. - (save-restriction - (gnus-article-show-all-headers) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (narrow-to-region (point-min) (point)) - (setq from (mail-fetch-field "from")) - (setq newsgroups (mail-fetch-field "newsgroups")) - (setq message-id (mail-fetch-field "message-id")) - (setq distribution (mail-fetch-field "distribution"))) - ;; Verify if the article is absolutely user's by comparing - ;; user id with value of its From: field. - (if (not - (string-equal - (downcase (gnus-mail-strip-quoted-names from)) - (downcase (gnus-mail-strip-quoted-names - (gnus-inews-user-name))))) - (progn - (ding) (gnus-message 3 "This article is not yours.") - nil) - ;; Make control article. - (set-buffer (get-buffer-create " *Gnus-canceling*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert "Newsgroups: " newsgroups "\n" - "From: " (gnus-inews-user-name) "\n" - "Subject: cancel " message-id "\n" - "Control: cancel " message-id "\n" - (if distribution - (concat "Distribution: " distribution "\n") - "") - mail-header-separator "\n" - "This is a cancel message from " from ".\n") - ;; Send the control article to NNTP server. - (gnus-message 5 "Canceling your article...") - (prog1 - (if (funcall gnus-inews-article-function) - (gnus-message 5 "Canceling your article...done") - (progn - (ding) - (gnus-message 1 "Cancel failed; %s" - (gnus-status-message gnus-newsgroup-name)) - nil) - t) - ;; Kill the article buffer. - (kill-buffer (current-buffer)))))))) - - (defun gnus-inews-remove-signature () - "Remove the signature from the text between point and mark. - The text will also be indented the normal way. - This function can be used in `mail-citation-hook', for instance." - (save-excursion - (let ((start (point)) - mark) - (if (not (re-search-forward gnus-signature-separator (mark t) t)) - ;; No signature here, so we just indent the cited text. - (mail-indent-citation) - ;; Find the last non-empty line. - (forward-line -1) - (while (looking-at "[ \t]*$") - (forward-line -1)) - (forward-line 1) - (setq mark (set-marker (make-marker) (point))) - (goto-char start) - (mail-indent-citation) - ;; Enable undoing the deletion. - (undo-boundary) - (delete-region mark (mark t)) - (set-marker mark nil))))) - ;; Dummy to avoid byte-compile warning. (defvar nnspool-rejected-article-hook) - (defun gnus-inews-article (&optional use-group-method) - "Post an article in current buffer using NNTP protocol." - (let ((artbuf (current-buffer)) - gcc result) - (widen) - (goto-char (point-max)) - ;; Require a newline at the end of the buffer since inews may - ;; append a .signature. - (or (= (preceding-char) ?\n) - (insert ?\n)) - ;; Prepare article headers. All message body such as signature - ;; must be inserted before Lines: field is prepared. - (save-restriction - (gnus-inews-narrow-to-headers) - ;; Fix some headers. - (gnus-inews-cleanup-headers) - ;; Remove some headers. - (gnus-inews-remove-headers) - ;; Insert some headers. - (gnus-inews-insert-headers) - ;; Let the user do all of the above. - (run-hooks 'gnus-inews-article-header-hook) - ;; Copy the Gcc header, if any. - (setq gcc (mail-fetch-field "gcc")) - (widen)) - ;; Check whether the article is a good Net Citizen. - (if (not (gnus-inews-check-post)) - ;; Aber nein! - 'illegal - ;; We fudge a hook for nnspool. - (setq nnspool-rejected-article-hook - `((lambda () - (condition-case () - (save-excursion - (set-buffer ,(buffer-name)) - (gnus-associate-buffer-with-draft nil 'silent)) - (error - (ding) - (gnus-message - 1 "Couldn't enter rejected article into draft group")))))) - - ;; Looks ok, so we do the nasty. - (save-excursion - ;; This hook may insert a signature. - (save-excursion - (goto-char (point-min)) - (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups") - gnus-newsgroup-name))) - (run-hooks 'gnus-prepare-article-hook))) - ;; Send off copies using mail, if that is wanted. - (gnus-inews-send-mail-copy) - ;; Remove more headers. - (gnus-inews-remove-headers-after-mail) - ;; Copy the article over to a temp buffer. - (nnheader-set-temp-buffer " *Gnus-posting*") - (insert-buffer-substring artbuf) - ;; Remove the header separator. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (replace-match "" t t) - ;; Remove X- prefixes to headers. - (gnus-inews-dex-headers) - ;; Run final inews hooks. This hook may do FCC. - ;; The article must be saved before being posted because - ;; `gnus-request-post' modifies the buffer. - (save-window-excursion - (switch-to-buffer (current-buffer)) - (run-hooks 'gnus-inews-article-hook)) - ;; Copy the article over to some group, possibly. - (and gcc (gnus-inews-do-gcc gcc)) - ;; Post the article. - (setq result (gnus-request-post - (gnus-post-method gnus-newsgroup-name use-group-method))) - (kill-buffer (current-buffer))) - (run-hooks 'gnus-message-sent-hook) - ;; If the posting was unsuccessful (that it, it was rejected) we - ;; put it into the draft group. - (or result (gnus-associate-buffer-with-draft)) - result))) - - (defun gnus-inews-cleanup-headers () - ;; Remove empty lines in the header. - (save-restriction - (gnus-inews-narrow-to-headers) - (while (re-search-forward "^[ \t]*\n" nil t) - (replace-match "" t t))) - - ;; Correct newsgroups field: change sequence of spaces to comma and - ;; eliminate spaces around commas. Eliminate imbedded line breaks. - (goto-char (point-min)) - (when (re-search-forward "^Newsgroups: +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (forward-line 1) - (point))) - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) ;No line breaks (too confusing) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) - (replace-match "," t t)) - (goto-char (point-min)) - ;; Remove trailing commas. - (when (re-search-forward ",+$" nil t) - (replace-match "" t t)))) - - ;; Added by Per Abrahamsen . - ;; Help save the the world! - (unless gnus-expert-user - (let ((newsgroups (mail-fetch-field "newsgroups")) - (followup-to (mail-fetch-field "followup-to")) - to) - (when (and newsgroups (string-match "," newsgroups) - (not followup-to) - (not - (zerop - (length - (setq to (completing-read - "Followups to: (default all groups) " - (mapcar (lambda (g) (list g)) - (cons "poster" - (gnus-tokenize-header - newsgroups))))))))) - (goto-char (point-min)) - (insert "Followup-To: " to "\n")))) - - ;; Cleanup Followup-To. - (goto-char (point-min)) - (when (search-forward-regexp "^Followup-To: +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil 'end) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - ;; No line breaks (too confusing) - (while (re-search-forward "\n[ \t]+" nil t ) - (replace-match " " t )) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) - (replace-match "," t t))))) - - (defun gnus-inews-remove-headers () - (let ((case-fold-search t) - (headers gnus-removable-headers)) - ;; Remove toxic headers. - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (downcase (format "%s" (car headers)))) - nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq headers (cdr headers))))) - ;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might ;;; as well include the Emacs version as well. ;;; The following function works with later GNU Emacs, and XEmacs. --- 440,450 ---- *************** *** 1325,1497 **** (format " %d.%d" emacs-major-version emacs-minor-version))) (t emacs-version)))) - (defun gnus-inews-insert-headers (&optional headers) - "Prepare article headers. - Headers already prepared in the buffer are not modified. - Headers in `gnus-required-headers' will be generated." - (let* ((Date (gnus-inews-date)) - (Message-ID (gnus-inews-message-id)) - (Organization (gnus-inews-organization)) - (From (gnus-inews-user-name)) - (Path (gnus-inews-path)) - (Subject nil) - (Newsgroups nil) - (In-Reply-To (gnus-inews-in-reply-to)) - (To nil) - (Distribution (gnus-inews-distribution)) - (Lines (gnus-inews-lines)) - (X-Newsreader (gnus-extended-version)) - (X-Mailer X-Newsreader) - (Expires (gnus-inews-expires)) - (headers (or headers gnus-required-headers)) - (case-fold-search t) - header value elem) - ;; First we remove any old generated headers. - (let ((headers gnus-deletable-headers)) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (get-text-property (1+ (match-beginning 0)) 'gnus-deletable) - (gnus-delete-line)) - (setq headers (cdr headers)))) - ;; If there are References, and no "Re: ", then the thread has - ;; changed name. See Son-of-1036. - (if (and (mail-fetch-field "references") - (get-buffer gnus-article-buffer)) - (let ((psubject (gnus-simplify-subject-re - (mail-fetch-field "subject")))) - (or (and psubject gnus-reply-subject - (string= (gnus-simplify-subject-re gnus-reply-subject) - psubject)) - (progn - (string-match "@" Message-ID) - (setq Message-ID - (concat (substring Message-ID 0 (match-beginning 0)) - "_-_" - (substring Message-ID (match-beginning 0)))))))) - ;; Go through all the required headers and see if they are in the - ;; articles already. If they are not, or are empty, they are - ;; inserted automatically - except for Subject, Newsgroups and - ;; Distribution. - (while headers - (goto-char (point-min)) - (setq elem (pop headers)) - (if (consp elem) - (setq header (car elem)) - (setq header elem)) - (when (or (not (re-search-forward - (concat "^" (downcase (symbol-name header)) ":") nil t)) - (progn - ;; The header was found. We insert a space after the - ;; colon, if there is none. - (if (/= (following-char) ? ) (insert " ")) - ;; Find out whether the header is empty... - (looking-at "[ \t]*$"))) - ;; So we find out what value we should insert. - (setq value - (cond - ((and (consp elem) (eq (car elem) 'optional)) - ;; This is an optional header. If the cdr of this - ;; is something that is nil, then we do not insert - ;; this header. - (setq header (cdr elem)) - (or (and (fboundp (cdr elem)) (funcall (cdr elem))) - (and (boundp (cdr elem)) (symbol-value (cdr elem))))) - ((consp elem) - ;; The element is a cons. Either the cdr is a - ;; string to be inserted verbatim, or it is a - ;; function, and we insert the value returned from - ;; this function. - (or (and (stringp (cdr elem)) (cdr elem)) - (and (fboundp (cdr elem)) (funcall (cdr elem))))) - ((and (boundp header) (symbol-value header)) - ;; The element is a symbol. We insert the value - ;; of this symbol, if any. - (symbol-value header)) - (t - ;; We couldn't generate a value for this header, - ;; so we just ask the user. - (read-from-minibuffer - (format "Empty header for %s; enter value: " header))))) - ;; Finally insert the header. - (when (and value - (not (equal value ""))) - (save-excursion - (if (bolp) - (progn - ;; This header didn't exist, so we insert it. - (goto-char (point-max)) - (insert (symbol-name header) ": " value "\n") - (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)) - (insert value)) - ;; Add the deletable property to the headers that require it. - (and (memq header gnus-deletable-headers) - (progn (beginning-of-line) (looking-at "[^:]+: ")) - (add-text-properties - (point) (match-end 0) - '(gnus-deletable t face italic) (current-buffer))))))) - ;; Insert new Sender if the From is strange. - (let ((from (mail-fetch-field "from")) - (sender (mail-fetch-field "sender")) - (secure-sender (gnus-inews-real-user-address))) - (when (and from - (not (gnus-check-before-posting 'sender)) - (not (string= - (downcase (cadr (gnus-extract-address-components from))) - (downcase (gnus-inews-real-user-address)))) - (or (null sender) - (not - (string= - (downcase - (cadr (gnus-extract-address-components sender))) - (downcase secure-sender))))) - (goto-char (point-min)) - ;; Rename any old Sender headers to Original-Sender. - (when (re-search-forward "^Sender:" nil t) - (beginning-of-line) - (insert "Original-") - (beginning-of-line)) - (insert "Sender: " secure-sender "\n"))))) - - (defun gnus-inews-insert-signature () - "Insert a signature file. - If `gnus-signature-function' is bound and returns a string, this - string is used instead of the variable `gnus-signature-file'. - In either case, if the string is a file name, this file is - inserted. If the string is not a file name, the string itself is - inserted. - - If you never want any signature inserted, set both of these variables to - nil." - (save-excursion - (let ((signature - (or (and gnus-signature-function - (funcall gnus-signature-function gnus-newsgroup-name)) - gnus-signature-file))) - (if (and signature - (or (file-exists-p signature) - (string-match " " signature) - (not (string-match - "^/[^/]+/" (expand-file-name signature))))) - (progn - (goto-char (point-max)) - (if (and mail-signature (search-backward "\n-- \n" nil t)) - () - ;; Delete any previous signatures. - (if (search-backward "\n-- \n" nil t) - (delete-region (point) (point-max))) - (or (eolp) (insert "\n")) - (insert "-- \n") - (if (file-exists-p signature) - (insert-file-contents signature) - (insert signature)) - (goto-char (point-max)) - (or (bolp) (insert "\n")))))))) - ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () (goto-char (point-min)) --- 466,471 ---- *************** *** 1518,1756 **** (or (mail-position-on-field "Content-Transfer-Encoding") (insert "7bit"))))))) - (defun gnus-inews-do-fcc () - "Process Fcc headers in the current buffer. - Unless the first character of the field is `|', the article is saved - to the specified file using the function specified by the variable - gnus-author-copy-saver. The default function rmail-output saves in - Unix mailbox format. - - If the first character is `|', the contents of the article is sent to - a program specified by the rest of the value." - (let ((case-fold-search t) ;Should ignore case. - list file) - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (while (setq file (mail-fetch-field "fcc")) - (push file list) - (nnheader-remove-header "fcc" nil t)) - ;; Process FCC operations. - (widen) - (while list - (setq file (pop list)) - (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) - ;; Pipe the article to the program in question. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil "-c" (match-string 1 file)) - ;; Save the article. - (setq file (expand-file-name file)) - (gnus-make-directory (file-name-directory file)) - (if (and gnus-author-copy-saver - (not (eq gnus-author-copy-saver 'rmail-output))) - (funcall gnus-author-copy-saver file) - (if (and (file-readable-p file) (mail-file-babyl-p file)) - (gnus-output-to-rmail file) - (let ((mail-use-rfc822 t)) - (rmail-output file 1 t t)))))))))) - - (defun gnus-inews-path () - "Return uucp path." - (let ((login-name (gnus-inews-login-name))) - (cond ((null gnus-use-generic-path) - (concat (nth 1 gnus-select-method) "!" login-name)) - ((stringp gnus-use-generic-path) - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. - (concat gnus-use-generic-path "!" login-name)) - (t login-name)))) - - (defun gnus-inews-user-name () - "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"." - (let ((full-name (gnus-inews-full-name)) - (address (if (or gnus-user-login-name gnus-use-generic-from - gnus-local-domain (getenv "DOMAINNAME")) - (concat (gnus-inews-login-name) "@" - (gnus-inews-domain-name gnus-use-generic-from)) - user-mail-address))) - (or gnus-user-from-line - (concat address - ;; User's full name. - (cond ((string-equal full-name "&") ;Unix hack. - (concat " (" (user-login-name) ")")) - ((string-match "[^ ]+@[^ ]+ +(.*)" address) - "") - (t - (concat " (" full-name ")"))))))) - - (defun gnus-inews-real-user-address () - "Return the \"real\" user address. - This function tries to ignore all user modifications, and - give as trustworthy answer as possible." - (concat (user-login-name) "@" (system-name))) - - (defun gnus-inews-login-name () - "Return login name." - (or gnus-user-login-name (getenv "LOGNAME") (user-login-name))) - - (defun gnus-inews-full-name () - "Return full user name." - (or gnus-user-full-name (getenv "NAME") (user-full-name))) - - (defun gnus-inews-domain-name (&optional genericfrom) - "Return user's domain name. - If optional argument GENERICFROM is a string, use it as the domain - name; if it is non-nil, strip off local host name from the domain name. - If the function `system-name' returns full internet name and the - domain is undefined, the domain name is got from it." - (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) - (let* ((system-name (system-name)) - (domain - (or (if (stringp genericfrom) genericfrom) - (getenv "DOMAINNAME") - (and (boundp 'mail-host-address) - mail-host-address) - gnus-local-domain - ;; Function `system-name' may return full internet name. - ;; Suggested by Mike DeCorte . - (if (string-match "\\.." system-name) - ;; Some machines return "name.", and that's not - ;; very nice. - (substring system-name (1- (match-end 0)))) - (read-string "Domain name (no host): "))) - (host (or (if (string-match "\\." system-name) - (substring system-name 0 (match-beginning 0))) - system-name))) - (if (string-equal "." (substring domain 0 1)) - (setq domain (substring domain 1))) - ;; Support GENERICFROM as same as standard Bnews system. - ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. - (cond ((null genericfrom) - (concat host "." domain)) - ;;((stringp genericfrom) genericfrom) - (t domain))) - (if (string-match "\\." (system-name)) - (system-name) - (if (string-match "@\\([^ ]+\\)\\($\\| \\)" user-mail-address) - (substring user-mail-address - (match-beginning 1) (match-end 1)) - "bogus-domain")))) - - (defun gnus-inews-full-address () - (let ((domain (gnus-inews-domain-name)) - (system (system-name)) - (case-fold-search t)) - (if (string-match "\\." system) system - (if (string-match (concat "^" (regexp-quote system)) domain) domain - (concat system "." domain))))) - - (defun gnus-inews-expires () - "Return an Expires header based on `gnus-article-expires'." - (let ((current (current-time)) - (future (* 1.0 gnus-article-expires 60 60 24))) - ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - ;; Return the date in the future in UT. - (timezone-make-date-arpa-standard - (current-time-string current) (current-time-zone) '(0 "UT")))) - - (defun gnus-inews-distribution () - "Return the current Distribution header, if any." - (when (and gnus-distribution-function - (fboundp gnus-distribution-function)) - (funcall gnus-distribution-function - (or gnus-newsgroup-name - (save-excursion (mail-fetch-field "newsgroups")) - "")))) - - (defun gnus-inews-message-id () - "Generate unique Message-ID for user." - ;; Message-ID should not contain a slash and should be terminated by - ;; a number. I don't know the reason why it is so. - (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">")) - - (defvar gnus-unique-id-char nil) - - ;; If you ever change this function, make sure the new version - ;; cannot generate IDs that the old version could. - ;; You might for example insert a "." somewhere (not next to another dot - ;; or string boundary), or modify the newsreader name to "Ding". - (defun gnus-inews-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. - ;; Instead we use this randomly inited counter. - (setq gnus-unique-id-char - (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20))))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (if (fboundp 'current-time) - (current-time) '(12191 46742 287898)))) - (concat - (if (memq system-type '(ms-dos emx vax-vms)) - (let ((user (downcase (gnus-inews-login-name)))) - (while (string-match "[^a-z0-9_]" user) - (aset user (match-beginning 0) ?_)) - user) - (gnus-number-base36 (user-uid) -1)) - (gnus-number-base36 (+ (car tm) (lsh (% gnus-unique-id-char 25) 16)) 4) - (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4) - ;; Append the newsreader name, because while the generated - ;; ID is unique to this newsreader, other newsreaders might - ;; otherwise generate the same ID via another algorithm. - ".fsf"))) - - (defun gnus-inews-date () - "Current time string." - (let ((now (current-time))) - (timezone-make-date-arpa-standard - (current-time-string now) (current-time-zone now)))) - - (defun gnus-inews-organization () - "Return user's organization. - The ORGANIZATION environment variable is used if defined. - If not, the variable `gnus-local-organization' is used instead. - If it is a function, the function will be called with the current - newsgroup name as the argument. - If this is a file name, the contents of this file will be used as the - organization." - (let* ((organization - (or (getenv "ORGANIZATION") - (if gnus-local-organization - (if (gnus-functionp gnus-local-organization) - (funcall gnus-local-organization gnus-newsgroup-name) - gnus-local-organization)) - gnus-organization-file - "~/.organization"))) - (and (stringp organization) - (> (length organization) 0) - (or (file-exists-p organization) - (string-match " " organization) - (not (string-match "^/usr/lib/\\|^~/" organization))) - (save-excursion - (gnus-set-work-buffer) - (if (file-exists-p organization) - (insert-file-contents organization) - (insert organization)) - (goto-char (point-min)) - (while (re-search-forward " *\n *" nil t) - (replace-match " " t t)) - (buffer-substring (point-min) (point-max)))))) - - (defun gnus-inews-lines () - "Count the number of lines and return numeric string." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (int-to-string (count-lines (point) (point-max)))))) - - (defun gnus-inews-in-reply-to () - "Return the In-Reply-To header for this message." - gnus-in-reply-to) - ;;; ;;; Gnus Mail Functions --- 492,497 ---- *************** *** 1758,1837 **** ;;; Mail reply commands of Gnus summary mode ! (defun gnus-summary-reply (yank &optional yank-articles) "Reply mail to news author. ! If prefix argument YANK is non-nil, original article is yanked automatically. ! Customize the variable gnus-mail-reply-method to use another mailer." ! (interactive "P") ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (if yank-articles (gnus-summary-goto-subject (car yank-articles))) ! (gnus-summary-select-article) ! (bury-buffer gnus-article-buffer) ! (gnus-mail-reply (or yank-articles (not (not yank))))) (defun gnus-summary-reply-with-original (n) "Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer." (interactive "P") ! (gnus-summary-reply t (gnus-summary-work-articles n))) ! (defun gnus-summary-mail-forward (post) ! "Forward the current message to another user. ! Customize the variable gnus-mail-forward-method to use another mailer." (interactive "P") (gnus-set-global-variables) ! (gnus-summary-select-article) ! (gnus-copy-article-buffer) ! (if post ! (gnus-forward-using-post gnus-original-article-buffer) ! (gnus-mail-forward gnus-original-article-buffer))) (defun gnus-summary-resend-message (address) "Resend the current article to ADDRESS." (interactive "sResend message to: ") (gnus-summary-select-article) (save-excursion ! (let (beg) ! ;; We first set up a normal mail buffer. ! (nnheader-set-temp-buffer " *Gnus resend*") ! ;; This code from sendmail.el ! (insert "To: ") ! (let ((fill-prefix "\t") ! (address-start (point))) ! (insert address "\n") ! (fill-region-as-paragraph address-start (point-max))) ! (insert mail-header-separator "\n") ! ;; Insert our usual headers. ! (gnus-inews-narrow-to-headers) ! (gnus-inews-insert-headers '(From Date To)) ! (goto-char (point-min)) ! ;; Rename them all to "Resent-*". ! (while (re-search-forward "^[A-Za-z]" nil t) ! (forward-char -1) ! (insert "Resent-")) ! (widen) ! (forward-line) ! (delete-region (point) (point-max)) ! (setq beg (point)) ! ;; Insert the message to be resent. ! (insert-buffer-substring gnus-original-article-buffer) ! (goto-char (point-min)) ! (search-forward "\n\n") ! (forward-char -1) ! (save-restriction ! (narrow-to-region beg (point)) ! (nnheader-remove-header gnus-ignored-resent-headers t) ! (goto-char (point-max))) ! (insert mail-header-separator) ! ;; Rename all old ("Also-")Resent headers. ! (while (re-search-backward "^\\(Also-\\)?Resent-" beg t) ! (beginning-of-line) ! (insert "Also-")) ! ;; Send it. ! (mail-send) ! (kill-buffer (current-buffer))))) (defun gnus-summary-post-forward () "Forward the current article to a newsgroup." --- 499,545 ---- ;;; Mail reply commands of Gnus summary mode ! (defun gnus-summary-reply (&optional yank) "Reply mail to news author. ! If prefix argument YANK is non-nil, original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg ! (gnus-summary-work-articles 1)))) ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (when yank ! (gnus-summary-goto-subject (car yank))) ! (let ((gnus-article-reply t)) ! (gnus-setup-message (if yank 'reply-yank 'reply) ! (gnus-summary-select-article) ! (set-buffer (gnus-copy-article-buffer)) ! (message-reply) ! (when yank ! (gnus-inews-yank-articles yank))))) (defun gnus-summary-reply-with-original (n) "Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer." (interactive "P") ! (gnus-summary-reply (gnus-summary-work-articles n))) ! (defun gnus-summary-mail-forward (&optional post) ! "Forward the current message to another user." (interactive "P") (gnus-set-global-variables) ! (gnus-setup-message 'forward ! (gnus-summary-select-article) ! (set-buffer gnus-original-article-buffer) ! (message-forward post))) (defun gnus-summary-resend-message (address) "Resend the current article to ADDRESS." (interactive "sResend message to: ") (gnus-summary-select-article) (save-excursion ! (set-buffer gnus-original-article-buffer) ! (message-resend address))) (defun gnus-summary-post-forward () "Forward the current article to a newsgroup." *************** *** 1851,2098 **** "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) ! (set-buffer gnus-mail-buffer) (insert (format gnus-nastygram-message group)) ! (gnus-mail-send-and-exit)))) (defun gnus-summary-mail-other-window () ! "Compose mail in other window. ! Customize the variable `gnus-mail-other-window-method' to use another ! mailer." (interactive) (gnus-set-global-variables) ! (gnus-new-mail ! ;; We might want to prompt here. ! (when (and gnus-interactive-post ! (not gnus-expert-user)) ! (read-string "To: "))) ! (gnus-configure-windows 'summary-mail 'force)) ! ! (defun gnus-new-mail (&optional to) ! (let (subject) ! (when (and gnus-interactive-post ! (not gnus-expert-user)) ! (setq subject (read-string "Subject: "))) ! (pop-to-buffer gnus-default-mail-buffer) ! (erase-buffer) ! (gnus-mail-setup 'new to subject) ! (gnus-inews-insert-gcc) ! (gnus-inews-insert-archive-gcc) ! (run-hooks 'gnus-mail-hook))) ! ! (defun gnus-new-empty-mail () ! "Create a new, virtually empty mail mode buffer." ! (pop-to-buffer gnus-default-mail-buffer) ! (gnus-mail-setup 'new "" "")) ! ! (defun gnus-mail-reply (&optional yank to-address followup) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let ((group gnus-newsgroup-name) ! (cur (cons (current-buffer) (cdr gnus-article-current))) ! (winconf (current-window-configuration)) ! from subject date reply-to message-of to cc ! references message-id sender follow-to sendto elt new-cc new-to ! mct mctdo gnus-warning) ! (set-buffer (get-buffer-create gnus-default-mail-buffer)) ! (mail-mode) ! (if (and (buffer-modified-p) ! (> (buffer-size) 0) ! (not (gnus-y-or-n-p ! "Unsent message being composed; erase it? "))) ! () ! (erase-buffer) ! (save-excursion ! (gnus-copy-article-buffer) ! (save-restriction ! (set-buffer gnus-article-copy) ! (nnheader-narrow-to-headers) ! (if (not followup) ! ;; This is a regular reply. ! (if (gnus-functionp gnus-reply-to-function) ! (setq follow-to (funcall gnus-reply-to-function group))) ! ;; This is a followup. ! (if (gnus-functionp gnus-followup-to-function) ! (save-excursion ! (setq follow-to ! (funcall gnus-followup-to-function group))))) ! (setq from (mail-fetch-field "from")) ! (setq date (or (mail-fetch-field "date") ! (mail-header-date gnus-current-headers))) ! (setq message-of (gnus-message-of from date)) ! (setq sender (mail-fetch-field "sender")) ! (setq subject (or (mail-fetch-field "subject") "none")) ! ;; Remove any (buggy) Re:'s that are present and make a ! ;; proper one. ! (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject) ! (setq subject (substring subject (match-end 0)))) ! (setq subject (concat "Re: " subject)) ! (setq to (mail-fetch-field "to")) ! (setq cc (mail-fetch-field "cc")) ! (setq mct (mail-fetch-field "mail-copies-to")) ! (setq reply-to ! (unless (gnus-group-get-parameter group 'broken-reply-to) ! (mail-fetch-field "reply-to"))) ! (setq references (mail-fetch-field "references")) ! (setq message-id (mail-fetch-field "message-id")) ! (when (and (setq gnus-warning (mail-fetch-field "gnus-warning")) ! (string-match "<[^>]+>" gnus-warning)) ! (setq message-id (match-string 0 gnus-warning))) ! ! (setq mctdo (and mct (not (equal mct "never")))) ! (when (and mct (string= (downcase mct) "always")) ! (setq mct (or reply-to from))) ! ! (if (not (and followup (not to-address))) ! (setq new-to (or reply-to from) ! new-cc ! (if (and mctdo ! (not (string= ! (gnus-mail-strip-quoted-names mct) ! (gnus-mail-strip-quoted-names ! (or to-address ! (if (and follow-to ! (not (stringp follow-to))) ! sendto ! (or follow-to new-to ! sender ""))))))) ! mct)) ! (let (ccalist) ! (save-excursion ! (gnus-set-work-buffer) ! (unless (equal mct "never") ! (insert (or reply-to from ""))) ! (insert ! (if (bolp) "" ", ") (or to "") ! (if (or (not mct) (not mctdo)) "" ! (concat (if (bolp) "" ", ") mct)) ! (if cc (concat (if (bolp) "" ", ") cc) "")) ! ;; Remove addresses that match `rmail-dont-reply-to-names'. ! (insert (prog1 (rmail-dont-reply-to (buffer-string)) ! (erase-buffer))) ! (goto-char (point-min)) ! (setq ccalist ! (mapcar ! (lambda (addr) ! (cons (gnus-mail-strip-quoted-names addr) addr)) ! (nreverse (gnus-mail-parse-comma-list)))) ! (let ((s ccalist)) ! (while s ! (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) ! (setq new-to (cdr (pop ccalist))) ! (setq new-cc ! (mapconcat ! (lambda (addr) (cdr addr)) ! ccalist ", ")))) ! (widen))) ! ! (setq news-reply-yank-from (or from "(nobody)")) ! (setq news-reply-yank-message-id ! (or message-id "(unknown Message-ID)")) ! ! ;; Gather the "to" addresses out of the follow-to list and remove ! ;; them as we go. ! (if (and follow-to (listp follow-to)) ! (while (setq elt (assoc "To" follow-to)) ! (setq sendto (concat sendto (and sendto ", ") (cdr elt))) ! (setq follow-to (delq elt follow-to)))) ! ! (gnus-mail-setup ! (if followup 'followup 'reply) ! (or to-address ! (if (and follow-to (not (stringp follow-to))) sendto ! (or follow-to new-to sender ""))) ! subject message-of ! (if (zerop (length new-cc)) nil new-cc) ! gnus-article-copy) ! ! (make-local-variable 'gnus-article-reply) ! (setq gnus-article-reply cur) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf) ! (make-local-variable 'gnus-reply-subject) ! (setq gnus-reply-subject subject) ! (make-local-variable 'gnus-in-reply-to) ! (setq gnus-in-reply-to message-of) ! ! (auto-save-mode auto-save-default) ! (gnus-inews-insert-gcc) ! (gnus-inews-insert-archive-gcc group) ! ! (when (and follow-to (listp follow-to)) ! (let (beg) ! (gnus-inews-narrow-to-headers) ! (re-search-forward "^To:" nil t) ! (beginning-of-line) ! (forward-line 1) ! (setq beg (point)) ! ;; Insert the rest of the Follow-To headers. ! (while follow-to ! (goto-char (point-min)) ! (if (not (re-search-forward ! (concat "^" (caar follow-to) ":") nil t)) ! (progn ! (goto-char beg) ! (insert (caar follow-to) ": " (cdar follow-to) "\n")) ! (if (eolp) ! (insert " ") ! (skip-chars-forward " ") ! (unless (eolp) ! (end-of-line) ! (insert ", "))) ! (insert (cdar follow-to))) ! (setq follow-to (cdr follow-to))) ! (widen))) ! (nnheader-insert-references references message-id) ! ! ;; Now the headers should be ok, so we do the yanking. ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (forward-line 1) ! (if (not yank) ! (gnus-configure-windows 'reply 'force) ! (let ((last (point)) ! end) ! (if (not (listp yank)) ! (progn ! ;; Just a single article being yanked. ! (save-excursion ! (mail-yank-original nil)) ! (or mail-yank-hooks mail-citation-hook ! (run-hooks 'news-reply-header-hook))) ! (while yank ! (save-window-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-select-article nil nil nil (car yank)) ! (gnus-summary-remove-process-mark (car yank))) ! (save-excursion ! (setq end (point)) ! (gnus-copy-article-buffer) ! (mail-yank-original nil) ! (save-restriction ! (narrow-to-region (point-min) (point)) ! (goto-char (mark t)) ! (let ((news-reply-yank-from ! (save-excursion ! (set-buffer gnus-article-buffer) ! (or (mail-fetch-field "from") "(nobody)"))) ! (news-reply-yank-message-id ! (save-excursion ! (set-buffer gnus-article-buffer) ! (or (mail-fetch-field "message-id") ! "(unknown Message-ID)")))) ! (or mail-yank-hooks mail-citation-hook ! (run-hooks 'news-reply-header-hook)) ! (setq end (point-max))))) ! (goto-char end) ! (setq yank (cdr yank)))) ! (goto-char last)) ! (forward-line 2) ! (gnus-configure-windows 'reply-yank 'force)) ! (run-hooks 'gnus-mail-hook) ! ;; Mark this buffer as unchanged. ! (set-buffer-modified-p nil))))) (defun gnus-mail-parse-comma-list () (let (accumulated --- 559,573 ---- "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) ! (set-buffer gnus-message-buffer) (insert (format gnus-nastygram-message group)) ! (message-send-and-exit)))) (defun gnus-summary-mail-other-window () ! "Compose mail in other window." (interactive) (gnus-set-global-variables) ! (message-mail)) (defun gnus-mail-parse-comma-list () (let (accumulated *************** *** 2121,2379 **** (skip-chars-forward ", ")) accumulated)) - (defun gnus-new-news (&optional group inhibit-prompt) - "Set up a *Post Gnus* buffer that points to GROUP. - If INHIBIT-PROMPT, never prompt for a Subject." - (let ((winconf (current-window-configuration)) - subject) - (when (and gnus-interactive-post - (not inhibit-prompt) - (not gnus-expert-user)) - (setq subject (read-string "Subject: "))) - (pop-to-buffer gnus-default-post-news-buffer) - (erase-buffer) - (news-reply-mode) - - ;; Let posting styles be configured. - (gnus-configure-posting-styles) - (news-setup nil subject nil (and group (gnus-group-real-name group)) nil) - ;; Associate this buffer with the draft group. - (gnus-enter-buffer-into-draft) - (goto-char (point-min)) - - (unless (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (goto-char (point-max))) - (insert "\n\n") - - (gnus-inews-insert-bfcc) - (gnus-inews-insert-gcc) - (gnus-inews-insert-archive-gcc group) - (gnus-inews-insert-signature) - (and gnus-post-prepare-function - (gnus-functionp gnus-post-prepare-function) - (funcall gnus-post-prepare-function group)) - (run-hooks 'gnus-post-prepare-hook) - (gnus-inews-set-point) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (setq gnus-post-news-buffer (current-buffer)) - (gnus-inews-modify-mail-mode-map) - (local-set-key "\C-c\C-c" 'gnus-inews-news))) - - (defun gnus-news-followup (&optional yank group) - (save-excursion - (set-buffer gnus-summary-buffer) - (if (not (or (not gnus-novice-user) - gnus-expert-user - (gnus-y-or-n-p - "Are you sure you want to post to all of USENET? "))) - () - (let ((group (or group gnus-newsgroup-name)) - (cur (cons (current-buffer) (cdr gnus-article-current))) - (winconf (current-window-configuration)) - from subject date message-of - references message-id follow-to sendto elt - followup-to distribution newsgroups gnus-warning) - (set-buffer (get-buffer-create gnus-default-post-news-buffer)) - (news-reply-mode) - (setq gnus-post-news-buffer (current-buffer)) - ;; Associate this buffer with the draft group. - (gnus-enter-buffer-into-draft) - (if (and (buffer-modified-p) - (> (buffer-size) 0) - (not (gnus-y-or-n-p - "Unsent message being composed; erase it? "))) - () - (erase-buffer) - (save-excursion - (gnus-copy-article-buffer) - (save-restriction - (set-buffer gnus-article-copy) - (nnheader-narrow-to-headers) - (if (gnus-functionp gnus-followup-to-function) - (save-excursion - (setq follow-to - (funcall gnus-followup-to-function group)))) - (setq from (mail-fetch-field "from")) - (setq date (or (mail-fetch-field "date") - (mail-header-date gnus-current-headers))) - (setq message-of (gnus-message-of from date)) - (setq subject (or (mail-fetch-field "subject") "none")) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - (setq references (mail-fetch-field "references")) - (setq message-id (mail-fetch-field "message-id")) - (when (and (setq gnus-warning (mail-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - (setq followup-to (mail-fetch-field "followup-to")) - (setq newsgroups (mail-fetch-field "newsgroups")) - (setq distribution (mail-fetch-field "distribution")) - ;; Remove bogus distribution. - (and (stringp distribution) - (string-match "world" distribution) - (setq distribution nil)) - (widen))) - - (setq news-reply-yank-from (or from "(nobody)")) - (setq news-reply-yank-message-id - (or message-id "(unknown Message-ID)")) - - ;; Gather the "to" addresses out of the follow-to list and remove - ;; them as we go. - (if (and follow-to (listp follow-to)) - (while (setq elt (assoc "Newsgroups" follow-to)) - (setq sendto (concat sendto (and sendto ", ") (cdr elt))) - (setq follow-to (delq elt follow-to)))) - - ;; Let posting styles be configured. - (gnus-configure-posting-styles) - - (news-setup - nil subject nil - (or sendto - (if (equal followup-to "poster") - (or newsgroups group "") - (and followup-to - gnus-use-followup-to - (or (not (eq gnus-use-followup-to 'ask)) - (equal followup-to newsgroups) - (gnus-y-or-n-p - (format "Use Followup-To %s? " followup-to))) - followup-to)) - newsgroups group "") - gnus-article-copy) - - (make-local-variable 'gnus-article-reply) - (setq gnus-article-reply cur) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (make-local-variable 'gnus-reply-subject) - (setq gnus-reply-subject (mail-header-subject gnus-current-headers)) - (make-local-variable 'gnus-in-reply-to) - (setq gnus-in-reply-to message-of) - (when (and followup-to newsgroups) - (make-local-variable 'gnus-newsgroup-followup) - (setq gnus-newsgroup-followup - (cons newsgroups followup-to))) - - (gnus-inews-insert-signature) - - (and gnus-post-prepare-function - (gnus-functionp gnus-post-prepare-function) - (funcall gnus-post-prepare-function group)) - (run-hooks 'gnus-post-prepare-hook) - - (auto-save-mode auto-save-default) - (gnus-inews-modify-mail-mode-map) - (local-set-key "\C-c\C-c" 'gnus-inews-news) - - (if (and follow-to (listp follow-to)) - (progn - (goto-char (point-min)) - (and (re-search-forward "^Newsgroups:" nil t) - (forward-line 1)) - (while follow-to - (insert (caar follow-to) ": " (cdar follow-to) "\n") - (setq follow-to (cdr follow-to))))) - - ;; If a distribution existed, we use it. - (if distribution - (progn - (mail-position-on-field "Distribution") - (insert distribution))) - - (nnheader-insert-references references message-id) - - ;; Handle `gnus-auto-mail-to-author'. - ;; Suggested by Daniel Quinlan . - ;; Revised to respect Reply-To by Ulrik Dickow . - (let ((to (if (if (eq gnus-auto-mail-to-author 'ask) - (y-or-n-p "Also send mail to author? ") - gnus-auto-mail-to-author) - (or (save-excursion - (set-buffer gnus-article-copy) - (unless (gnus-group-get-parameter - group 'broken-reply-to) - (gnus-fetch-field "reply-to"))) - from))) - (x-mail (save-excursion - (set-buffer gnus-article-copy) - (gnus-fetch-field "x-mail-copy-to")))) - ;; Deny sending copy if there's a negative X-Mail-Copy-To - ;; header. - (if x-mail - (if (and (string= x-mail "never") - (not (eq gnus-auto-mail-to-author 'force))) - (setq to nil) - (setq to x-mail))) - ;; Insert a To or Cc header. - (if to - (if (mail-fetch-field "To") - (progn - (beginning-of-line) - (insert "Cc: " to "\n")) - (mail-position-on-field "To") - (insert to)))) - - (gnus-inews-insert-bfcc) - (gnus-inews-insert-gcc) - (gnus-inews-insert-archive-gcc group) - - ;; Now the headers should be ok, so we do the yanking. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (if (not yank) - (progn - (gnus-configure-windows 'followup 'force) - (insert "\n\n") - (forward-line -2)) - (let ((last (point)) - end) - (if (not (listp yank)) - (progn - (save-excursion - (mail-yank-original nil)) - (or mail-yank-hooks mail-citation-hook - (run-hooks 'news-reply-header-hook))) - (while yank - (save-window-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-select-article nil nil nil (car yank)) - (gnus-summary-remove-process-mark (car yank))) - (save-excursion - (gnus-copy-article-buffer) - (mail-yank-original nil) - (setq end (set-marker (make-marker) (point)))) - (or mail-yank-hooks mail-citation-hook - (run-hooks 'news-reply-header-hook)) - (goto-char end) - (set-marker end nil) - (setq yank (cdr yank)))) - (goto-char last)) - (gnus-configure-windows 'followup-yank 'force)) - - (make-local-variable 'gnus-article-check-size) - (setq gnus-article-check-size - (cons (buffer-size) (gnus-article-checksum))) - (gnus-inews-set-point)))))) - - (defun gnus-message-of (from date) - "Take a FROM and a DATE and return an IN-REPLY-TO." - (when from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of " - (if (or (not date) (string= date "")) - "(unknown date)" date))))) - (defun gnus-mail-yank-original () (interactive) (save-excursion --- 596,601 ---- *************** *** 2381,2419 **** (or mail-yank-hooks mail-citation-hook (run-hooks 'news-reply-header-hook))) ! (defun gnus-mail-send-and-exit (&optional dont-send) ! "Send the current mail and return to Gnus." ! (interactive) ! (let* ((reply gnus-article-reply) ! (winconf gnus-prev-winconf) ! (address-group gnus-add-to-address) ! (to-address (and address-group ! (mail-fetch-field "to")))) ! (setq gnus-add-to-address nil) ! (let ((buffer-file-name nil)) ! (or dont-send (gnus-mail-send))) ! (bury-buffer) ! (when (gnus-alive-p) ;; This mail group doesn't have a `to-list', so we add one ;; here. Magic! ! (when to-address ! (gnus-group-add-parameter address-group (cons 'to-list to-address))) ! (when (and (gnus-buffer-exists-p (car reply)) ! (cdr reply)) ! (save-excursion ! (set-buffer (car reply)) ! (gnus-summary-mark-article-as-replied (cdr reply)))) ! (and winconf (set-window-configuration winconf))))) ! ! (defun gnus-kill-message-buffer () ! "Kill the current buffer after dissociating it from the draft group." ! (interactive) ! (when (gnus-y-or-n-p "Dissociate and kill the current buffer? ") ! (gnus-dissociate-buffer-from-draft) ! (let ((winconf gnus-prev-winconf)) ! (kill-buffer (current-buffer)) ! (when winconf ! (set-window-configuration winconf))))) (defun gnus-put-message () "Put the current message in some group and return to Gnus." --- 603,615 ---- (or mail-yank-hooks mail-citation-hook (run-hooks 'news-reply-header-hook))) ! (defun gnus-inews-add-to-address (group) ! (let ((to-address (mail-fetch-field "to"))) ! (when (and to-address ! (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one ;; here. Magic! ! (gnus-group-add-parameter group (cons 'to-list to-address))))) (defun gnus-put-message () "Put the current message in some group and return to Gnus." *************** *** 2433,2441 **** (widen) (gnus-inews-narrow-to-headers) (let (gnus-deletable-headers) ! (if (eq major-mode 'mail-mode) ! (gnus-inews-insert-headers gnus-required-mail-headers) ! (gnus-inews-insert-headers))) (goto-char (point-max)) (insert "Gcc: " group "\n") (widen))) --- 629,637 ---- (widen) (gnus-inews-narrow-to-headers) (let (gnus-deletable-headers) ! (if (message-news-p) ! (message-generate-headers message-required-news-headers) ! (message-generate-headers message-required-mail-headers))) (goto-char (point-max)) (insert "Gcc: " group "\n") (widen))) *************** *** 2452,2549 **** (cdr reply))))) (and winconf (set-window-configuration winconf)))))) - (defun gnus-forward-make-subject (buffer) - (save-excursion - (set-buffer buffer) - (concat "[" (if (memq 'mail (assoc (symbol-name - (car (gnus-find-method-for-group - gnus-newsgroup-name))) - gnus-valid-select-methods)) - (gnus-fetch-field "From") - gnus-newsgroup-name) - "] " (or (gnus-fetch-field "Subject") "")))) - - (defun gnus-forward-insert-buffer (buffer) - (save-excursion - (save-restriction - ;; Put point where we want it before inserting the forwarded - ;; message. - (if gnus-signature-before-forwarded-message - (goto-char (point-max)) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1)) - ;; Narrow to the area we are to insert. - (narrow-to-region (point) (point)) - ;; Insert the separators and the forwarded buffer. - (insert gnus-forward-start-separator) - (insert-buffer-substring buffer) - (goto-char (point-max)) - (insert gnus-forward-end-separator) - (gnus-set-text-properties (point-min) (point-max) nil) - ;; Remove all unwanted headers. - (goto-char (point-min)) - (forward-line 1) - (save-restriction - (narrow-to-region (point) (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (goto-char (point-min)) - (let ((case-fold-search t) - delete) - (while (re-search-forward "^[^ \t]*:" nil t) - (beginning-of-line) - (when delete (delete-region delete (point))) - (if (looking-at gnus-forward-included-headers) - (setq delete nil) - (setq delete (point))) - (forward-line 1))))))) - - (defun gnus-mail-forward (&optional buffer) - "Forward the current message to another user using mail." - (let* ((forward-buffer (or buffer (current-buffer))) - (winconf (current-window-configuration)) - (subject (gnus-forward-make-subject forward-buffer))) - (set-buffer (get-buffer-create gnus-default-mail-buffer)) - (if (and (buffer-modified-p) - (> (buffer-size) 0) - (not (gnus-y-or-n-p - "Unsent message being composed; erase it? "))) - () - (erase-buffer) - (gnus-mail-setup 'forward nil subject) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (gnus-forward-insert-buffer forward-buffer) - (goto-char (point-min)) - (re-search-forward "^To: ?" nil t) - (gnus-configure-windows 'mail-forward 'force) - ;; You have a chance to arrange the message. - (run-hooks 'gnus-mail-forward-hook) - (run-hooks 'gnus-mail-hook)))) - - (defun gnus-forward-using-post (&optional buffer) - (save-excursion - (let* ((forward-buffer (or buffer (current-buffer))) - (subject (gnus-forward-make-subject forward-buffer)) - (gnus-newsgroup-name nil)) - (gnus-post-news 'post nil nil nil nil subject) - (save-excursion - (gnus-forward-insert-buffer forward-buffer) - ;; You have a chance to arrange the message. - (run-hooks 'gnus-mail-forward-hook))))) - - (defun gnus-mail-other-window-using-mail () - "Compose mail other window using mail." - (let ((winconf (current-window-configuration))) - (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) - (gnus-inews-modify-mail-mode-map) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (run-hooks 'gnus-mail-hook) - (gnus-configure-windows 'summary-mail 'force))) - (defun gnus-article-mail (yank) "Send a reply to the address near point. If YANK is non-nil, include the original article." --- 648,653 ---- *************** *** 2573,2579 **** (auto-save-mode auto-save-default) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) - (gnus-inews-modify-mail-mode-map) (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) --- 677,682 ---- *************** *** 2592,2598 **** (let ((cur (current-buffer))) (and (get-buffer "*Gnus Help Bug*") (kill-buffer "*Gnus Help Bug*")) ! (gnus-mail-send-and-exit) (when (buffer-name cur) (kill-buffer cur)))) --- 695,701 ---- (let ((cur (current-buffer))) (and (get-buffer "*Gnus Help Bug*") (kill-buffer "*Gnus Help Bug*")) ! (message-send-and-exit) (when (buffer-name cur) (kill-buffer cur)))) *************** *** 2663,2671 **** ;;; Treatment of rejected articles. ;;; Bounced mail. ! (defvar mail-unsent-separator) ! ! (defun gnus-summary-resend-bounced-mail (fetch) "Re-mail the current message. This only makes sense if the current message is a bounce message than contains some mail you have written which has been bounced back to --- 766,772 ---- ;;; Treatment of rejected articles. ;;; Bounced mail. ! (defun gnus-summary-resend-bounced-mail (&optional fetch) "Re-mail the current message. This only makes sense if the current message is a bounce message than contains some mail you have written which has been bounced back to *************** *** 2673,2810 **** If FETCH, try to fetch the article that this is a reply to, if indeed this is a reply." (interactive "P") - (require 'rmail) (gnus-summary-select-article t) ! ;; Create a mail buffer. ! (gnus-new-empty-mail) ! (erase-buffer) ! (insert-buffer-substring gnus-original-article-buffer) ! (goto-char (point-min)) ! (or (and (re-search-forward mail-unsent-separator nil t) ! (forward-line 1)) ! (and (search-forward "\n\n" nil t) ! (re-search-forward "^Return-Path:.*\n" nil t))) ! ;; We remove everything before the bounced mail. ! (delete-region ! (point-min) ! (if (re-search-forward "[^ \t]*:" nil t) ! (match-beginning 0) ! (point))) ! (let (references) ! (save-excursion ! (save-restriction ! (nnheader-narrow-to-headers) ! (nnheader-remove-header gnus-bounced-headers-junk t) ! (setq references (mail-fetch-field "references")) ! (goto-char (point-max)) ! (insert mail-header-separator))) ! ;; If there are references, we fetch the article we answered to. ! (and fetch ! references ! (string-match "\\(<[^]+>\\)[ \t]*$" references) ! (gnus-summary-refer-article ! (substring references (match-beginning 1) (match-end 1))) ! (progn ! (gnus-summary-show-all-headers) ! (gnus-configure-windows 'compose-bounce)))) ! (goto-char (point-min))) - ;;; Sending mail. - - (defun gnus-mail-send (&optional no-generated-headers) - "Send the current buffer as mail. - Headers will be generated before sending." - (interactive) - (unless no-generated-headers - (save-excursion - (save-restriction - (widen) - (gnus-inews-narrow-to-headers) - (gnus-inews-insert-headers gnus-required-mail-headers) - (gnus-inews-remove-empty-headers)))) - (widen) - (when (not (gnus-inews-reject-message)) - ;; Remove the header separator. - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (replace-match "" t t)) - ;; Run final inews hooks. This hook may do FCC. - (run-hooks 'gnus-inews-article-hook) - (gnus-inews-do-gcc) - (nnheader-narrow-to-headers) - (nnheader-remove-header "^[gf]cc:" t) - (widen) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (mail-send) - (run-hooks 'gnus-message-sent-hook))) - - (defun gnus-inews-modify-mail-mode-map () - (use-local-map (copy-keymap (current-local-map))) - (gnus-local-set-keys - "\C-c\C-c" gnus-mail-send-and-exit - "\C-c\M-\C-p" gnus-put-message - "\C-c\C-q" gnus-kill-message-buffer - "\C-c\M-d" gnus-dissociate-buffer-from-draft - "\C-c\C-d" gnus-associate-buffer-with-draft)) - - (defun gnus-mail-setup (type &optional to subject in-reply-to cc - replybuffer actions) - ;; Let posting styles be configured. - (gnus-configure-posting-styles) - (funcall - (cond - ((or - (eq gnus-mail-method 'mh) - (and (or (eq type 'reply) (eq type 'followup)) - (eq gnus-mail-reply-method 'gnus-mail-reply-using-mhe)) - (and (eq type 'forward) - (eq gnus-mail-forward-method 'gnus-mail-forward-using-mhe)) - (and (eq type 'new) - (eq gnus-mail-other-window-method - 'gnus-mail-other-window-using-mhe))) - 'gnus-mh-mail-setup) - ((or - (eq gnus-mail-method 'vm) - (and (or (eq type 'reply) (eq type 'followup)) - (eq gnus-mail-reply-method 'gnus-mail-reply-using-vm)) - (and (eq type 'forward) - (eq gnus-mail-forward-method 'gnus-mail-forward-using-vm)) - (and (eq type 'new) - (eq gnus-mail-other-window-method - 'gnus-mail-other-window-using-vm))) - 'gnus-vm-mail-setup) - ((or - (eq gnus-mail-method 'sendmail) - (and (or (eq type 'reply) (eq type 'followup)) - (eq gnus-mail-reply-method 'gnus-mail-reply-using-mail)) - (and (eq type 'forward) - (eq gnus-mail-forward-method 'gnus-mail-forward-using-mail)) - (and (eq type 'new) - (eq gnus-mail-other-window-method - 'gnus-mail-other-window-using-mail))) - 'gnus-sendmail-mail-setup) - (t - (cond ((or (eq type 'reply) (eq type 'followup)) - gnus-mail-reply-method) - ((eq type 'forward) - gnus-mail-forward-method) - ((eq type 'new) - gnus-mail-other-window-method)))) - to subject in-reply-to cc replybuffer actions) - (setq gnus-mail-buffer (current-buffer)) - ;; Associate this mail buffer with the draft group. - (gnus-enter-buffer-into-draft)) - - (defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions) - (mail-mode) - (mail-setup to subject nil cc replybuffer actions) - (gnus-inews-set-point) - (gnus-inews-modify-mail-mode-map)) - ;;; Gcc handling. ;; Do Gcc handling, which copied the message over to some group. --- 774,790 ---- If FETCH, try to fetch the article that this is a reply to, if indeed this is a reply." (interactive "P") (gnus-summary-select-article t) ! (set-buffer gnus-original-article-buffer) ! (gnus-setup-message 'compose-bounce ! (let* ((references (mail-fetch-field "references")) ! (parent (and references (gnus-parent-id references)))) ! (message-bounce) ! ;; If there are references, we fetch the article we answered to. ! (and fetch parent ! (gnus-summary-refer-article parent) ! (gnus-summary-show-all-headers))))) ;;; Gcc handling. ;; Do Gcc handling, which copied the message over to some group. *************** *** 2816,2824 **** (cur (current-buffer)) groups group method) (when gcc ! (nnheader-remove-header "gcc") (widen) ! (setq groups (gnus-tokenize-header gcc " ,")) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (gnus-check-server --- 796,804 ---- (cur (current-buffer)) groups group method) (when gcc ! (message-remove-header "gcc") (widen) ! (setq groups (message-tokenize-header gcc " ,")) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (gnus-check-server *************** *** 2846,2866 **** (sit-for 2)) (kill-buffer (current-buffer))))))))) - (defun gnus-inews-insert-bfcc () - "Insert Bcc and Fcc headers." - (save-excursion - ;; Handle author copy using BCC field. - (when (and gnus-mail-self-blind - (not (mail-fetch-field "bcc"))) - (mail-position-on-field "Bcc") - (insert (if (stringp gnus-mail-self-blind) - gnus-mail-self-blind - (user-login-name)))) - ;; Handle author copy using FCC field. - (when gnus-author-copy - (mail-position-on-field "Fcc") - (insert gnus-author-copy)))) - (defun gnus-inews-insert-gcc () "Insert Gcc headers based on `gnus-outgoing-message-group'." (save-excursion --- 826,831 ---- *************** *** 2931,3004 **** (insert " ")) (insert "\n")))))) - ;;; Handling rejected (and postponed) news. - - (defun gnus-draft-group () - "Return the name of the draft group." - (gnus-group-prefixed-name - (file-name-nondirectory (directory-file-name gnus-draft-group-directory)) - (list 'nndraft gnus-draft-group-directory))) - - (defun gnus-make-draft-group () - "Make the draft group or die trying." - (let* ((method `(nndraft "private" - (nndraft-directory - ,gnus-draft-group-directory))) - (group (gnus-draft-group))) - (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-group-make-group (gnus-group-real-name group) method) - (error "Can't create the draft group")) - (gnus-check-server method) - group)) - - (defun gnus-associate-buffer-with-draft (&optional generate silent) - "Enter the current buffer into the draft group." - (interactive) - (when (gnus-request-accept-article (gnus-make-draft-group) t) - (unless silent - ;; This function does the proper marking of articles. - (gnus-mail-send-and-exit 'dont-send)) - (set-buffer-modified-p nil))) - - (defun gnus-enter-buffer-into-draft () - (when gnus-use-draft - (save-excursion - ;; Make sure the draft group exists. - (gnus-make-draft-group) - ;; Associate the buffer with the draft group. - (let ((article (gnus-request-associate-buffer (gnus-draft-group)))) - ;; Arrange for deletion of the draft after successful sending. - (make-local-variable 'gnus-message-sent-hook) - (setq gnus-message-sent-hook - (list - `(lambda () - (let ((gnus-verbose-backends nil)) - (gnus-request-expire-articles - (quote ,(list article)) - ,(gnus-draft-group) t))))))))) - - (defun gnus-dissociate-buffer-from-draft () - "Disable auto-saving and association to the draft group of the current buffer." - (interactive) - (run-hooks 'gnus-message-sent-hook) - (setq buffer-file-name nil) - (setq buffer-auto-save-file-name nil)) - (defun gnus-summary-send-draft () "Enter a mail/post buffer to edit and send the draft." (interactive) (gnus-set-global-variables) - (unless (equal gnus-newsgroup-name (gnus-draft-group)) - (error "This function can only be used in the draft buffer")) (let (buf) (if (not (setq buf (gnus-request-restore-buffer (gnus-summary-article-number) gnus-newsgroup-name))) (error "Couldn't restore the article") (switch-to-buffer buf) - (gnus-inews-modify-mail-mode-map) (when (eq major-mode 'news-reply-mode) (local-set-key "\C-c\C-c" 'gnus-inews-news)) - (gnus-enter-buffer-into-draft) ;; Insert the separator. (goto-char (point-min)) (search-forward "\n\n") --- 896,912 ---- *************** *** 3009,3089 **** (gnus-configure-windows 'draft t) (goto-char (point)))))) - (defun gnus-configure-posting-styles () - "Configure posting styles according to `gnus-posting-styles'." - (let ((styles gnus-posting-styles) - (gnus-newsgroup-name (or gnus-newsgroup-name "")) - style match variable attribute value value-value) - ;; Go through all styles and look for matches. - (while styles - (setq style (pop styles) - match (pop style)) - (when (cond ((stringp match) - ;; Regexp string match on the group name. - (string-match match gnus-newsgroup-name)) - ((or (symbolp match) - (gnus-functionp match)) - (cond ((gnus-functionp match) - ;; Function to be called. - (funcall match)) - ((boundp match) - ;; Variable to be checked. - (symbol-value match)))) - ((listp match) - ;; This is a form to be evaled. - (eval match))) - ;; We have a match, so we set the variables. - (while style - (setq attribute (pop style) - value (cdr attribute)) - ;; We find the variable that is to be modified. - (if (and (not (stringp (car attribute))) - (not (setq variable (cdr (assq (car attribute) - gnus-posting-style-alist))))) - (message "Couldn't find attribute %s" (car attribute)) - ;; We set the variable. - (setq value-value - (cond ((stringp value) - value) - ((or (symbolp value) - (gnus-functionp value)) - (cond ((gnus-functionp value) - (funcall value)) - ((boundp value) - (symbol-value value)))) - ((listp value) - (eval value)))) - (if variable - (progn - ;; This is an ordinary variable. - (make-local-variable variable) - (set variable value-value)) - ;; This is a header to be added to the headers when - ;; posting. - (when value-value - (make-local-variable gnus-required-headers) - (make-local-variable gnus-required-mail-headers) - (push (cons (car attribute) value-value) - gnus-required-headers) - (push (cons (car attribute) value-value) - gnus-required-mail-headers))))))))) - - (defun gnus-inews-set-point () - "Move point to where the user probably wants to find it." - (gnus-inews-narrow-to-headers) - (cond - ((re-search-forward "^[^:]+:[ \t]*$" nil t) - (search-backward ":" ) - (widen) - (forward-char 2)) - (t - (goto-char (point-max)) - (widen) - (forward-line 1) - (unless (looking-at "$") - (forward-line 2))) - (sit-for 0))) - (gnus-add-shutdown 'gnus-inews-close 'gnus) (defun gnus-inews-close () --- 917,922 ---- *** pub/sgnus/lisp/gnus-soup.el Sun Mar 24 03:42:16 1996 --- sgnus/lisp/gnus-soup.el Wed Mar 27 03:48:11 1996 *************** *** 144,151 **** (when (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) (save-restriction ! (nnheader-narrow-to-headers) ! (nnheader-remove-header gnus-soup-ignored-headers t)) (gnus-soup-store gnus-soup-directory prefix headers gnus-soup-encoding-type gnus-soup-index-type) --- 144,151 ---- (when (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) (save-restriction ! (message-narrow-to-headers) ! (message-remove-header gnus-soup-ignored-headers t)) (gnus-soup-store gnus-soup-directory prefix headers gnus-soup-encoding-type gnus-soup-index-type) *************** *** 538,549 **** (message "Sending news message to %s..." (mail-fetch-field "newsgroups")) (sit-for 1) ! (gnus-inews-article)) ((string= (gnus-soup-reply-kind (car replies)) "mail") (message "Sending mail to %s..." (mail-fetch-field "to")) (sit-for 1) ! (gnus-mail-send-and-exit)) (t (error "Unknown reply kind"))) (set-buffer msg-buf) --- 538,549 ---- (message "Sending news message to %s..." (mail-fetch-field "newsgroups")) (sit-for 1) ! (funcall message-send-news-function)) ((string= (gnus-soup-reply-kind (car replies)) "mail") (message "Sending mail to %s..." (mail-fetch-field "to")) (sit-for 1) ! (funcall message-send-mail-function)) (t (error "Unknown reply kind"))) (set-buffer msg-buf) *** pub/sgnus/lisp/gnus.el Sun Mar 24 03:42:22 1996 --- sgnus/lisp/gnus.el Wed Mar 27 04:39:02 1996 *************** *** 66,81 **** variable, or returned by the function) is a file name, the contents of this file will be used as the organization.") - (defvar gnus-use-generic-from nil - "If nil, the full host name will be the system name prepended to the domain name. - If this is a string, the full host name will be this string. - If this is non-nil, non-string, the domain name will be used as the - full host name.") - - (defvar gnus-use-generic-path nil - "If nil, use the NNTP server name in the Path header. - If stringp, use this; if non-nil, use no host name (user name only).") - ;; Customization variables ;; Don't touch this variable. --- 66,71 ---- *************** *** 869,887 **** (vertical 1.0 (browse 1.0 point) (if gnus-carpal '(browse-carpal 2)))) ! (group-mail ! (vertical 1.0 ! (mail 1.0 point))) ! (group-post ! (vertical 1.0 ! (post 1.0 point))) ! (summary-mail ! (vertical 1.0 ! (mail 1.0 point))) ! (summary-reply (vertical 1.0 ! (article-copy 0.5) ! (mail 1.0 point))) (pick (vertical 1.0 (article 1.0 point))) --- 859,867 ---- (vertical 1.0 (browse 1.0 point) (if gnus-carpal '(browse-carpal 2)))) ! (message (vertical 1.0 ! (message 1.0 point))) (pick (vertical 1.0 (article 1.0 point))) *************** *** 910,929 **** (reply (vertical 1.0 (article-copy 0.5) ! (mail 1.0 point))) ! (mail-forward (vertical 1.0 ! (mail 1.0 point))) ! (post-forward ! (vertical 1.0 ! (post 1.0 point))) (reply-yank (vertical 1.0 ! (mail 1.0 point))) (mail-bounce (vertical 1.0 (article 0.5) ! (mail 1.0 point))) (draft (vertical 1.0 (draft 1.0 point))) --- 890,906 ---- (reply (vertical 1.0 (article-copy 0.5) ! (message 1.0 point))) ! (forward (vertical 1.0 ! (message 1.0 point))) (reply-yank (vertical 1.0 ! (message 1.0 point))) (mail-bounce (vertical 1.0 (article 0.5) ! (message 1.0 point))) (draft (vertical 1.0 (draft 1.0 point))) *************** *** 935,948 **** (compose-bounce (vertical 1.0 (article 0.5) ! (mail 1.0 point))) ! (followup ! (vertical 1.0 ! (article-copy 0.5) ! (post 1.0 point))) ! (followup-yank ! (vertical 1.0 ! (post 1.0 point)))) "Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and a RULE. The NAMEs are commonsense names like `group', which names a --- 912,918 ---- (compose-bounce (vertical 1.0 (article 0.5) ! (message 1.0 point)))) "Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and a RULE. The NAMEs are commonsense names like `group', which names a *************** *** 971,978 **** (server-carpal . gnus-carpal-server-buffer) (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) ! (mail . gnus-mail-buffer) ! (post . gnus-post-news-buffer) (faq . gnus-faq-buffer) (picons . "*Picons*") (tree . gnus-tree-buffer) --- 941,947 ---- (server-carpal . gnus-carpal-server-buffer) (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) ! (message . gnus-message-buffer) (faq . gnus-faq-buffer) (picons . "*Picons*") (tree . gnus-tree-buffer) *************** *** 1719,1725 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.57" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1688,1694 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.58" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 13369,13378 **** (setq major-mode 'gnus-original-article-mode) (setq buffer-read-only t) (gnus-add-current-to-buffer-list)) - (setq gnus-original-article (cons group article)) (let (buffer-read-only) (erase-buffer) ! (insert-buffer-substring gnus-article-buffer)))) ;; Update sparse articles. (when do-update-line --- 13338,13347 ---- (setq major-mode 'gnus-original-article-mode) (setq buffer-read-only t) (gnus-add-current-to-buffer-list)) (let (buffer-read-only) (erase-buffer) ! (insert-buffer-substring gnus-article-buffer)) ! (setq gnus-original-article (cons group article)))) ;; Update sparse articles. (when do-update-line *************** *** 13704,13711 **** (when (and from reply-to (equal ! (nth 1 (mail-extract-address-components from)) ! (nth 1 (mail-extract-address-components reply-to)))) (gnus-article-hide-header "reply-to")))) ((eq elem 'date) (let ((date (mail-fetch-field "date"))) --- 13673,13681 ---- (when (and from reply-to (equal ! (nth 1 (funcall gnus-extract-address-components from)) ! (nth 1 (funcall gnus-extract-address-components ! reply-to)))) (gnus-article-hide-header "reply-to")))) ((eq elem 'date) (let ((date (mail-fetch-field "date"))) *************** *** 14038,14044 **** (nnheader-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. ! (if (zerop (nnheader-remove-header date-regexp t)) (beginning-of-line) (goto-char (point-max))) (insert --- 14008,14014 ---- (nnheader-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. ! (if (zerop (message-remove-header date-regexp t)) (beginning-of-line) (goto-char (point-max))) (insert *** pub/sgnus/lisp/mail-header.el Wed Mar 27 05:21:11 1996 --- sgnus/lisp/mail-header.el Sun Mar 24 21:28:49 1996 *************** *** 0 **** --- 1,177 ---- + ;;; mail-header.el --- Mail header parsing, merging, formatting + + ;; Copyright (C) 1996 by Free Software Foundation, Inc. + + ;; Author: Erik Naggum + ;; Keywords: tools, mail, news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to + ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; This package provides an abstraction to RFC822-style messages, used in + ;; mail news, and some other systems. The simple syntactic rules for such + ;; headers, such as quoting and line folding, are routinely reimplemented + ;; in many individual packages. This package removes the need for this + ;; redundancy by representing message headers as association lists, + ;; offering functions to extract the set of headers from a message, to + ;; parse individual headers, to merge sets of headers, and to format a set + ;; of headers. + + ;; The car of each element in the message-header alist is a symbol whose + ;; print name is the name of the header, in all lower-case. The cdr of an + ;; element depends on the operation. After extracting headers from a + ;; messge, it is a string, the value of the header. An extracted set of + ;; headers may be parsed further, which may turn it into a list, whose car + ;; is the original value and whose subsequent elements depend on the + ;; header. For formatting, it is evaluated to obtain the strings to be + ;; inserted. For merging, one set of headers consists of strings, while + ;; the other set will be evaluated with the symbols in the first set of + ;; headers bound to their respective values. + + ;;; Code: + + (defun mail-header-extract () + "Extract headers from current buffer after point. + Returns a header alist, where each element is a cons cell (name . value), + where NAME is a symbol, and VALUE is the string value of the header having + that name." + (let ((message-headers ()) (top (point)) + start end) + (while (and (setq start (point)) + (> (skip-chars-forward "^\0- :") 0) + (= (following-char) ?:) + (setq end (point)) + (progn (forward-char) + (> (skip-chars-forward " \t") 0))) + (let ((header (intern (downcase (buffer-substring start end)))) + (value (list (buffer-substring + (point) (progn (end-of-line) (point)))))) + (while (progn (forward-char) (> (skip-chars-forward " \t") 0)) + (push (buffer-substring (point) (progn (end-of-line) (point))) + value)) + (push (if (cdr value) + (cons header (mapconcat #'identity (nreverse value) " ")) + (cons header (car value))) + message-headers))) + (goto-char top) + (nreverse message-headers))) + + (defun mail-header-extract-no-properties () + "Extract headers from current buffer after point, without properties. + Returns a header alist, where each element is a cons cell (name . value), + where NAME is a symbol, and VALUE is the string value of the header having + that name." + (mapcar + (lambda (elt) + (set-text-properties 0 (length (cdr elt)) nil (cdr elt)) + elt) + (mail-header-extract))) + + (defun mail-header-parse (parsing-rules headers) + "Apply PARSING-RULES to HEADERS. + PARSING-RULES is an alist whose keys are header names (symbols) and whose + value is a parsing function. The function takes one argument, a string, + and return a list of values, which will destructively replace the value + associated with the key in HEADERS, after being prepended with the original + value." + (dolist (rule parsing-rules) + (let ((header (assq (car rule) headers))) + (when header + (if (consp (cdr header)) + (setf (cddr header) (funcall (cdr rule) (cadr header))) + (setf (cdr header) + (cons (cdr header) (funcall (cdr rule) (cdr header)))))))) + headers) + + (defsubst mail-header (header &optional header-alist) + "Return the value associated with header HEADER in HEADER-ALIST. + If the value is a string, it is the original value of the header. If the + value is a list, its first element is the original value of the header, + with any subsequent elements bing the result of parsing the value. + If HEADER-ALIST is nil, the dynamically bound variable `headers' is used." + (cdr (assq header (or header-alist headers)))) + + (defun mail-header-set (header value &optional header-alist) + "Set the value associated with header HEADER to VALUE in HEADER-ALIST. + HEADER-ALIST defaults to the dynamically bound variable `headers' if nil. + See `mail-header' for the semantics of VALUE." + (let* ((alist (or header-alist headers)) + (entry (assq header alist))) + (if entry + (setf (cdr entry) value) + (nconc alist (list (cons header value))))) + value) + + (defsetf mail-header (header &optional header-alist) (value) + `(mail-header-set ,header ,value ,header-alist)) + + (defun mail-header-merge (merge-rules headers) + "Return a new header alist with MERGE-RULES applied to HEADERS. + MERGE-RULES is an alist whose keys are header names (symbols) and whose + values are forms to evaluate, the results of which are the new headers. It + should be a string or a list of string. The first element may be nil to + denote that the formatting functions must use the remaining elements, or + skip the header altogether if there are no other elements. + The macro `mail-header' can be used to access headers in HEADERS." + (mapcar + (lambda (rule) + (cons (car rule) (eval (cdr rule)))) + merge-rules)) + + (defvar mail-header-format-function + (lambda (header value) + "Function to format headers without a specified formatting function." + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value) + "\n"))) + + (defun mail-header-format (format-rules headers) + "Use FORMAT-RULES to format HEADERS and insert into current buffer. + FORMAT-RULES is an alist whose keys are header names (symbols), and whose + values are functions that format the header, the results of which are + inserted, unless it is nil. The function takes two arguments, the header + symbol, and the value of that header. If the function itself is nil, the + default action is to insert the value of the header, unless it is nil. + The headers are inserted in the order of the FORMAT-RULES. + A key of t represents any otherwise unmentioned headers. + A key of nil has as its value a list of defaulted headers to ignore." + (let ((ignore (append (cdr (assq nil format-rules)) + (mapcar #'car format-rules)))) + (dolist (rule format-rules) + (let* ((header (car rule)) + (value (mail-header header))) + (cond ((null header) 'ignore) + ((eq header t) + (dolist (defaulted headers) + (unless (memq (car defaulted) ignore) + (let* ((header (car defaulted)) + (value (cdr defaulted))) + (if (cdr rule) + (funcall (cdr rule) header value) + (funcall mail-header-format-function header value)))))) + (value + (if (cdr rule) + (funcall (cdr rule) header value) + (funcall mail-header-format-function header value)))))) + (insert "\n"))) + + (provide 'mail-header) + + ;;; mail-header.el ends here *** pub/sgnus/lisp/message.el Wed Mar 27 05:21:11 1996 --- sgnus/lisp/message.el Wed Mar 27 04:48:40 1996 *************** *** 0 **** --- 1,2123 ---- + ;;; message.el --- composing mail and news messages + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: mail, news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; This mode provides mail-sending facilities from within Emacs. It + ;; consists mainly of large chunks of code from the sendmail.el, + ;; gnus-msg.el and rnewspost.el files. + + ;;; Code: + + (eval-when-compile + (require 'cl)) + (require 'mail-header) + + (defvar message-fcc-handler-function 'rmail-output + "*A function called to save outgoing articles. + This function will be called with the same of the file to store the + article in. The default function is `rmail-output' which saves in Unix + mailbox format.") + + (defvar message-courtesy-message + "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" + "*This is inserted at the start of a mailed copy of a posted message. + If this variable is nil, no such courtesy message will be added.") + + (defvar message-ignored-bounced-headers "^\\(Received\\):" + "*Regexp that matches headers to be removed in resent bounced mail.") + + (defvar message-from-style 'angles + "*Specifies how \"From\" headers look. + + If `nil', they contain just the return address like: + king@grassland.com + If `parens', they look like: + king@grassland.com (Elvis Parsley) + If `angles', they look like: + Elvis Parsley ") + + (defvar message-syntax-checks + '(subject-cmsg multiple-headers sendsys message-id from + long-lines control-chars size new-text + redirected-followup signature approved sender + empty empty-headers) + "In non-nil, message will attempt to run some checks on outgoing posts. + If this variable is t, message will check everything it can. If it is + a list, then those elements in that list will be checked.") + + (defvar message-required-news-headers + '(From Date Newsgroups Subject Message-ID Organization Lines + (optional . X-Newsreader)) + "*Headers to be generated or prompted for when posting an article. + RFC977 and RFC1036 require From, Date, Newsgroups, Subject, + Message-ID. Organization, Lines, In-Reply-To, Expires, and + X-Newsreader are optional. If don't you want message to insert some + header, remove it from this list.") + + (defvar message-required-mail-headers + '(From Date To Subject (optional . In-Reply-To) Message-ID Lines + (optional . X-Mailer)) + "*Headers to be generated or prompted for when mailing a message. + RFC822 required that From, Date, To, Subject and Message-ID be + included. Organization, Lines and X-Mailer are optional.") + + (defvar message-deletable-headers '(Message-ID Date) + "*Headers to be deleted if they already exists and were generated by message previously.") + + (defvar message-ignored-news-headers + "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:" + "*Regexp of headers to be removed unconditionally before posting.") + + (defvar message-ignored-supersedes-headers + "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:" + "*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.") + + (defvar message-signature-separator "^-- *$" + "Regexp matching signature separator.") + + (defvar message-interactive nil + "Non-nil means when sending a message wait for and display errors. + nil means let mailer mail back a message to report errors.") + + (defvar gnus-local-organization) + (defvar message-user-organization + (if (boundp 'gnus-local-organization) + gnus-local-organization t) + "*String to be used as an Organization header. + If t, use `message-user-organization-file'.") + + (defvar message-user-organization-file "/usr/lib/news/organization" + "*Local news organization file.") + + (defvar message-autosave-directory "~/Mail/drafts/" + "*Directory where message autosaves buffers. + If nil, message won't autosave.") + + (defvar message-forward-start-separator + "------- Start of forwarded message -------\n" + "*Delimiter inserted before forwarded messages.") + + (defvar message-forward-end-separator + "------- End of forwarded message -------\n" + "*Delimiter inserted after forwarded messages.") + + (defvar message-signature-before-forwarded-message t + "*If non-nil, put the signature before any included forwarded message.") + + (defvar message-included-forward-headers + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:" + "*Regexp matching headers to be included in forwarded messages.") + + (defvar message-ignored-resent-headers "^Return-receipt" + "*All headers that match this regexp will be deleted when resending a message.") + + ;;;###autoload + (defvar message-ignored-cited-headers ":" + "Delete these headers from the messages you yank.") + + ;; Useful to set in site-init.el + ;;;###autoload + (defvar message-send-mail-function 'message-send-mail + "Function to call to send the current buffer as mail. + The headers should be delimited by a line whose contents match the + variable `message-header-separator'.") + + (defvar message-send-news-function 'message-send-news + "Function to call to send the current buffer as news. + The headers should be delimited by a line whose contents match the + variable `message-header-separator'.") + + (defvar message-reply-to-function nil + "Function that should return a list of headers.") + + (defvar message-wide-reply-to-function nil + "Function that should return a list of headers.") + + (defvar message-followup-to-function nil + "Function that should return a list of headers.") + + (defvar message-use-followup-to 'ask + "*Specifies what to do with Followup-To header. + If nil, ignore the header. If it is t, use its value, but ignore + \"poster\". If it is the symbol `ask', query the user whether to + ignore the \"poster\" value. If it is the symbol `use', always use + the value.") + + (defvar message-post-method + (cond ((boundp 'gnus-post-method) + gnus-post-method) + ((boundp 'gnus-select-method) + gnus-select-method) + (t '(nnspool ""))) + "Method used to post news.") + + (defvar message-generate-headers-first nil + "*If non-nil, generate all possible headers before composing.") + + ;;;###autoload + (defvar message-header-separator "--text follows this line--" + "*Line used to separate headers from text in messages being composed.") + + ;;;###autoload + (defvar message-alias-file nil + "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'. + This file defines aliases to be expanded by the mailer; this is a different + feature from that of defining aliases in `.mailrc' to be expanded in Emacs. + This variable has no effect unless your system uses sendmail as its mailer.") + + ;;;###autoload + (defvar message-personal-alias-file "~/.mailrc" + "*If non-nil, the name of the user's personal mail alias file. + This file typically should be in same format as the `.mailrc' file used by + the `Mail' or `mailx' program. + This file need not actually exist.") + + (defvar message-setup-hook nil + "Normal hook, run each time a new outgoing message is initialized. + The function `message-setup' runs this hook.") + + (defvar message-header-setup-hook nil + "Hook called narrowed to the headers when setting up a message buffer.") + + (defvar message-citation-line-function 'message-insert-citation-line + "*Function called to insert the \"Whomever writes:\" line.") + + (defvar message-aliases t + "Alist of mail address aliases. + If t, initialized from your mail aliases file. + \(The file's name is normally `~/.mailrc', but your MAILRC environment + variable can override that name.) + The alias definitions in the file have this form: + alias ALIAS MEANING") + + (defvar message-alias-modtime nil + "The modification time of your mail alias file when it was last examined.") + + (defvar message-yank-prefix "> " + "*Prefix inserted on the lines of yanked messages. + nil means use indentation.") + + (defvar message-indentation-spaces 3 + "*Number of spaces to insert at the beginning of each cited line. + Used by `message-yank-original' via `message-yank-cite'.") + + (defvar message-indent-citation-function 'message-indent-citation + "*Function for modifying a citation just inserted in the mail buffer. + This can also be a list of functions. Each function can find the + citation between (point) and (mark t). And each function should leave + point and mark around the citation text as modified.") + + (defvar message-abbrevs-loaded nil) + + (autoload 'build-mail-aliases "mailalias" + "Read mail aliases from user's personal aliases file and set `mail-aliases'." + nil) + + (autoload 'expand-mail-aliases "mailalias" + "Expand all mail aliases in suitable header fields found between BEG and END. + Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants. + Optional second arg EXCLUDE may be a regular expression defining text to be + removed from alias expansions." + nil) + + (defvar message-signature t + "*String to be inserted at the and the the message buffer. + If t, the `message-signature-file' file will be inserted instead. + If a function, the result from the function will be used instead. + If a form, the result from the form will be used instead.") + + (defvar message-signature-file "~/.signature" + "*File containing the text inserted at end of mail buffer.") + + (defvar message-distribution-function nil + "*Function called to return a Distribution header.") + + (defvar message-expires 14 + "*Number of days before your article expires.") + + (defvar message-user-path nil + "If nil, use the NNTP server name in the Path header. + If stringp, use this; if non-nil, use no host name (user name only).") + + (defvar message-generic-domain nil + "If nil, the full host name will be the system name prepended to the domain name. + If this is a string, the full host name will be this string. + If this is non-nil, non-string, the domain name will be used as the + full host name.") + + (defvar message-reply-buffer nil) + (defvar message-reply-headers nil) + (defvar message-newsreader nil) + (defvar message-mailer nil) + (defvar message-sent-message-via nil) + (defvar message-send-actions nil + "A list of actions to be performed upon successful sending of a message.") + + (defvar message-default-headers nil + "*A string containing header lines to be inserted in outgoing messages. + It is inserted before you edit the message, so you can edit or delete + these lines.") + + (defvar message-default-mail-headers nil + "*A string of header lines to be inserted in outgoing mails.") + + (defvar message-default-news-headers nil + "*A string of header lines to be inserted in outgoing news articles.") + + ;; Note: could use /usr/ucb/mail instead of sendmail; + ;; options -t, and -v if not interactive. + (defvar message-mailer-swallows-blank-line + (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" + system-configuration) + (file-readable-p "/etc/sendmail.cf") + (let ((buffer (get-buffer-create " *temp*"))) + (unwind-protect + (save-excursion + (set-buffer buffer) + (insert-file-contents "/etc/sendmail.cf") + (goto-char (point-min)) + (let ((case-fold-search nil)) + (re-search-forward "^OR\\>" nil t))) + (kill-buffer buffer)))) + ;; According to RFC822, "The field-name must be composed of printable + ;; ASCII characters (i.e. characters that have decimal values between + ;; 33 and 126, except colon)", i.e. any chars except ctl chars, + ;; space, or colon. + '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) + "Set this non-nil if the system's mailer runs the header and body together. + \(This problem exists on Sunos 4 when sendmail is run in remote mode.) + The value should be an expression to test whether the problem will + actually occur.") + + (defvar message-mode-syntax-table + (let ((table (copy-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?% ". " table) + table) + "Syntax table used while in message mode.") + + (defvar message-font-lock-keywords + (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) + (list '("^To:" . font-lock-function-name-face) + '("^B?CC:\\|^Reply-To:" . font-lock-keyword-face) + '("^\\(Subject:\\)[ \t]*\\(.+\\)?" + (1 font-lock-comment-face) (2 font-lock-type-face nil t)) + (list (concat "^\\(" (regexp-quote message-header-separator) "\\)$") + 1 'font-lock-comment-face) + (cons (concat "^[ \t]*" + "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" + "[>|}].*") + 'font-lock-reference-face) + '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*" + . font-lock-string-face))) + "Additional expressions to highlight in Mail mode.") + + (defvar message-send-hook nil + "Hook run before sending messages.") + + (defvar message-sent-hook nil + "Hook run after sending messages.") + + (defvar message-header-format-alist + `((Newsgroups) + (To . message-fill-header) + (Cc . message-fill-header) + (Subject) + (In-Reply-To) + (Fcc) + (Bcc) + (Date) + (Organization) + (Distribution) + (Lines) + (Expires) + (Message-ID) + (References . message-fill-header) + (X-Mailer) + (X-Newsreader)) + "Alist used for formatting headers.") + + + + ;;; + ;;; Utility functions. + ;;; + + (defun message-point-at-bol () + "Return point at the beginning of the line." + (let ((p (point))) + (beginning-of-line) + (prog1 + (point) + (goto-char p)))) + + (defun message-point-at-eol () + "Return point at the end of the line." + (let ((p (point))) + (end-of-line) + (prog1 + (point) + (goto-char p)))) + + ;; Delete the current line (and the next N lines.); + (defmacro message-delete-line (&optional n) + `(delete-region (progn (beginning-of-line) (point)) + (progn (forward-line ,(or n 1)) (point)))) + + (defun message-tokenize-header (header &optional separator) + "Split HEADER into a list of header elements. + \",\" is used as the separator." + (let* ((beg 0) + (separator (or separator ",")) + (regexp + (format "[ \t]*\\([^%s]+\\)?\\([%s]+\\|\\'\\)" separator separator)) + elems) + (while (and (string-match regexp header beg) + (< beg (length header))) + (when (match-beginning 1) + (push (match-string 1 header) elems)) + (setq beg (match-end 0))) + (nreverse elems))) + + (defun message-fetch-reply-field (header) + "Fetch FIELD from the message we're replying to." + (when (and message-reply-buffer + (buffer-name message-reply-buffer)) + (save-excursion + (set-buffer message-reply-buffer) + (mail-fetch-field header)))) + + (defun message-set-work-buffer () + (if (get-buffer " *message work*") + (progn + (set-buffer " *message work*") + (erase-buffer)) + (set-buffer (get-buffer-create " *message work*")) + (kill-all-local-variables) + (buffer-disable-undo (current-buffer)))) + + (defun message-functionp (form) + "Return non-nil if FORM is funcallable." + (or (and (symbolp form) (fboundp form)) + (and (listp form) (eq (car form) 'lambda)))) + + (defun message-strip-subject-re (subject) + "Remove \"Re:\" from subject lines." + (if (string-match "^[Rr][Ee]: *" subject) + (substring subject (match-end 0)) + subject)) + + (defun message-remove-header (header &optional is-regexp first) + "Remove HEADER in the narrowed buffer. + If REGEXP, HEADER is a regular expression. + If FIRST, only remove the first instance of the header. + Return the number of headers removed." + (goto-char (point-min)) + (let ((regexp (if is-regexp header (concat "^" header ":"))) + (number 0) + (case-fold-search t) + last) + (while (and (re-search-forward regexp nil t) + (not last)) + (incf number) + (when first + (setq last t)) + (delete-region + (message-point-at-bol) + ;; There might be a continuation header, so we have to search + ;; until we find a new non-continuation line. + (if (re-search-forward "^[^ \t]" nil t) + (goto-char (match-beginning 0)) + (point-max)))) + number)) + + (defun message-narrow-to-headers () + "Narrow the buffer to the head of the message." + (widen) + (narrow-to-region + (goto-char (point-min)) + (if (re-search-forward + (concat "^" (regexp-quote message-header-separator) "\n") nil t) + (match-beginning 0) + (point-max))) + (goto-char (point-min))) + + (defun message-narrow-to-head () + "Narrow the buffer to the head of the message." + (widen) + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil 1) + (1- (point)) + (point-max))) + (goto-char (point-min))) + + (defun message-news-p () + "Say whether the current buffer contains a news message." + (mail-fetch-field "newsgroups")) + + (defun message-mail-p () + "Say whether the current buffer contains a mail message." + (or (mail-fetch-field "to") + (mail-fetch-field "cc") + (mail-fetch-field "bcc"))) + + + + ;;; + ;;; Message mode + ;;; + + ;;; Set up keymap. + + (defvar message-mode-map nil) + + (unless message-mode-map + (setq message-mode-map (nconc (make-sparse-keymap) text-mode-map)) + (define-key message-mode-map "\C-c?" 'describe-mode) + + (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) + (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) + (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-fcc) + (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) + (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) + (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) + (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) + (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) + (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-followup-to) + (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) + (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) + (define-key message-mode-map "\C-c\C-b" 'message-goto-body) + (define-key message-mode-map "\C-c\C-s" 'message-goto-signature) + + (define-key message-mode-map "\C-c\C-t" 'message-insert-to) + (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) + + (define-key message-mode-map "\C-c\C-y" 'message-yank-original) + (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) + (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) + (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) + + (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) + (define-key message-mode-map "\C-c\C-s" 'message-send)) + + (easy-menu-define + message-menu message-mode-map "" + '("Mail" + ["Fill Citation" message-fill-yanked-message t])) + + ;;;###autoload + (defun message-mode () + "Major mode for editing mail to be sent. + Like Text Mode but with these additional commands: + C-c C-s message-send (send the message) C-c C-c message-send-and-exit + C-c C-f move to a header field (and create it if there isn't): + C-c C-f C-t move to To: C-c C-f C-s move to Subject: + C-c C-f C-c move to CC: C-c C-f C-b move to BCC: + C-c C-f C-f move to FCC: + C-c C-t message-text (move to beginning of message text). + C-c C-w message-signature (insert `message-signature-file' file). + C-c C-y message-yank-original (insert current message, in Rmail). + C-c C-q message-fill-yanked-message (fill what was yanked). + C-c C-v message-sent-via (add a Sent-via field for each To or CC)." + (interactive) + (kill-all-local-variables) + (make-local-variable 'message-reply-buffer) + (setq message-reply-buffer nil) + (make-local-variable 'message-send-actions) + (set-syntax-table message-mode-syntax-table) + (use-local-map message-mode-map) + (setq local-abbrev-table text-mode-abbrev-table) + (setq major-mode 'message-mode) + (setq mode-name "Message") + (setq buffer-offer-save t) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(message-font-lock-keywords t)) + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat (regexp-quote message-header-separator) + "$\\|[ \t]*[-_][-_][-_]+$\\|" + paragraph-start)) + (setq paragraph-separate (concat (regexp-quote message-header-separator) + "$\\|[ \t]*[-_][-_][-_]+$\\|" + paragraph-separate)) + (make-local-variable 'message-reply-headers) + (make-local-variable 'message-newsreader) + (make-local-variable 'message-mailer) + (make-local-variable 'message-post-method) + (make-local-variable 'message-sent-message-via) + (run-hooks 'text-mode-hook 'message-mode-hook)) + + + + ;;; + ;;; Message mode commands + ;;; + + ;;; Movement commands + + (defun message-goto-to () + "Move point to the To header." + (interactive) + (message-position-on-field "To")) + + (defun message-goto-subject () + "Move point to the Subject header." + (interactive) + (message-position-on-field "Subject")) + + (defun message-goto-cc () + "Move point to the Cc header." + (interactive) + (message-position-on-field "Cc" "To")) + + (defun message-goto-bcc () + "Move point to the Bcc header." + (interactive) + (message-position-on-field "Bcc" "Cc" "To")) + + (defun message-goto-fcc () + "Move point to the Followup-To header." + (interactive) + (message-position-on-field "Fcc" "To" "Newsgroups")) + + (defun message-goto-reply-to () + "Move point to the Reply-To header." + (interactive) + (message-position-on-field "Reply-To" "Subject")) + + (defun message-goto-newsgroups () + "Move point to the Newsgroups header." + (interactive) + (message-position-on-field "Newsgroups")) + + (defun message-goto-distribution () + "Move point to the Distribution header." + (interactive) + (message-position-on-field "Distribution")) + + (defun message-goto-followup-to () + "Move point to the Followup-To header." + (interactive) + (message-position-on-field "Followup-To" "Newsgroups")) + + (defun message-goto-keywords () + "Move point to the Keywords header." + (interactive) + (message-position-on-field "Keywords" "Subject")) + + (defun message-goto-summary () + "Move point to the Summary header." + (interactive) + (message-position-on-field "Summary" "Subject")) + + (defun message-goto-body () + "Move point to the beginning of the message body." + (interactive) + (goto-char (point-min)) + (search-forward (concat "\n" message-header-separator "\n") nil t)) + + + + (defun message-insert-to () + "Insert a To header that points to the author of the message being replied to." + (interactive) + (message-position-on-field "To") + (insert (or (message-fetch-reply-field "reply-to") + (message-fetch-reply-field "from") ""))) + + (defun message-insert-newsgroups () + "Insert the Newsgroups header from the article being replied to." + (interactive) + (message-position-on-field "newsgroups") + (insert (or (message-fetch-reply-field "newsgroups") ""))) + + + + ;;; Various commands + + (defun message-insert-signature () + "Insert a signature." + (interactive) + (let* ((signature + (cond ((message-functionp message-signature) + (funcall message-signature)) + ((listp message-signature) + (eval message-signature)) + (t message-signature))) + (signature + (cond ((stringp signature) + signature) + ((and (eq t signature) + message-signature-file + (file-exists-p message-signature-file)) + signature)))) + (when signature + ;; Remove blank lines at the end of the message. + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (end-of-line) + (delete-region (point) (point-max)) + ;; Insert the signature. + (insert "\n\n-- \n") + (if (eq signature t) + (insert-file-contents message-signature-file) + (insert signature)) + (goto-char (point-max)) + (or (bolp) (insert "\n"))))) + + (defvar message-caesar-translation-table nil) + + (defun message-caesar-region (b e &optional n) + "Caesar rotation of region by N, default 13, for decrypting netnews." + (interactive + (list + (min (point) (or (mark t) (point))) + (max (point) (or (mark t) (point))) + (when current-prefix-arg + (prefix-numeric-value current-prefix-arg)))) + + (setq n (if (numberp n) (mod n 26) 13)) ;canonize N + (unless (or (zerop n) ; no action needed for a rot of 0 + (= b e)) ; no region to rotate + ;; We build the table, if necessary. + (when (or (not message-caesar-translation-table) + (/= (aref message-caesar-translation-table ?a) (+ ?a n))) + (let ((i -1) + (table (make-string 256 0))) + (while (< (incf i) 256) + (aset table i i)) + (setq table + (concat + (substring table 0 ?A) + (substring table (+ ?A n) (+ ?A n (- 26 n))) + (substring table ?A (+ ?A n)) + (substring table (+ ?A 26) ?a) + (substring table (+ ?a n) (+ ?a n (- 26 n))) + (substring table ?a (+ ?a n)) + (substring table (+ ?a 26) 255))) + (setq message-caesar-translation-table table))) + ;; Then we translate the region. Do it this way to retain + ;; text properties. + (while (< b e) + (subst-char-in-region + b (1+ b) (char-after b) + (aref message-caesar-translation-table (char-after b))) + (incf b)))) + + (defun message-caesar-buffer-body (&optional rotnum) + "Caesar rotates all letters in the current buffer by 13 places. + Used to encode/decode possibly offensive messages (commonly in net.jokes). + With prefix arg, specifies the number of places to rotate each letter forward. + Mail and USENET news headers are not rotated." + (interactive (if current-prefix-arg + (list (prefix-numeric-value current-prefix-arg)) + (list nil))) + (save-excursion + (save-restriction + (when (message-goto-body) + (narrow-to-region (point) (point-max))) + (message-caesar-region (point-min) (point-max) rotnum)))) + + (defun message-fill-yanked-message (&optional justifyp) + "Fill the paragraphs of a message yanked into this one. + Numeric argument means justify as well." + (interactive "P") + (save-excursion + (goto-char (point-min)) + (search-forward (concat "\n" message-header-separator "\n") nil t) + (fill-individual-paragraphs (point) + (point-max) + justifyp + t))) + + (defun message-indent-citation () + "Modify text just inserted from a message to be cited. + The inserted text should be the region. + When this function returns, the region is again around the modified text. + + Normally, indent each nonblank line `message-indentation-spaces' spaces. + However, if `message-yank-prefix' is non-nil, insert that prefix on each line." + (let ((start (point))) + ;; Remove unwanted headers. + (when message-ignored-cited-headers + (save-restriction + (narrow-to-region + (goto-char start) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point))) + (message-remove-header message-ignored-cited-headers t))) + ;; Do the indentation. + (if (null message-yank-prefix) + (indent-rigidly start (mark t) message-indentation-spaces) + (save-excursion + (goto-char start) + (while (< (point) (mark t)) + (insert message-yank-prefix) + (forward-line 1))) + (goto-char start)))) + + (defun message-yank-original (&optional arg) + "Insert the message being replied to, if any (in rmail). + Puts point before the text and mark after. + Normally indents each nonblank line ARG spaces (default 3). However, + if `message-yank-prefix' is non-nil, insert that prefix on each line. + + Just \\[universal-argument] as argument means don't indent, insert no + prefix, and don't delete any headers." + (interactive "P") + (when message-reply-buffer + (let ((start (point)) + (functions + (when message-indent-citation-function + (if (listp message-indent-citation-function) + message-indent-citation-function + (list message-indent-citation-function))))) + ;; If the original message is in another window in the same frame, + ;; delete that window to save screen space. + ;; t means don't alter other frames. + (delete-windows-on message-reply-buffer t) + (insert-buffer message-reply-buffer) + (unless (consp arg) + (goto-char start) + (let ((message-indentation-spaces + (if arg (prefix-numeric-value arg) + message-indentation-spaces))) + (while functions + (funcall (pop functions))))) + (when message-citation-line-function + (unless (bolp) + (insert "\n")) + (funcall message-citation-line-function)) + ;; This is like exchange-point-and-mark, but doesn't activate the mark. + ;; It is cleaner to avoid activation, even though the command + ;; loop would deactivate the mark because we inserted text. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer)))) + (unless (bolp) + (insert ?\n))))) + + (defun message-insert-citation-line () + "Function that inserts a simple citation line." + (when message-reply-headers + (insert (mail-header-from message-reply-headers) " writes:\n\n"))) + + (defun message-position-on-field (header &rest afters) + (let ((case-fold-search t)) + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (progn + (re-search-forward + (concat "^" (regexp-quote message-header-separator) "$")) + (match-beginning 0))) + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t) + (progn + (re-search-forward "^[^ \t]" nil 'move) + (beginning-of-line) + (skip-chars-backward "\n") + t) + (while (and afters + (not (re-search-forward + (concat "^" (regexp-quote (car afters)) ":") + nil t))) + (pop afters)) + (when afters + (re-search-forward "^[^ \t]" nil 'move) + (beginning-of-line)) + (insert header ": \n") + (forward-char -1) + nil)))) + + (defun message-remove-signature () + "Remove the signature from the text between point and mark. + The text will also be indented the normal way. + This function can be used in `message-citation-hook', for instance." + (save-excursion + (let ((start (point)) + mark) + (if (not (re-search-forward message-signature-separator (mark t) t)) + ;; No signature here, so we just indent the cited text. + (message-indent-citation) + ;; Find the last non-empty line. + (forward-line -1) + (while (looking-at "[ \t]*$") + (forward-line -1)) + (forward-line 1) + (setq mark (set-marker (make-marker) (point))) + (goto-char start) + (message-indent-citation) + ;; Enable undoing the deletion. + (undo-boundary) + (delete-region mark (mark t)) + (set-marker mark nil))))) + + + + ;;; + ;;; Sending messages + ;;; + + (defun message-send-and-exit (&optional arg) + "Send message like `message-send', then, if no errors, exit from mail buffer. + Prefix arg means don't delete this window." + (interactive "P") + (message-send) + ;(message-bury arg) + ) + + (defun message-dont-send (&optional arg) + "Don't send the message you have been editing. + Prefix arg means don't delete this window." + (interactive "P") + (message-bury arg)) + + (defun message-bury (arg) + "Bury this mail buffer." + (let ((newbuf (other-buffer (current-buffer)))) + (bury-buffer (current-buffer)) + (if (and (fboundp 'frame-parameters) + (cdr (assq 'dedicated (frame-parameters))) + (not (null (delq (selected-frame) (visible-frame-list))))) + (delete-frame (selected-frame)) + (switch-to-buffer newbuf)))) + + (defun message-send (&optional arg) + "Send the message in the current buffer. + If `message-interactive' is non-nil, wait for success indication + or error messages, and inform user. + Otherwise any failure is reported in a message back to + the user from the mailer." + (interactive "P") + (when (if buffer-file-name + (y-or-n-p (format "Send buffer contents as %s message? " + (if (message-mail-p) + (if (message-news-p) "main and news" "news") + "news"))) + (or (buffer-modified-p) + (y-or-n-p "Message already sent; resend? "))) + ;; Make it possible to undo the coming changes. + (undo-boundary) + (run-hooks 'message-send-hook) + (message "Sending...") + (when (and (or (not (message-news-p)) + (and (or (not (memq 'news message-sent-message-via)) + (y-or-n-p + "Already sent message via news; resend? ")) + (funcall message-send-news-function arg))) + (or (not (message-mail-p)) + (and (or (not (memq 'mail message-sent-message-via)) + (y-or-n-p + "Already sent message via mail; resend? ")) + (funcall message-send-mail-function arg)))) + (message-do-fcc) + (run-hooks 'message-sent-hook) + (message "Sending...done") + ;; If buffer has no file, mark it as unmodified and delete autosave. + (unless buffer-file-name + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t)) + ;; Now perform actions on successful sending. + (let ((actions message-send-actions)) + (while actions + (condition-case nil + (apply (caar actions) (cdar actions)) + (error)) + (pop actions)))))) + + (defun message-send-mail (&optional arg) + (require 'mail-utils) + (let ((errbuf (if message-interactive + (generate-new-buffer " sendmail errors") + 0)) + (tembuf (generate-new-buffer " message temp")) + (case-fold-search nil) + (news (message-news-p)) + (resend-to-addresses (mail-fetch-field "resent-to")) + delimline + (mailbuf (current-buffer))) + (save-restriction + (message-narrow-to-headers) + ;; Remove some headers. + (message-remove-header message-ignored-news-headers t) + ;; Insert some headers. + (message-generate-headers message-required-mail-headers) + ;; Let the user do all of the above. + (run-hooks 'message-header-hook)) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer-substring mailbuf) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (when (and news + (or (mail-fetch-field "cc") + (mail-fetch-field "to"))) + (message-insert-courtesy-copy)) + (let ((case-fold-search t)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote message-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + (sendmail-synch-aliases) + (when message-aliases + (expand-mail-aliases (point-min) delimline)) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (when (eval message-mailer-swallows-blank-line) + (newline)) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + (let ((default-directory "/")) + (apply 'call-process-region + (append (list (point-min) (point-max) + (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail") + nil errbuf nil "-oi") + ;; Always specify who from, + ;; since some systems have broken sendmails. + (list "-f" (user-login-name)) + (and message-alias-file + (list (concat "-oA" message-alias-file))) + ;; These mean "report errors by mail" + ;; and "deliver in background". + (if (null message-interactive) '("-oem" "-odb")) + ;; Get the addresses from the message + ;; unless this is a resend. + ;; We must not do that for a resend + ;; because we would find the original addresses. + ;; For a resend, include the specific addresses. + (or resend-to-addresses + '("-t"))))) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (goto-char (point-min)) + (while (re-search-forward "\n\n* *" nil t) + (replace-match "; ")) + (if (not (zerop (buffer-size))) + (error "Sending...failed to %s" + (buffer-substring (point-min) (point-max))))))) + (kill-buffer tembuf) + (when (bufferp errbuf) + (kill-buffer errbuf))) + (push 'mail message-sent-message-via))) + + (defun message-send-news (&optional arg) + (let ((tembuf (generate-new-buffer " *message temp*")) + (case-fold-search nil) + (method (if (message-functionp message-post-method) + (funcall message-post-method arg) + message-post-method)) + (messbuf (current-buffer))) + (save-restriction + (message-narrow-to-headers) + ;; Remove some headers. + (message-remove-header message-ignored-news-headers t) + ;; Insert some headers. + (message-generate-headers message-required-news-headers) + ;; Let the user do all of the above. + (run-hooks 'message-header-hook)) + ;; Insert the proper mail headers. + (unwind-protect + (save-excursion + (set-buffer tembuf) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring messbuf) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (let ((case-fold-search t)) + ;; Remove the delimeter. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote message-header-separator) "\n")) + (replace-match "\n") + (backward-char 1)) + (require (car method)) + (funcall (intern (format "%s-open-server" (car method))) + (cadr method) (cddr method)) + (funcall (intern (format "%s-request-post" + (car method))))) + (kill-buffer tembuf)) + (push 'news message-sent-message-via))) + + ;;; + ;;; Header generation & syntax checking. + ;;; + + (defun message-check-news-syntax () + "Check the syntax of the message." + (or + (not message-syntax-checks) + (and + ;; We narrow to the headers and check them first. + (save-excursion + (save-restriction + (message-narrow-to-headers) + (and + ;; Check for commands in Subject. + (or + (message-check-element 'subject-cmsg) + (save-excursion + (if (string-match "^cmsg " (mail-fetch-field "subject")) + (y-or-n-p + "The control code \"cmsg \" is in the subject. Really post? ") + t))) + ;; Check for multiple identical headers. + (or (message-check-element 'multiple-headers) + (save-excursion + (let (found) + (while (and (not found) + (re-search-forward "^[^ \t:]+: " nil t)) + (save-excursion + (or (re-search-forward + (concat "^" (setq found + (buffer-substring + (match-beginning 0) + (- (match-end 0) 2)))) + nil t) + (setq found nil)))) + (if found + (y-or-n-p + (format "Multiple %s headers. Really post? " found)) + t)))) + ;; Check for Version and Sendsys. + (or (message-check-element 'sendsys) + (save-excursion + (if (re-search-forward "^Sendsys:\\|^Version:" nil t) + (y-or-n-p + (format "The article contains a %s command. Really post? " + (buffer-substring (match-beginning 0) + (1- (match-end 0))))) + t))) + ;; See whether we can shorten Followup-To. + (or (message-check-element 'shorten-followup-to) + (let ((newsgroups (mail-fetch-field "newsgroups")) + (followup-to (mail-fetch-field "followup-to")) + to) + (when (and newsgroups (string-match "," newsgroups) + (not followup-to) + (not + (zerop + (length + (setq to (completing-read + "Followups to: (default all groups) " + (mapcar (lambda (g) (list g)) + (cons "poster" + (message-tokenize-header + newsgroups))))))))) + (goto-char (point-min)) + (insert "Followup-To: " to "\n")))) + + ;; Check for Approved. + (or (message-check-element 'approved) + (save-excursion + (if (re-search-forward "^Approved:" nil t) + (y-or-n-p + "The article contains an Approved header. Really post? ") + t)))))) + ;; Check for long lines. + (or (message-check-element 'long-lines) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (while (and + (progn + (end-of-line) + (< (current-column) 80)) + (zerop (forward-line 1)))) + (or (bolp) + (eobp) + (y-or-n-p + "You have lines longer than 79 characters. Really post? ")))) + ;; Check whether the article is empty. + (or (message-check-element 'empty) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1) + (or (re-search-forward "[^ \n\t]" nil t) + (y-or-n-p "Empty article. Really post?")))) + ;; Check for control characters. + (or (message-check-element 'control-chars) + (save-excursion + (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) + (y-or-n-p + "The article contains control characters. Really post? ") + t))) + ;; Check excessive size. + (or (message-check-element 'size) + (if (> (buffer-size) 60000) + (y-or-n-p + (format "The article is %d octets long. Really post? " + (buffer-size))) + t)) + ;; Check the length of the signature. + (or (message-check-element 'signature) + (progn + (goto-char (point-max)) + (if (not (re-search-backward "^-- $" nil t)) + t + (if (> (count-lines (point) (point-max)) 5) + (y-or-n-p + (format + "Your .sig is %d lines; it should be max 4. Really post? " + (count-lines (point) (point-max)))) + t))))))) + + ;; Returns non-nil if this type is not to be checked. + (defun message-check-element (type) + (not + (or (not message-syntax-checks) + (if (listp message-syntax-checks) + (memq type message-syntax-checks) + t)))) + + (defun message-do-fcc () + "Process Fcc headers in the current buffer." + (let ((case-fold-search t) + list file) + (save-excursion + (save-restriction + (nnheader-narrow-to-headers) + (while (setq file (mail-fetch-field "fcc")) + (push file list) + (message-remove-header "fcc" nil t)) + ;; Process FCC operations. + (widen) + (while list + (setq file (pop list)) + (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) + ;; Pipe the article to the program in question. + (call-process-region (point-min) (point-max) shell-file-name + nil nil nil "-c" (match-string 1 file)) + ;; Save the article. + (setq file (expand-file-name file)) + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (if (and message-fcc-handler-function + (not (eq message-fcc-handler-function 'rmail-output))) + (funcall message-fcc-handler-function file) + (if (and (file-readable-p file) (mail-file-babyl-p file)) + (rmail-output file 1) + (let ((mail-use-rfc822 t)) + (rmail-output file 1 t t)))))))))) + + (defun message-cleanup-headers () + "Do various automatic cleanups of the headers." + ;; Remove empty lines in the header. + (save-restriction + (message-narrow-to-headers) + (while (re-search-forward "^[ \t]*\n" nil t) + (replace-match "" t t))) + + ;; Correct Newsgroups and Followup-To headers: change sequence of + ;; spaces to comma and eliminate spaces around commas. Eliminate + ;; imbedded line breaks. + (goto-char (point-min)) + (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t) + (save-restriction + (narrow-to-region + (point) + (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + (forward-line 1) + (point))) + (goto-char (point-min)) + (while (re-search-forward "\n[ \t]+" nil t) + (replace-match " " t t)) ;No line breaks (too confusing) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) + (replace-match "," t t)) + (goto-char (point-min)) + ;; Remove trailing commas. + (when (re-search-forward ",+$" nil t) + (replace-match "" t t))))) + + (defun message-make-date () + "Make a valid data header." + (let ((now (current-time))) + (timezone-make-date-arpa-standard + (current-time-string now) (current-time-zone now)))) + + (defun message-make-message-id () + "Make a unique Message-ID." + (concat "<" (message-unique-id) "@" (message-make-fqdm) ">")) + + (defvar message-unique-id-char nil) + + ;; If you ever change this function, make sure the new version + ;; cannot generate IDs that the old version could. + ;; You might for example insert a "." somewhere (not next to another dot + ;; or string boundary), or modify the "fsf" string. + (defun message-unique-id () + ;; Don't use microseconds from (current-time), they may be unsupported. + ;; Instead we use this randomly inited counter. + (setq message-unique-id-char + (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20))))) + ;; (current-time) returns 16-bit ints, + ;; and 2^16*25 just fits into 4 digits i base 36. + (* 25 25))) + (let ((tm (current-time))) + (concat + (if (memq system-type '(ms-dos emx vax-vms)) + (let ((user (downcase (user-login-name)))) + (while (string-match "[^a-z0-9_]" user) + (aset user (match-beginning 0) ?_)) + user) + (message-number-base36 (user-uid) -1)) + (message-number-base36 (+ (car tm) + (lsh (% message-unique-id-char 25) 16)) 4) + (message-number-base36 (+ (nth 1 tm) + (lsh (/ message-unique-id-char 25) 16)) 4) + ;; Append the newsreader name, because while the generated + ;; ID is unique to this newsreader, other newsreaders might + ;; otherwise generate the same ID via another algorithm. + ".fsf"))) + + (defun message-number-base36 (num len) + (if (if (< len 0) (<= num 0) (= len 0)) + "" + (concat (message-number-base36 (/ num 36) (1- len)) + (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" + (% num 36)))))) + + (defun message-make-organization () + "Make an Organization header." + (let* ((organization + (or (getenv "ORGANIZATION") + (when message-user-organization + (if (message-functionp message-user-organization) + (funcall message-user-organization) + message-user-organization))))) + (save-excursion + (message-set-work-buffer) + (cond ((stringp message-user-organization) + (insert message-user-organization)) + ((and (eq t message-user-organization) + message-user-organization-file + (file-exists-p message-user-organization-file)) + (insert-file-contents message-user-organization-file))) + (goto-char (point-min)) + (when (re-search-forward "[ \t\n]*" nil t) + (replace-match "" t t)) + (unless (zerop (buffer-size)) + (buffer-string))))) + + (defun message-make-lines () + "Count the number of lines and return numeric string." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote message-header-separator) "$")) + (forward-line 1) + (int-to-string (count-lines (point) (point-max)))))) + + (defun message-make-in-reply-to () + "Return the In-Reply-To header for this message." + (when message-reply-headers + (let ((from (mail-header-from message-reply-headers)) + (date (mail-header-date message-reply-headers))) + (when from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (concat (if stop-pos (substring from 0 stop-pos) from) + "'s message of " + (if (or (not date) (string= date "")) + "(unknown date)" date))))))) + + (defun message-make-distribution () + "Make a Distribution header." + (let ((orig-distribution (message-fetch-reply-field "distribution"))) + (cond ((message-functionp message-distribution-function) + (funcall message-distribution-function)) + (t orig-distribution)))) + + (defun message-make-expires () + "Return an Expires header based on `message-expires'." + (let ((current (current-time)) + (future (* 1.0 message-expires 60 60 24))) + ;; Add the future to current. + (setcar current (+ (car current) (round (/ future (expt 2 16))))) + (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) + ;; Return the date in the future in UT. + (timezone-make-date-arpa-standard + (current-time-string current) (current-time-zone current) '(0 "UT")))) + + (defun message-make-path () + "Return uucp path." + (let ((login-name (user-login-name))) + (cond ((null message-user-path) + (concat (system-name) "!" login-name)) + ((stringp message-user-path) + ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. + (concat message-user-path "!" login-name)) + (t login-name)))) + + (defun message-make-from () + "Make a From header." + (let* ((login (message-make-address)) + (fullname (user-full-name))) + (when (string= fullname "&") + (setq fullname (user-login-name))) + (save-excursion + (message-set-work-buffer) + (cond + ((eq message-from-style 'angles) + (insert fullname) + (goto-char (point-min)) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) + ;; Quote fullname, escaping specials. + (goto-char (point-min)) + (insert "\"") + (while (re-search-forward "[\"\\]" nil 1) + (replace-match "\\\\\\&" t)) + (insert "\"")) + (insert " <" login ">")) + ((eq message-from-style 'parens) + (insert login " (") + (let ((fullname-start (point))) + (insert fullname) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" nil 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + nil 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start))) + (insert ")")) + ((null message-from-style) + (insert login "\n"))) + (buffer-string)))) + + (defun message-make-sender () + "Return the \"real\" user address. + This function tries to ignore all user modifications, and + give as trustworthy answer as possible." + (concat (user-login-name) "@" (system-name))) + + (defun message-make-address () + "Make the address of the user." + (concat (user-login-name) "@" (message-make-domain))) + + (defun message-make-fqdm () + "Return user's fully qualified domain name." + (let ((system-name (system-name))) + (if (string-match "[^.]\\.[^.]" system-name) + ;; `system-name' returned the right result. + system-name + ;; We try `user-mail-address' as a backup. + (if (string-match "@\\([^ ]+\\)\\($\\| \\)" user-mail-address) + (match-string 1 user-mail-address) + (concat system-name ".i-have-a-misconfigured-system-so-shoot-me"))))) + + (defun message-make-host-name () + "Return the name of the host." + (let ((fqdm (message-make-fqdm))) + (string-match "^[^.]+\\." fqdm) + (substring fqdm 0 (1- (match-end 0))))) + + (defun message-make-domain () + "Return the domain name." + (let ((fqdm (message-make-fqdm))) + (if message-generic-domain + (progn + (string-match "^[^.]+\\." fqdm) + (substring fqdm (match-end 0))) + fqdm))) + + (defun message-generate-headers (headers) + "Prepare article HEADERS. + Headers already prepared in the buffer are not modified." + (save-restriction + (message-narrow-to-headers) + (let* ((Date (message-make-date)) + (Message-ID (message-make-message-id)) + (Organization (message-make-organization)) + (From (message-make-from)) + (Path (message-make-path)) + (Subject nil) + (Newsgroups nil) + (In-Reply-To (message-make-in-reply-to)) + (To nil) + (Distribution (message-make-distribution)) + (Lines (message-make-lines)) + (X-Newsreader message-newsreader) + (X-Mailer message-mailer) + (Expires (message-make-expires)) + (case-fold-search t) + header value elem) + ;; First we remove any old generated headers. + (let ((headers message-deletable-headers)) + (while headers + (goto-char (point-min)) + (and (re-search-forward + (concat "^" (symbol-name (car headers)) ": *") nil t) + (get-text-property (1+ (match-beginning 0)) 'message-deletable) + (message-delete-line)) + (pop headers))) + ;; If there are References, and the subject has changed, then + ;; we have to change the Message-ID. See Son-of-1036. + (when (and message-reply-headers + (mail-fetch-field "references")) + (let ((psubject (mail-fetch-field "subject"))) + (and psubject (mail-header-subject message-reply-headers) + (string= (message-strip-subject-re + (mail-header-subject message-reply-headers)) + (message-strip-subject-re + psubject)) + (progn + (string-match "@" Message-ID) + (setq Message-ID + (concat (substring Message-ID 0 (match-beginning 0)) + "_-_" + (substring Message-ID (match-beginning 0)))))))) + ;; Go through all the required headers and see if they are in the + ;; articles already. If they are not, or are empty, they are + ;; inserted automatically - except for Subject, Newsgroups and + ;; Distribution. + (while headers + (goto-char (point-min)) + (setq elem (pop headers)) + (if (consp elem) + (setq header (car elem)) + (setq header elem)) + (when (or (not (re-search-forward + (concat "^" (downcase (symbol-name header)) ":") nil t)) + (progn + ;; The header was found. We insert a space after the + ;; colon, if there is none. + (if (/= (following-char) ? ) (insert " ") (forward-char 1)) + ;; Find out whether the header is empty... + (looking-at "[ \t]*$"))) + ;; So we find out what value we should insert. + (setq value + (cond + ((and (consp elem) (eq (car elem) 'optional)) + ;; This is an optional header. If the cdr of this + ;; is something that is nil, then we do not insert + ;; this header. + (setq header (cdr elem)) + (or (and (fboundp (cdr elem)) (funcall (cdr elem))) + (and (boundp (cdr elem)) (symbol-value (cdr elem))))) + ((consp elem) + ;; The element is a cons. Either the cdr is a + ;; string to be inserted verbatim, or it is a + ;; function, and we insert the value returned from + ;; this function. + (or (and (stringp (cdr elem)) (cdr elem)) + (and (fboundp (cdr elem)) (funcall (cdr elem))))) + ((and (boundp header) (symbol-value header)) + ;; The element is a symbol. We insert the value + ;; of this symbol, if any. + (symbol-value header)) + (t + ;; We couldn't generate a value for this header, + ;; so we just ask the user. + (read-from-minibuffer + (format "Empty header for %s; enter value: " header))))) + ;; Finally insert the header. + (when (and value + (not (equal value ""))) + (save-excursion + (if (bolp) + (progn + ;; This header didn't exist, so we insert it. + (goto-char (point-max)) + (insert (symbol-name header) ": " value "\n") + (forward-line -1)) + ;; The value of this header was empty, so we clear + ;; totally and insert the new value. + (delete-region (point) (message-point-at-eol)) + (insert value)) + ;; Add the deletable property to the headers that require it. + (and (memq header message-deletable-headers) + (progn (beginning-of-line) (looking-at "[^:]+: ")) + (add-text-properties + (point) (match-end 0) + '(message-deletable t face italic) (current-buffer))))))) + ;; Insert new Sender if the From is strange. + (let ((from (mail-fetch-field "from")) + (sender (mail-fetch-field "sender")) + (secure-sender (message-make-sender))) + (when (and from + (not (message-check-element 'sender)) + (not (string= + (downcase (cadr (mail-extract-address-components from))) + (downcase secure-sender))) + (or (null sender) + (not + (string= + (downcase + (cadr (mail-extract-address-components sender))) + (downcase secure-sender))))) + (goto-char (point-min)) + ;; Rename any old Sender headers to Original-Sender. + (when (re-search-forward "^Sender:" nil t) + (beginning-of-line) + (insert "Original-") + (beginning-of-line)) + (insert "Sender: " secure-sender "\n")))))) + + (defun message-insert-courtesy-copy () + "Insert a courtesy message in mail copies of combined messages." + (save-excursion + (save-restriction + (message-narrow-to-headers) + (let ((newsgroups (mail-fetch-field "newsgroups"))) + (goto-char (point-max)) + (insert "Posted-To: " newsgroups "\n"))) + (forward-line 1) + (insert message-courtesy-message))) + + ;;; + ;;; Setting up a message buffer + ;;; + + (defun message-fill-header (header value) + (let ((begin (point)) + (fill-column 78) + (fill-prefix "\t")) + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value) + "\n") + (fill-region-as-paragraph begin (1- (point))))) + + (defun sendmail-synch-aliases () + (let ((modtime (nth 5 (file-attributes message-personal-alias-file)))) + (or (equal message-alias-modtime modtime) + (setq message-alias-modtime modtime + message-aliases t)))) + + (defun message-position-point () + "Move point to where the user probably wants to find it." + (message-narrow-to-headers) + (cond + ((re-search-forward "^[^:]+:[ \t]*$" nil t) + (search-backward ":" ) + (widen) + (forward-char 1) + (if (= (following-char) ? ) + (forward-char 1) + (insert " "))) + (t + (goto-char (point-max)) + (widen) + (forward-line 1) + (unless (looking-at "$") + (forward-line 2))) + (sit-for 0))) + + (defun message-pop-to-buffer (name) + "Pop to buffer NAME, and warn if it already exists and is modified." + (let ((buffer (get-buffer name))) + (if (and buffer + (buffer-name buffer)) + (progn + (set-buffer (pop-to-buffer buffer)) + (when (and (buffer-modified-p) + (not (y-or-n-p + "Message already being composed; erase? "))) + (error "Message being composed"))) + (set-buffer (pop-to-buffer name))) + (erase-buffer) + (message-mode))) + + (defun message-setup (headers &optional replybuffer actions) + (sendmail-synch-aliases) + (when (eq message-aliases t) + (setq message-aliases nil) + (when (file-exists-p message-personal-alias-file) + (build-mail-aliases))) + (setq message-send-actions actions) + (setq message-reply-buffer replybuffer) + (goto-char (point-min)) + ;; Insert all the headers. + (mail-header-format + (let ((h headers) + (alist message-header-format-alist)) + (while h + (unless (assq (caar h) message-header-format-alist) + (push (list (caar h)) alist)) + (pop h)) + alist) + headers) + (when message-default-headers + (insert message-default-headers)) + (when (and (message-news-p) + message-default-news-headers) + (when message-generate-headers-first + (message-generate-headers message-required-news-headers)) + (insert message-default-news-headers)) + (when (and (message-mail-p) + message-default-mail-headers) + (when message-generate-headers-first + (message-generate-headers message-required-mail-headers)) + (insert message-default-mail-headers)) + (forward-line -1) + (insert message-header-separator "\n") + (message-insert-signature) + (message-set-auto-save-file-name) + (save-restriction + (message-narrow-to-headers) + (run-hooks 'message-header-setup-hook)) + (set-buffer-modified-p nil) + (run-hooks 'message-setup-hook) + (message-position-point)) + + (defun message-set-auto-save-file-name () + "Associate the message buffer with a file in the drafts directory." + (when message-autosave-directory + (unless (file-exists-p message-autosave-directory) + (make-directory message-autosave-directory t)) + (let ((name (make-temp-name + (concat (file-name-as-directory message-autosave-directory) + "msg.")))) + (setq buffer-auto-save-file-name + (save-excursion + (prog1 + (progn + (set-buffer (get-buffer-create " *draft tmp*")) + (setq buffer-file-name name) + (make-auto-save-file-name)) + (kill-buffer (current-buffer))))) + (clear-visited-file-modtime)))) + + + + ;;; + ;;; Commands for interfacing with message + ;;; + + ;;;###autoload + (defun message-mail (&optional to subject) + "Start editing a mail message to be sent." + (interactive) + (message-pop-to-buffer "*mail message*") + (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) + + ;;;###autoload + (defun message-news (&optional newsgroups subject) + "Start editing a news article to be sent." + (interactive) + (message-pop-to-buffer "*news message*") + (message-setup `((Newsgroups . ,(or newsgroups "")) + (Subject . ,(or subject ""))))) + + ;;;###autoload + (defun message-reply (&optional to-address wide) + "Start editing a reply to the article in the current buffer." + (interactive) + (let ((cur (current-buffer)) + from subject date reply-to message-of to cc + references message-id sender follow-to sendto elt new-cc new-to + mct never-mct gnus-warning) + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + ;; Allow customizations to have their say. + (if (not wide) + ;; This is a regular reply. + (if (message-functionp message-reply-to-function) + (setq follow-to (funcall message-reply-to-function))) + ;; This is a followup. + (if (gnus-functionp message-wide-reply-to-function) + (save-excursion + (setq follow-to + (funcall message-wide-reply-to-function))))) + ;; Find all relevant headers we need. + (setq from (mail-fetch-field "from") + date (mail-fetch-field "date") + sender (mail-fetch-field "sender") + subject (or (mail-fetch-field "subject") "none") + to (mail-fetch-field "to") + cc (mail-fetch-field "cc") + mct (mail-fetch-field "mail-copies-to") + reply-to (mail-fetch-field "reply-to") + references (mail-fetch-field "references") + message-id (mail-fetch-field "message-id")) + ;; Remove any (buggy) Re:'s that are present and make a + ;; proper one. + (when (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject) + (setq subject (substring subject (match-end 0)))) + (setq subject (concat "Re: " subject)) + + (when (and (setq gnus-warning (mail-fetch-field "gnus-warning")) + (string-match "<[^>]+>" gnus-warning)) + (setq message-id (match-string 0 gnus-warning))) + + ;; Handle special values of Mail-Copies-To. + (when mct + (cond ((equal (downcase mct) "never") + (setq never-mct t) + (setq mct nil)) + ((equal (downcase mct) "always") + (setq mct (or reply-to from))))) + + (unless follow-to + (if (or (not wide) + to-address) + (setq follow-to (list (cons 'To (or to-address reply-to from)))) + (let (ccalist) + (save-excursion + (message-set-work-buffer) + (unless never-mct + (insert (or reply-to from ""))) + (insert + (if (bolp) "" ", ") (or to "") + (if mct (concat (if (bolp) "" ", ") mct) "") + (if cc (concat (if (bolp) "" ", ") cc) "")) + ;; Remove addresses that match `rmail-dont-reply-to-names'. + (insert (prog1 (rmail-dont-reply-to (buffer-string)) + (erase-buffer))) + (goto-char (point-min)) + (setq ccalist + (mapcar + (lambda (addr) + (cons (mail-strip-quoted-names addr) addr)) + (nreverse (mail-parse-comma-list)))) + (let ((s ccalist)) + (while s + (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) + (setq follow-to (list (cons 'To (cdr (pop ccalist))))) + (when ccalist + (push (cons 'Cc + (mapconcat (lambda (addr) (cdr addr)) ccalist ", ")) + follow-to))))) + (widen)) + + (message-pop-to-buffer "*mail message*") + + (setq message-reply-headers + (vector 0 subject from date message-id references 0 0 "")) + + (message-setup + `((Subject . ,subject) + ,@follow-to + (References . ,(concat (or references "") (and references " ") + (or message-id "")))) + cur))) + + ;;;###autoload + (defun message-wide-reply (&optional to-address) + (interactive) + (message-reply to-address t)) + + ;;;###autoload + (defun message-followup () + (interactive) + (let ((cur (current-buffer)) + from subject date message-of reply-to mct + references message-id follow-to sendto elt + followup-to distribution newsgroups gnus-warning) + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (when (message-functionp message-followup-to-function) + (setq follow-to + (funcall message-followup-to-function))) + (setq from (mail-fetch-field "from") + date (mail-fetch-field "date") + subject (or (mail-fetch-field "subject") "none") + references (mail-fetch-field "references") + message-id (mail-fetch-field "message-id") + followup-to (mail-fetch-field "followup-to") + newsgroups (mail-fetch-field "newsgroups") + reply-to (mail-fetch-field "reply-to") + distribution (mail-fetch-field "distribution") + mct (mail-fetch-field "mail-copies-to")) + (when (and (setq gnus-warning (mail-fetch-field "gnus-warning")) + (string-match "<[^>]+>" gnus-warning)) + (setq message-id (match-string 0 gnus-warning))) + ;; Remove bogus distribution. + (and (stringp distribution) + (string-match "world" distribution) + (setq distribution nil)) + ;; Remove any (buggy) Re:'s that are present and make a + ;; proper one. + (when (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject) + (setq subject (substring subject (match-end 0)))) + (setq subject (concat "Re: " subject)) + (widen)) + + (message-pop-to-buffer "*news message*") + + (message-setup + `((Subject . ,subject) + ,@(cond + (follow-to follow-to) + ((and followup-to message-use-followup-to) + (list + (cond + ((equal (downcase followup-to) "poster") + (if (or (eq message-use-followup-to 'use) + (y-or-n-p "Use Followup-To \"poster\"? ")) + (cons 'To (or reply-to from "")) + (cons 'Newsgroups newsgroups))) + (t + (if (or (equal followup-to newsgroups) + (not (eq message-use-followup-to 'ask)) + (y-or-n-p (format "Use Followup-To %s? " followup-to))) + (cons 'Newsgroups followup-to) + (cons 'Newsgroups newsgroups)))))) + (t + `((Newsgroups . ,newsgroups)))) + ,@(and distribution (list (cons 'Distribution distribution))) + (References . ,(concat (or references "") (and references " ") + (or message-id ""))) + ,@(when (and mct + (not (equal (downcase mct) "never"))) + (list (cons 'Cc (if (equal (downcase mct) "always") + (or reply-to from "") + mct))))) + cur))) + + ;;;###autoload + (defun message-cancel-news () + "Cancel an article you posted." + (interactive) + (unless (message-news-p) + (error "This is not a news article; canceling is impossible")) + (when (yes-or-no-p "Do you really want to cancel this article? ")) + (let (from newsgroups message-id distribution buf) + (save-excursion + ;; Get header info. from original article. + (save-restriction + (message-narrow-to-head) + (setq from (mail-fetch-field "from") + newsgroups (mail-fetch-field "newsgroups") + message-id (mail-fetch-field "message-id") + distribution (mail-fetch-field "distribution"))) + ;; Make sure that this article was written by the user. + (unless (string-equal + (downcase (mail-strip-quoted-names from)) + (downcase (message-make-address))) + (error "This article is not yours")) + ;; Make control message. + (setq buf (set-buffer (get-buffer-create " *message cancel*"))) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert "Newsgroups: " newsgroups "\n" + "From: " (message-make-from) "\n" + "Subject: cmsg cancel " message-id "\n" + "Control: cancel " message-id "\n" + (if distribution + (concat "Distribution: " distribution "\n") + "") + message-header-separator "\n" + "This is a cancel message from " from ".\n") + (message "Canceling your article...") + (funcall message-send-news-function) + (message "Canceling your article...done") + (kill-buffer buf)))) + + ;;;###autoload + (defun message-supersede () + "Start composing a message to supersede the current message. + This is done simply by taking the old article and adding a Supersedes + header line with the old Message-ID." + (interactive) + (let ((cur (current-buffer))) + ;; Check whether the user owns the article that is to be superseded. + (unless (string-equal + (downcase (mail-strip-quoted-names (mail-fetch-field "from"))) + (downcase (mail-strip-quoted-names (message-make-address)))) + (error "This article is not yours")) + ;; Get a normal message buffer. + (message-pop-to-buffer "*supersede message*") + (insert-buffer-substring cur) + (message-narrow-to-head) + ;; Remove unwanted headers. + (when message-ignored-supersedes-headers + (message-remove-header message-ignored-supersedes-headers t)) + (goto-char (point-min)) + (if (not (re-search-forward "^Message-ID: " nil t)) + (error "No Message-ID in this article") + (replace-match "Supersedes: " t t)) + (goto-char (point-max)) + (insert message-header-separator) + (widen) + (forward-line 1))) + + ;;;###autoload + (defun message-recover () + "Reread contents of current buffer from its last auto-save file." + (interactive) + (let ((file-name (make-auto-save-file-name))) + (cond ((save-window-excursion + (if (not (eq system-type 'vax-vms)) + (with-output-to-temp-buffer "*Directory*" + (buffer-disable-undo standard-output) + (let ((default-directory "/")) + (call-process + "ls" nil standard-output nil "-l" file-name)))) + (yes-or-no-p (format "Recover auto save file %s? " file-name))) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert-file-contents file-name nil))) + (t (error "message-recover cancelled"))))) + + ;;; Forwarding messages. + + (defun message-make-forward-subject () + "Return a Subject header suitable for the message in the current buffer." + (concat "[" (mail-fetch-field (if (message-news-p) "newsgroups" "from")) + "] " (or (mail-fetch-field "Subject") ""))) + + ;;;###autoload + (defun message-forward (&optional news) + (interactive "P") + (let ((cur (current-buffer)) + (subject (message-make-forward-subject))) + (if news (message-news nil subject) (message-mail nil subject)) + ;; Put point where we want it before inserting the forwarded + ;; message. + (if message-signature-before-forwarded-message + (goto-char (point-max)) + (message-goto-body)) + ;; Narrow to the area we are to insert. + (narrow-to-region (point) (point)) + ;; Insert the separators and the forwarded buffer. + (insert message-forward-start-separator) + (insert-buffer-substring cur) + (goto-char (point-max)) + (insert message-forward-end-separator) + (set-text-properties (point-min) (point-max) nil) + ;; Remove all unwanted headers. + (goto-char (point-min)) + (forward-line 1) + (narrow-to-region (point) (if (search-forward "\n\n" nil t) + (1- (point)) + (point))) + (goto-char (point-min)) + (message-remove-header message-included-forward-headers t) + (widen) + (message-position-point))) + + ;;;###autoload + (defun message-resend (address) + "Resend the current article to ADDRESS." + (interactive "sResend message to: ") + (save-excursion + (let ((cur (current-buffer)) + beg) + ;; We first set up a normal mail buffer. + (message-set-work-buffer) + (message-setup `((To . ,address))) + ;; Insert our usual headers. + (message-narrow-to-headers) + (message-generate-headers '(From Date To)) + (goto-char (point-min)) + ;; Rename them all to "Resent-*". + (while (re-search-forward "^[A-Za-z]" nil t) + (forward-char -1) + (insert "Resent-")) + (widen) + (forward-line) + (delete-region (point) (point-max)) + (setq beg (point)) + ;; Insert the message to be resent. + (insert-buffer-substring cur) + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (save-restriction + (narrow-to-region beg (point)) + (message-remove-header message-ignored-resent-headers t) + (goto-char (point-max))) + (insert mail-header-separator) + ;; Rename all old ("Also-")Resent headers. + (while (re-search-backward "^\\(Also-\\)?Resent-" beg t) + (beginning-of-line) + (insert "Also-")) + ;; Send it. + (funcall message-send-mail-function)))) + + ;;;###autoload + (defun message-bounce () + "Re-mail the current message. + This only makes sense if the current message is a bounce message than + contains some mail you have written which has been bounced back to + you." + (interactive "P") + (let ((cur (current-buffer))) + (message-pop-to-buffer "*mail message*") + (insert-buffer-substring cur) + (goto-char (point-min)) + (or (and (re-search-forward mail-unsent-separator nil t) + (forward-line 1)) + (and (search-forward "\n\n" nil t) + (re-search-forward "^Return-Path:.*\n" nil t))) + ;; We remove everything before the bounced mail. + (delete-region + (point-min) + (if (re-search-forward "[^ \t]*:" nil t) + (match-beginning 0) + (point))) + (save-restriction + (message-narrow-to-head) + (message-remove-header message-ignored-bounced-headers t) + (goto-char (point-max)) + (insert mail-header-separator)) + (message-position-point))) + + (provide 'message) + + ;;; message.el ends here *** pub/sgnus/lisp/nnheader.el Sun Mar 24 03:42:23 1996 --- sgnus/lisp/nnheader.el Tue Mar 26 02:28:02 1996 *************** *** 39,44 **** --- 39,45 ---- (require 'mail-utils) (require 'sendmail) + (require 'message) (require 'rmail) (eval-when-compile (require 'cl)) *************** *** 259,294 **** ;; without inserting extra newline. (fill-region-as-paragraph begin (1+ (point)))))) - (defun nnheader-remove-header (header &optional is-regexp first) - "Remove HEADER. - If FIRST, only remove the first instance if the header. - Return the number of headers removed." - (goto-char (point-min)) - (let ((regexp (if is-regexp header (concat "^" header ":"))) - (number 0) - (case-fold-search t) - last) - (while (and (re-search-forward regexp nil t) - (not last)) - (incf number) - (when first - (setq last t)) - (delete-region - (match-beginning 0) - ;; There might be a continuation header, so we have to search - ;; until we find a new non-continuation line. - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max)))) - number)) - (defun nnheader-replace-header (header new-value) "Remove HEADER and insert the NEW-VALUE." (save-excursion (save-restriction (nnheader-narrow-to-headers) (prog1 ! (nnheader-remove-header header) (goto-char (point-max)) (insert header ": " new-value "\n"))))) --- 260,272 ---- ;; without inserting extra newline. (fill-region-as-paragraph begin (1+ (point)))))) (defun nnheader-replace-header (header new-value) "Remove HEADER and insert the NEW-VALUE." (save-excursion (save-restriction (nnheader-narrow-to-headers) (prog1 ! (message-remove-header header) (goto-char (point-max)) (insert header ": " new-value "\n"))))) *** pub/sgnus/lisp/nnmail.el Sun Mar 24 03:42:23 1996 --- sgnus/lisp/nnmail.el Tue Mar 26 06:04:06 1996 *************** *** 988,993 **** --- 988,994 ---- (buffer-disable-undo (current-buffer)) (and (file-exists-p nnmail-message-id-cache-file) (insert-file-contents nnmail-message-id-cache-file)) + (set-buffer-modified-p nil) (current-buffer)))) (defun nnmail-cache-close () *************** *** 1011,1017 **** nnmail-message-id-cache-file nil 'silent) (set-buffer-modified-p nil) (setq nnmail-cache-buffer nil) ! (kill-buffer (current-buffer))))) (defun nnmail-cache-insert (id) (when nnmail-treat-duplicates --- 1012,1019 ---- nnmail-message-id-cache-file nil 'silent) (set-buffer-modified-p nil) (setq nnmail-cache-buffer nil) ! ;;(kill-buffer (current-buffer)) ! ))) (defun nnmail-cache-insert (id) (when nnmail-treat-duplicates *** pub/sgnus/lisp/nnsoup.el Sun Mar 24 03:42:23 1996 --- sgnus/lisp/nnsoup.el Tue Mar 26 06:04:51 1996 *************** *** 321,327 **** (nnsoup-store-reply "news") t) ! (defun nnsoup-request-mail () (nnsoup-store-reply "mail") t) --- 321,327 ---- (nnsoup-store-reply "news") t) ! (defun nnsoup-request-mail (&optional server) (nnsoup-store-reply "mail") t) *************** *** 609,629 **** (and areas (car areas)))) (defvar nnsoup-old-functions ! (list gnus-inews-article-function send-mail-function)) ;;;###autoload (defun nnsoup-set-variables () "Use the SOUP methods for posting news and mailing mail." (interactive) ! (setq gnus-inews-article-function 'nnsoup-request-post) ! (setq send-mail-function 'nnsoup-request-mail)) ;;;###autoload (defun nnsoup-revert-variables () "Revert posting and mailing methods to the standard Emacs methods." (interactive) ! (setq gnus-inews-article-function (car nnsoup-old-functions)) ! (setq send-mail-function (cadr nnsoup-old-functions))) (defun nnsoup-store-reply (kind) ;; Mostly stolen from `sendmail.el'. --- 609,629 ---- (and areas (car areas)))) (defvar nnsoup-old-functions ! (list message-send-mail-function message-send-news-function)) ;;;###autoload (defun nnsoup-set-variables () "Use the SOUP methods for posting news and mailing mail." (interactive) ! (setq message-send-news-function 'nnsoup-request-post) ! (setq message-send-mail-function 'nnsoup-request-mail)) ;;;###autoload (defun nnsoup-revert-variables () "Revert posting and mailing methods to the standard Emacs methods." (interactive) ! (setq message-send-mail-function (car nnsoup-old-functions)) ! (setq message-send-news-function (cadr nnsoup-old-functions))) (defun nnsoup-store-reply (kind) ;; Mostly stolen from `sendmail.el'. *** pub/sgnus/lisp/nnspool.el Sun Mar 24 03:42:23 1996 --- sgnus/lisp/nnspool.el Wed Mar 27 00:57:31 1996 *************** *** 411,423 **** ((< num article) (setq min (point))) (t ! (setq found t))))) ;; Now we may have found the article we're looking for, or we ;; may be somewhere near it. ! (when (not (eq num article)) (setq found (point)) (while (and (< (point) max) ! (< num article)) (forward-line 1) (setq found (point)) (or (eobp) --- 411,425 ---- ((< num article) (setq min (point))) (t ! (setq found 'yes))))) ;; Now we may have found the article we're looking for, or we ;; may be somewhere near it. ! (when (and (not (eq found 'yes)) ! (not (eq num article))) (setq found (point)) (while (and (< (point) max) ! (or (not (numberp num)) ! (< num article))) (forward-line 1) (setq found (point)) (or (eobp) *** pub/sgnus/lisp/ChangeLog Sun Mar 24 03:42:31 1996 --- sgnus/lisp/ChangeLog Tue Mar 26 06:04:01 1996 *************** *** 1,4 **** --- 1,26 ---- + Tue Mar 26 05:15:15 1996 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-retrieve-headers): Would bug out on + empty groups. + + * nnmail.el (nnmail-cache-open): Mark buffer as un-modified. + (nnmail-cache-close): Don't kill buffer. + + * gnus-msg.el: Cannibalized. + + * message.el: New file. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Don't enter + sparse article into cache. + + Sun Mar 24 06:44:11 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-article-hide-boring-headers): Use + `gnus-extract-address-components'. + Sun Mar 24 00:00:33 1996 Lars Magne Ingebrigtsen + + * gnus.el: September Gnus v0.57 is released. * gnus-topic.el (gnus-topic-insert-topic-line): Would mess up the `.' command.