1 ;;; gnus-message --- mail and post interface for Gnus
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
33 ;;; Gnus Posting Functions
36 (defvar gnus-organization-file "/usr/lib/news/organization"
37 "*Local news organization file.")
39 (defvar gnus-post-news-buffer "*post-news*")
40 (defvar gnus-winconf-post-news nil)
42 (defvar gnus-summary-send-map nil)
44 (define-prefix-command 'gnus-summary-send-map)
45 (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
46 (define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
47 (define-key gnus-summary-send-map "f" 'gnus-summary-followup)
48 (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
49 (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply)
50 (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original)
51 (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
52 (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
53 (define-key gnus-summary-send-map "r" 'gnus-summary-reply)
54 (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
55 (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
56 (define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
57 (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward)
58 (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward)
59 (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward)
60 (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward)
62 ;;; Internal functions.
64 ;; Return NUM konverted to a key of exactly LEN chars. Requires NUM>=0.
65 ;; If LEN=-1, return 0 or more chars as necessary.
66 (defun gnus-number-base31 (num len)
67 (if (if (< len 0) (<= num 0) (= len 0))
69 (concat (gnus-number-base31 (/ num 31) (1- len))
70 (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
73 (defun gnus-number-base36 (num len)
74 (if (if (< len 0) (<= num 0) (= len 0))
76 (concat (gnus-number-base36 (/ num 36) (1- len))
77 (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
80 ;;; Post news commands of Gnus group mode and summary mode
82 (defun gnus-group-post-news ()
85 (gnus-set-global-variables)
86 ;; Save window configuration.
87 (setq gnus-winconf-post-news (current-window-configuration))
88 (let ((gnus-newsgroup-name nil))
92 (pop-to-buffer gnus-article-buffer)
94 (split-window-vertically)
95 (gnus-post-news 'post))
97 (pop-to-buffer gnus-article-buffer)
99 (delete-other-windows)
100 (gnus-post-news 'post)))
101 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
102 (not (zerop (buffer-size))))
103 ;; Restore last window configuration.
104 (and gnus-winconf-post-news
105 (set-window-configuration gnus-winconf-post-news)))))
106 ;; We don't want to return to summary buffer nor article buffer later.
107 (setq gnus-winconf-post-news nil)
108 (if (get-buffer gnus-summary-buffer)
109 (bury-buffer gnus-summary-buffer))
110 (if (get-buffer gnus-article-buffer)
111 (bury-buffer gnus-article-buffer)))
113 (defun gnus-summary-post-news ()
116 (gnus-set-global-variables)
117 ;; Save window configuration.
118 (setq gnus-winconf-post-news (current-window-configuration))
120 (gnus-post-news 'post gnus-newsgroup-name)
121 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
122 (not (zerop (buffer-size))))
123 ;; Restore last window configuration.
124 (and gnus-winconf-post-news
125 (set-window-configuration gnus-winconf-post-news))))
126 ;; We don't want to return to article buffer later.
127 (if (get-buffer gnus-article-buffer)
128 (bury-buffer gnus-article-buffer)))
130 (defun gnus-summary-followup (yank)
131 "Compose a followup to an article.
132 If prefix argument YANK is non-nil, original article is yanked automatically."
134 (gnus-set-global-variables)
135 (save-window-excursion
136 (gnus-summary-select-article t))
137 (let ((headers gnus-current-headers)
138 (gnus-newsgroup-name gnus-newsgroup-name))
139 ;; Check Followup-To: poster.
140 (set-buffer gnus-article-buffer)
141 (if (and gnus-use-followup-to
142 (string-equal "poster" (gnus-fetch-field "followup-to"))
143 (or (not (eq gnus-use-followup-to t))
145 "Do you want to ignore `Followup-To: poster'? "))))
146 ;; Mail to the poster. Gnus is now RFC1036 compliant.
147 (gnus-summary-reply yank)
148 ;; Save window configuration.
149 (setq gnus-winconf-post-news (current-window-configuration))
151 (gnus-post-news nil gnus-newsgroup-name
152 headers gnus-article-buffer yank)
153 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
154 (not (zerop (buffer-size))))
155 ;; Restore last window configuration.
156 (and gnus-winconf-post-news
157 (set-window-configuration gnus-winconf-post-news))))
158 ;; We don't want to return to article buffer later.
159 (bury-buffer gnus-article-buffer)))
160 (gnus-article-hide-headers-if-wanted))
162 (defun gnus-summary-followup-with-original ()
163 "Compose a followup to an article and include the original article."
165 (gnus-summary-followup t))
167 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
168 (defun gnus-summary-followup-and-reply (yank)
169 "Compose a followup and do an auto mail to author."
171 (let ((gnus-auto-mail-to-author t))
172 (gnus-summary-followup yank)))
174 (defun gnus-summary-followup-and-reply-with-original ()
175 "Compose a followup, include the original, and do an auto mail to author."
177 (gnus-summary-followup-and-reply t))
179 (defun gnus-summary-cancel-article ()
180 "Cancel an article you posted."
182 (gnus-set-global-variables)
183 (gnus-summary-select-article t)
184 (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
185 (gnus-article-hide-headers-if-wanted))
187 (defun gnus-summary-supersede-article ()
188 "Compose an article that will supersede a previous article.
189 This is done simply by taking the old article and adding a Supersedes
190 header line with the old Message-ID."
192 (gnus-set-global-variables)
195 (downcase (mail-strip-quoted-names
196 (header-from gnus-current-headers)))
197 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
198 (error "This article is not yours."))
199 (gnus-summary-select-article t)
201 (set-buffer gnus-article-buffer)
202 (let ((buffer-read-only nil))
203 (goto-char (point-min))
204 (search-forward "\n\n" nil t)
205 (if (not (re-search-backward "^Message-ID: " nil t))
206 (error "No Message-ID in this article"))))
207 (if (gnus-post-news 'post gnus-newsgroup-name)
210 (insert-buffer gnus-article-buffer)
211 (goto-char (point-min))
212 (search-forward "\n\n" nil t)
213 (if (not (re-search-backward "^Message-ID: " nil t))
214 (error "No Message-ID in this article")
215 (replace-match "Supersedes: " t t))
216 (search-forward "\n\n")
218 (insert mail-header-separator))))
222 (fset 'sendnews 'gnus-post-news)
225 (fset 'postnews 'gnus-post-news)
227 (defun gnus-post-news (post &optional group header article-buffer yank subject)
228 "Begin editing a new USENET news article to be posted.
229 Type \\[describe-mode] in the buffer to get a list of commands."
230 (interactive (list t))
231 (if (or (not gnus-novice-user)
235 (format "%s" (car (gnus-find-method-for-group
236 gnus-newsgroup-name)))
237 gnus-valid-select-methods))))
240 (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))))
241 (gnus-y-or-n-p "Are you sure you want to post to all of USENET? "))
242 (let ((sumart (if (not post)
244 (set-buffer gnus-summary-buffer)
245 (cons (current-buffer) gnus-current-article))))
246 (from (and header (header-from header)))
247 follow-to real-group)
248 (and gnus-interactive-post
249 (not gnus-expert-user)
253 (completing-read "Group: " gnus-active-hashtb))
255 (setq subject (read-string "Subject: ")))))
256 (setq mail-reply-buffer article-buffer)
258 (let ((gnus-newsgroup-name (or group gnus-newsgroup-name "")))
259 (setq real-group (and group (gnus-group-real-name group)))
260 (setq gnus-post-news-buffer
261 (gnus-request-post-buffer
262 post real-group subject header article-buffer
263 (nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb)))
264 (or (cdr (assq 'to-group
265 (nth 5 (nth 2 (gnus-gethash
267 gnus-newsrc-hashtb)))))
268 (if (and (boundp 'gnus-followup-to-function)
269 gnus-followup-to-function
273 (set-buffer article-buffer)
274 (funcall gnus-followup-to-function group)))))
275 gnus-use-followup-to))
278 (gnus-configure-windows '(1 0 0))
279 (switch-to-buffer gnus-post-news-buffer))
280 (gnus-configure-windows '(0 1 0))
283 (switch-to-buffer article-buffer)
284 (pop-to-buffer gnus-post-news-buffer))
285 (switch-to-buffer gnus-post-news-buffer)))
286 (gnus-overload-functions)
287 (make-local-variable 'gnus-article-reply)
288 (make-local-variable 'gnus-article-check-size)
289 (setq gnus-article-reply sumart)
290 ;; Handle `gnus-auto-mail-to-author'.
291 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
292 (let ((to (if (eq gnus-auto-mail-to-author 'ask)
293 (and (y-or-n-p "Also send mail to author? ") from)
294 (and gnus-auto-mail-to-author from))))
297 (if (mail-fetch-field "To")
300 (insert "Cc: " to "\n"))
301 (mail-position-on-field "To")
303 ;; Handle author copy using BCC field.
304 (if (and gnus-mail-self-blind
305 (not (mail-fetch-field "bcc")))
307 (mail-position-on-field "Bcc")
308 (insert (if (stringp gnus-mail-self-blind)
310 (user-login-name)))))
311 ;; Handle author copy using FCC field.
314 (mail-position-on-field "Fcc")
315 (insert gnus-author-copy)))
316 (goto-char (point-min))
319 (re-search-forward "^Newsgroup:" nil t)
322 (re-search-forward "^Subject:" nil t)
326 (concat "^" (regexp-quote mail-header-separator) "$"))
329 (concat "^" (regexp-quote mail-header-separator) "$"))
331 (and yank (save-excursion (news-reply-yank-original nil)))
332 (if gnus-post-prepare-function
333 (funcall gnus-post-prepare-function group))))))
334 (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum)))
338 (defun gnus-inews-news (&optional use-group-method)
339 "Send a news message.
340 If given a prefix, and the group is a foreign group, this function
341 will attempt to use the foreign server to post the article."
343 (let* ((case-fold-search nil)
344 (server-running (gnus-server-opened gnus-select-method))
345 (reply gnus-article-reply))
347 ;; Connect to default NNTP server if necessary.
348 ;; Suggested by yuki@flab.fujitsu.junet.
349 (gnus-start-news-server) ;Use default server.
350 ;; NNTP server must be opened before current buffer is modified.
352 (goto-char (point-min))
353 (run-hooks 'news-inews-hook)
358 (goto-char (point-min))
360 (concat "^" (regexp-quote mail-header-separator) "$"))))
362 ;; Correct newsgroups field: change sequence of spaces to comma and
363 ;; eliminate spaces around commas. Eliminate imbedded line breaks.
364 (goto-char (point-min))
365 (if (search-forward-regexp "^Newsgroups: +" nil t)
369 (if (re-search-forward "^[^ \t]" nil 'end)
372 (goto-char (point-min))
373 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
374 (goto-char (point-min))
375 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
377 ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
378 ;; Help save the the world!
381 (let ((newsgroups (mail-fetch-field "newsgroups"))
382 (followup-to (mail-fetch-field "followup-to"))
384 (if (and (string-match "," newsgroups) (not followup-to))
386 (while (string-match "," newsgroups)
388 (cons (list (substring newsgroups
389 0 (match-beginning 0)))
391 (setq newsgroups (substring newsgroups (match-end 0))))
392 (setq groups (nreverse (cons (list newsgroups) groups)))
395 (completing-read "Followups to: (default all groups) "
397 (if (> (length to) 0)
399 (goto-char (point-min))
400 (insert "Followup-To: " to "\n")))))))
402 ;; Cleanup Followup-To.
403 (goto-char (point-min))
404 (if (search-forward-regexp "^Followup-To: +" nil t)
408 (if (re-search-forward "^[^ \t]" nil 'end)
411 (goto-char (point-min))
412 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
413 (goto-char (point-min))
414 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
416 ;; Mail the message too if To:, Bcc:. or Cc: exists.
417 (if (or (mail-fetch-field "to" nil t)
418 (mail-fetch-field "bcc" nil t)
419 (mail-fetch-field "cc" nil t))
420 (if gnus-mail-send-method
424 (message "Sending via mail...")
426 (if gnus-mail-courtesy-message
428 ;; Insert "courtesy" mail message.
431 (concat "^" (regexp-quote
432 mail-header-separator) "$"))
434 (insert gnus-mail-courtesy-message)
435 (funcall gnus-mail-send-method)
437 (search-forward gnus-mail-courtesy-message)
438 (replace-match "" t t))
439 (funcall gnus-mail-send-method))
441 (message "Sending via mail... done")
446 (concat "^" (regexp-quote
447 mail-header-separator) "$")))
449 (delete-matching-lines "BCC:.*")))
451 (message "No mailer defined. To: and/or Cc: fields ignored.")
454 ;; Send to NNTP server.
455 (message "Posting to USENET...")
456 (if (gnus-inews-article use-group-method)
458 (message "Posting to USENET... done")
459 (if (gnus-buffer-exists-p (car-safe reply))
462 (set-buffer gnus-summary-buffer)
463 (gnus-summary-mark-article-as-replied
465 ;; We cannot signal an error.
466 (ding) (message "Article rejected: %s"
467 (gnus-status-message gnus-select-method)))
468 (set-buffer-modified-p nil))
469 ;; If NNTP server is opened by gnus-inews-news, close it by myself.
471 (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
472 (and (fboundp 'bury-buffer) (bury-buffer))
473 ;; Restore last window configuration.
474 (and gnus-winconf-post-news
475 (set-window-configuration gnus-winconf-post-news))
476 (setq gnus-winconf-post-news nil)))
478 (defun gnus-inews-check-post ()
479 "Check whether the post looks ok."
481 (not gnus-check-before-posting)
483 ;; We narrow to the headers and check them first.
486 (goto-char (point-min))
490 (concat "^" (regexp-quote mail-header-separator) "$")))
491 (goto-char (point-min))
493 ;; Check for commands in Subject.
495 (if (string-match "^cmsg " (mail-fetch-field "subject"))
497 "The control code \"cmsg \" is in the subject. Really post? ")
499 ;; Check for multiple identical headers.
502 (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
504 (or (re-search-forward
505 (concat "^" (setq found
508 (- (match-end 0) 2))))
513 (format "Multiple %s headers. Really post? " found))
515 ;; Check for version and sendsys.
517 (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
519 (format "The article contains a %s command. Really post? "
520 (buffer-substring (match-beginning 0)
521 (1- (match-end 0)))))
523 ;; Check the Message-Id header.
525 (let* ((case-fold-search t)
526 (message-id (mail-fetch-field "message-id")))
528 (and (string-match "@" message-id)
529 (string-match "@[^\\.]*\\." message-id))
531 (format "The Message-ID looks strange: \"%s\". Really post? "
533 ;; Check the From header.
535 (let* ((case-fold-search t)
536 (from (mail-fetch-field "from")))
538 (and (string-match "@" from)
539 (string-match "@[^\\.]*\\." from))
541 (format "The From looks strange: \"%s\". Really post? "
543 ;; Check for long lines.
545 (goto-char (point-min))
547 (concat "^" (regexp-quote mail-header-separator) "$"))
551 (< (current-column) 80))
552 (zerop (forward-line 1))))
557 "You have lines longer than 79 characters. Really post? "))))
558 ;; Check for control characters.
560 (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
562 "The article contains control characters. Really post? ")
564 ;; Check excessive size.
565 (if (> (buffer-size) 60000)
566 (gnus-y-or-n-p (format "The article is %d octets long. Really post? "
569 ;; Use the (size . checksum) variable to see whether the
570 ;; article is empty or has only quoted text.
571 (if (and (= (buffer-size) (car gnus-article-check-size))
572 (= (gnus-article-checksum) (cdr gnus-article-check-size)))
574 "It looks like there's no new text in your article. Really post? ")
577 (defun gnus-article-checksum ()
581 (setq sum (logxor sum (following-char)))
585 (defun gnus-cancel-news ()
586 "Cancel an article you posted."
588 (if (or gnus-expert-user
589 (gnus-yes-or-no-p "Do you really want to cancel this article? "))
595 ;; Get header info. from original article.
597 (gnus-article-show-all-headers)
598 (goto-char (point-min))
599 (search-forward "\n\n" nil 'move)
600 (narrow-to-region (point-min) (point))
601 (setq from (mail-fetch-field "from"))
602 (setq newsgroups (mail-fetch-field "newsgroups"))
603 (setq message-id (mail-fetch-field "message-id"))
604 (setq distribution (mail-fetch-field "distribution")))
605 ;; Verify if the article is absolutely user's by comparing
606 ;; user id with value of its From: field.
609 (downcase (mail-strip-quoted-names from))
610 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
612 (ding) (message "This article is not yours."))
613 ;; Make control article.
614 (set-buffer (get-buffer-create " *Gnus-canceling*"))
615 (buffer-disable-undo (current-buffer))
617 (insert "Newsgroups: " newsgroups "\n"
618 "Subject: cancel " message-id "\n"
619 "Control: cancel " message-id "\n"
620 mail-header-separator "\n"
621 "This is a cancel message from " from ".\n")
622 ;; Send the control article to NNTP server.
623 (message "Canceling your article...")
624 (if (gnus-inews-article)
625 (message "Canceling your article... done")
627 (message "Cancel failed; %s"
628 (gnus-status-message gnus-newsgroup-name)))
629 ;; Kill the article buffer.
630 (kill-buffer (current-buffer)))))))
633 ;;; Lowlevel inews interface
635 (defun gnus-inews-article (&optional use-group-method)
636 "Post an article in current buffer using NNTP protocol."
637 ;; Check whether the article is a good Net Citizen.
638 (if (and gnus-article-check-size (not (gnus-inews-check-post)))
641 ;; Looks ok, so we do the nasty.
642 (let ((artbuf (current-buffer))
643 (tmpbuf (get-buffer-create " *Gnus-posting*")))
645 (goto-char (point-max))
646 ;; require a newline at the end for inews to append .signature to
647 (or (= (preceding-char) ?\n)
649 ;; Prepare article headers. All message body such as signature
650 ;; must be inserted before Lines: field is prepared.
652 (goto-char (point-min))
657 (concat "^" (regexp-quote mail-header-separator) "$"))
658 (match-beginning 0)))
659 (gnus-inews-remove-headers)
660 (gnus-inews-insert-headers)
661 (run-hooks gnus-inews-article-header-hook)
665 (buffer-disable-undo (current-buffer))
667 (insert-buffer-substring artbuf)
668 ;; Remove the header separator.
669 (goto-char (point-min))
671 (concat "^" (regexp-quote mail-header-separator) "$"))
672 (replace-match "" t t)
673 ;; This hook may insert a signature.
674 (run-hooks 'gnus-prepare-article-hook)
675 ;; Run final inews hooks. This hook may do FCC.
676 ;; The article must be saved before being posted because
677 ;; `gnus-request-post' modifies the buffer.
678 (run-hooks 'gnus-inews-article-hook)
679 ;; Post an article to NNTP server.
680 ;; Return NIL if post failed.
684 (gnus-find-method-for-group gnus-newsgroup-name)
685 gnus-select-method) use-group-method)
686 (kill-buffer (current-buffer)))))))
688 (defun gnus-inews-remove-headers ()
689 (let ((case-fold-search t))
690 ;; Remove NNTP-posting-host.
691 (goto-char (point-min))
692 (and (re-search-forward "^nntp-posting-host:" nil t)
693 (delete-region (progn (beginning-of-line) (point))
694 (progn (forward-line 1) (point))))
696 (goto-char (point-min))
697 (and (re-search-forward "^bcc:" nil t)
698 (delete-region (progn (beginning-of-line) (point))
699 (progn (forward-line 1) (point))))))
701 (defun gnus-inews-insert-headers ()
702 "Prepare article headers.
703 Headers already prepared in the buffer are not modified.
704 Headers in `gnus-required-headers' will be generated."
705 (let ((Date (gnus-inews-date))
706 (Message-ID (gnus-inews-message-id))
707 (Organization (gnus-inews-organization))
708 (From (gnus-inews-user-name))
709 (Path (gnus-inews-path))
713 (Lines (gnus-inews-lines))
714 (X-Newsreader gnus-version)
715 (headers gnus-required-headers)
718 ;; First we remove any old Message-IDs. This might be slightly
719 ;; fascist, but if the user really wants to generate Message-IDs
720 ;; by herself, she should remove it from the `gnus-required-list'.
721 (goto-char (point-min))
722 (and (memq 'Message-ID headers)
723 (re-search-forward "^Message-ID:" nil t)
724 (delete-region (progn (beginning-of-line) (point))
725 (progn (forward-line 1) (point))))
726 ;; Insert new Sender if the From is strange.
727 (let ((from (mail-fetch-field "from")))
728 (if (and from (not (string= (downcase from) (downcase From))))
730 (goto-char (point-min))
731 (and (re-search-forward "^Sender:" nil t)
732 (delete-region (progn (beginning-of-line) (point))
733 (progn (forward-line 1) (point))))
734 (insert "Sender: " From "\n"))))
735 ;; If there are References, and no "Re: ", then the thread has
736 ;; changed name. See Son-of-1036.
737 (if (and (mail-fetch-field "references")
738 (get-buffer gnus-article-buffer))
739 (let ((psubject (gnus-simplify-subject-re
740 (mail-fetch-field "subject")))
743 (set-buffer gnus-article-buffer)
745 (gnus-narrow-to-headers)
746 (if (setq subject (mail-fetch-field "subject"))
748 (and gnus-summary-gather-subject-limit
749 (numberp gnus-summary-gather-subject-limit)
750 (> (length subject) gnus-summary-gather-subject-limit)
753 gnus-summary-gather-subject-limit)))
754 (setq subject (gnus-simplify-subject-re subject))))))
755 (or (and psubject subject (string= subject psubject))
757 (string-match "@" Message-ID)
759 (concat (substring Message-ID 0 (match-beginning 0))
761 (substring Message-ID (match-beginning 0))))))))
762 ;; Go through all the required headers and see if they are in the
763 ;; articles already. If they are not, or are empty, they are
764 ;; inserted automatically - except for Subject, Newsgroups and
767 (goto-char (point-min))
768 (setq elem (car headers))
770 (setq header (car elem))
772 (if (or (not (re-search-forward
773 (concat "^" (downcase (symbol-name header)) ":") nil t))
775 (if (= (following-char) ? ) (forward-char 1) (insert " "))
776 (looking-at "[ \t]*$")))
780 ;; The element is a cons. Either the cdr is
781 ;; a string to be inserted verbatim, or it
782 ;; is a function, and we insert the value
783 ;; returned from this function.
784 (or (and (stringp (cdr elem)) (cdr elem))
785 (and (fboundp (cdr elem)) (funcall (cdr elem))))
786 ;; The element is a symbol. We insert the
787 ;; value of this symbol, if any.
788 (and (boundp header) (symbol-value header)))
789 ;; We couldn't generate a value for this header,
790 ;; so we just ask the user.
791 (read-from-minibuffer
792 (format "Empty header for %s; enter value: " header))))
795 (goto-char (point-max))
796 (insert (symbol-name header) ": " value "\n"))
797 (replace-match value t t))))
798 (setq headers (cdr headers)))))
800 (defun gnus-inews-insert-signature ()
801 "Insert a signature file.
802 If `gnus-signature-function' is bound and returns a string, this
803 string is used instead of the variable `gnus-signature-file'.
804 In either case, if the string is a file name, this file is
805 inserted. If the string is not a file name, the string itself is
807 If you never want any signature inserted, set both those variables to
811 (or (and gnus-signature-function
812 (fboundp gnus-signature-function)
813 (funcall gnus-signature-function gnus-newsgroup-name))
814 gnus-signature-file))
817 (or (file-exists-p signature)
818 (string-match " " signature)
820 "^/[^/]+/" (expand-file-name signature)))))
822 (goto-char (point-max))
823 ;; Delete any previous signatures.
824 (if (and mail-signature (search-backward "\n-- \n" nil t))
825 (delete-region (1+ (point)) (point-max)))
827 (and (< 4 (setq b (count-lines
830 (if (file-exists-p signature)
831 (insert-file-contents signature)
833 (goto-char (point-max))
834 (or (bolp) (insert "\n"))
836 (not gnus-expert-user)
840 "Your .sig is %d lines; it should be max 4. Really post? "
842 (if (file-exists-p signature)
843 (error (format "Edit %s." signature))
844 (error "Trim your signature."))))))))
846 (defun gnus-inews-do-fcc ()
847 "Process FCC: fields in current article buffer.
848 Unless the first character of the field is `|', the article is saved
849 to the specified file using the function specified by the variable
850 gnus-author-copy-saver. The default function rmail-output saves in
852 If the first character is `|', the contents of the article is send to
853 a program specified by the rest of the value."
856 (case-fold-search t)) ;Should ignore case.
859 (goto-char (point-min))
860 (search-forward "\n\n")
861 (narrow-to-region (point-min) (point))
862 (goto-char (point-min))
863 (while (re-search-forward "^FCC:[ \t]*" nil t)
865 (cons (buffer-substring
869 (skip-chars-backward " \t")
872 (delete-region (match-beginning 0)
873 (progn (forward-line 1) (point))))
874 ;; Process FCC operations.
877 (setq fcc-file (car fcc-list))
878 (setq fcc-list (cdr fcc-list))
879 (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
880 (let ((program (substring fcc-file
881 (match-beginning 1) (match-end 1))))
882 ;; Suggested by yuki@flab.fujitsu.junet.
883 ;; Send article to named program.
884 (call-process-region (point-min) (point-max) shell-file-name
885 nil nil nil "-c" program)))
887 ;; Suggested by hyoko@flab.fujitsu.junet.
888 ;; Save article in Unix mail format by default.
889 (if (and gnus-author-copy-saver
890 (not (eq gnus-author-copy-saver 'rmail-output)))
891 (funcall gnus-author-copy-saver fcc-file)
892 (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
893 (gnus-output-to-rmail fcc-file)
894 (rmail-output fcc-file 1 t t))))))))))
896 (defun gnus-inews-path ()
898 (let ((login-name (gnus-inews-login-name)))
899 (cond ((null gnus-use-generic-path)
900 (concat (nth 1 gnus-select-method) "!" login-name))
901 ((stringp gnus-use-generic-path)
902 ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
903 (concat gnus-use-generic-path "!" login-name))
906 (defun gnus-inews-user-name ()
907 "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
908 (let ((full-name (gnus-inews-full-name)))
909 (or gnus-user-from-line
910 (concat (if (or gnus-user-login-name gnus-use-generic-from
911 gnus-local-domain (getenv "DOMAINNAME"))
912 (concat (gnus-inews-login-name) "@"
913 (gnus-inews-domain-name gnus-use-generic-from))
916 (cond ((string-equal full-name "") "")
917 ((string-equal full-name "&") ;Unix hack.
918 (concat " (" (user-login-name) ")"))
920 (concat " (" full-name ")")))))))
922 (defun gnus-inews-login-name ()
924 (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
926 (defun gnus-inews-full-name ()
927 "Return full user name."
928 (or gnus-user-full-name (getenv "NAME") (user-full-name)))
930 (defun gnus-inews-domain-name (&optional genericfrom)
931 "Return user's domain name.
932 If optional argument GENERICFROM is a string, use it as the domain
933 name; if it is non-nil, strip off local host name from the domain name.
934 If the function `system-name' returns full internet name and the
935 domain is undefined, the domain name is got from it."
936 (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
937 (let* ((system-name (system-name))
939 (or (if (stringp genericfrom) genericfrom)
940 (getenv "DOMAINNAME")
942 ;; Function `system-name' may return full internet name.
943 ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
944 (if (string-match "\\." system-name)
945 (substring system-name (match-end 0)))
946 (read-string "Domain name (no host): ")))
947 (host (or (if (string-match "\\." system-name)
948 (substring system-name 0 (match-beginning 0)))
950 (if (string-equal "." (substring domain 0 1))
951 (setq domain (substring domain 1)))
952 ;; Support GENERICFROM as same as standard Bnews system.
953 ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
954 (cond ((null genericfrom)
955 (concat host "." domain))
956 ;;((stringp genericfrom) genericfrom)
958 (if (string-match "\\." (system-name))
960 (substring user-mail-address
961 (1+ (string-match "@" user-mail-address))))))
963 (defun gnus-inews-full-address ()
964 (let ((domain (gnus-inews-domain-name))
965 (system (system-name))
966 (case-fold-search t))
967 (if (string-match "\\." system) system
968 (if (string-match (concat "^" (regexp-quote system)) domain) domain
969 (concat system "." domain)))))
971 (defun gnus-inews-message-id ()
972 "Generate unique Message-ID for user."
973 ;; Message-ID should not contain a slash and should be terminated by
974 ;; a number. I don't know the reason why it is so.
975 (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
977 (defun gnus-inews-unique-id ()
978 "Generate unique ID from user name and current time."
979 (concat (downcase (gnus-inews-login-name))
981 (lambda (num) (gnus-number-base31 num 3))
985 (defvar gnus-unique-id-char nil)
987 ;; If you ever change this function, make sure the new version
988 ;; cannot generate IDs that the old version could.
989 ;; You might for example insert a "." somewhere (not next to another dot
990 ;; or string boundary), or modify the newsreader name to "Ding".
991 (defun gnus-inews-unique-id-new ()
992 ;; Dont use microseconds from (current-time), they may be unsupported.
993 ;; Instead we use this randomly inited counter.
994 (setq gnus-unique-id-char
995 (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20)))))
996 ;; (current-time) returns 16-bit ints,
997 ;; and 2^16*25 just fits into 4 digits i base 36.
999 (let ((tm (if (fboundp 'current-time)
1000 (current-time) '(12191 46742 287898))))
1002 (if (memq system-type '(ms-dos emx vax-vms))
1003 (let ((user (downcase (gnus-inews-login-name))))
1004 (while (string-match "[^a-z0-9_]" user)
1005 (aset user (match-beginning 0) ?_))
1007 (gnus-number-base36 (user-uid) -1))
1008 (gnus-number-base36 (+ (car tm) (lsh (% gnus-unique-id-char 25) 16)) 4)
1009 (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4)
1010 ;; Append the newsreader name, because while the generated
1011 ;; ID is unique to this newsreader, other newsreaders might
1012 ;; otherwise generate the same ID via another algorithm.
1016 (defun gnus-inews-date ()
1017 "Current time string."
1018 (timezone-make-date-arpa-standard
1019 (current-time-string) (current-time-zone)))
1021 (defun gnus-inews-organization ()
1022 "Return user's organization.
1023 The ORGANIZATION environment variable is used if defined.
1024 If not, the variable `gnus-local-organization' is used instead.
1025 If it is a function, the function will be called with the current
1026 newsgroup name as the argument.
1027 If this is a file name, the contents of this file will be used as the
1029 (let* ((organization
1030 (or (getenv "ORGANIZATION")
1031 (if gnus-local-organization
1032 (if (and (symbolp gnus-local-organization)
1033 (fboundp gnus-local-organization))
1034 (funcall gnus-local-organization gnus-newsgroup-name)
1035 gnus-local-organization))
1036 gnus-organization-file
1037 "~/.organization")))
1038 (and (stringp organization)
1039 (> (length organization) 0)
1040 (or (file-exists-p organization)
1041 (string-match " " organization)
1042 (not (string-match "^/[^/]+/" (expand-file-name organization))))
1044 (gnus-set-work-buffer)
1045 (if (file-exists-p organization)
1046 (insert-file-contents organization)
1047 (insert organization))
1048 (goto-char (point-min))
1049 (while (re-search-forward " *\n *" nil t)
1050 (replace-match " " t t))
1051 (buffer-substring (point-min) (point-max))))))
1053 (defun gnus-inews-lines ()
1054 "Count the number of lines and return numeric string."
1058 (goto-char (point-min))
1060 (concat "^" (regexp-quote mail-header-separator) "$"))
1062 (int-to-string (count-lines (point) (point-max))))))
1066 ;;; Gnus Mail Functions
1069 ;;; Mail reply commands of Gnus summary mode
1071 (defun gnus-summary-reply (yank)
1072 "Reply mail to news author.
1073 If prefix argument YANK is non-nil, original article is yanked automatically.
1074 Customize the variable gnus-mail-reply-method to use another mailer."
1076 ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
1077 ;; Stripping headers should be specified with mail-yank-ignored-headers.
1078 (gnus-set-global-variables)
1079 (setq gnus-winconf-post-news (current-window-configuration))
1080 (gnus-summary-select-article t)
1081 (let ((gnus-newsgroup-name gnus-newsgroup-name))
1082 (bury-buffer gnus-article-buffer)
1083 (funcall gnus-mail-reply-method yank))
1084 (gnus-article-hide-headers-if-wanted))
1086 (defun gnus-summary-reply-with-original ()
1087 "Reply mail to news author with original article.
1088 Customize the variable gnus-mail-reply-method to use another mailer."
1090 (gnus-summary-reply t))
1092 (defun gnus-summary-mail-forward (post)
1093 "Forward the current message to another user.
1094 Customize the variable gnus-mail-forward-method to use another mailer."
1096 (gnus-summary-select-article t)
1097 (setq gnus-winconf-post-news (current-window-configuration))
1098 (if gnus-split-window
1100 (switch-to-buffer gnus-article-buffer)
1102 (delete-other-windows)
1103 (bury-buffer gnus-article-buffer))
1104 (let ((gnus-newsgroup-name gnus-newsgroup-name))
1106 (gnus-forward-using-post)
1107 (funcall gnus-mail-forward-method)))
1108 (gnus-article-hide-headers-if-wanted))
1110 (defun gnus-summary-post-forward ()
1111 "Forward the current article to a newsgroup."
1113 (gnus-summary-mail-forward t))
1115 (defun gnus-summary-mail-other-window ()
1116 "Compose mail in other window.
1117 Customize the variable `gnus-mail-other-window-method' to use another
1120 (setq gnus-winconf-post-news (current-window-configuration))
1121 (let ((gnus-newsgroup-name gnus-newsgroup-name))
1122 (funcall gnus-mail-other-window-method)))
1124 (defun gnus-mail-reply-using-mail (&optional yank to-address)
1126 (set-buffer gnus-summary-buffer)
1127 (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb)))
1128 (group (gnus-group-real-name gnus-newsgroup-name))
1129 (cur (cons (current-buffer) (cdr gnus-article-current)))
1130 from subject date to reply-to message-of
1131 references message-id sender follow-to cc sendto elt)
1132 (set-buffer (get-buffer-create "*mail*"))
1134 (make-local-variable 'gnus-article-reply)
1135 (setq gnus-article-reply cur)
1136 (use-local-map (copy-keymap mail-mode-map))
1137 (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
1138 (if (and (buffer-modified-p)
1141 "Unsent article being composed; erase it? ")))
1145 (set-buffer gnus-article-buffer)
1146 (let ((buffer-read-only nil))
1147 (goto-char (point-min))
1148 (narrow-to-region (point-min)
1149 (progn (search-forward "\n\n") (point)))
1150 (add-text-properties (point-min) (point-max) '(invisible nil)))
1151 (if (and (boundp 'gnus-reply-to-function)
1152 gnus-reply-to-function)
1155 (gnus-narrow-to-headers)
1156 (setq follow-to (funcall gnus-reply-to-function group)))))
1157 (setq from (mail-fetch-field "from"))
1158 (setq date (mail-fetch-field "date"))
1161 (string-match " *at \\| *@ \\| *(\\| *<" from)))
1163 (concat (if stop-pos (substring from 0 stop-pos) from)
1164 "'s message of " date))))
1165 (setq sender (mail-fetch-field "sender"))
1166 (setq subject (or (mail-fetch-field "subject")
1168 (or (string-match "^[Rr][Ee]:" subject)
1169 (setq subject (concat "Re: " subject)))
1170 (setq cc (mail-fetch-field "cc"))
1171 (setq reply-to (mail-fetch-field "reply-to"))
1172 (setq references (mail-fetch-field "references"))
1173 (setq message-id (mail-fetch-field "message-id"))
1175 (setq news-reply-yank-from from)
1176 (setq news-reply-yank-message-id message-id)
1178 ;; Gather the "to" addresses out of the follow-to list and remove
1180 (if (and follow-to (listp follow-to))
1181 (while (setq elt (assoc "To" follow-to))
1182 (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
1183 (setq follow-to (delq elt follow-to))))
1185 (mail-setup (or to-address
1186 (if (and follow-to (not (stringp follow-to))) sendto
1187 (or follow-to reply-to from sender "")))
1188 subject message-of nil gnus-article-buffer nil)
1190 (if (and follow-to (listp follow-to))
1192 (goto-char (point-min))
1193 (re-search-forward "^To:" nil t)
1197 (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
1198 (setq follow-to (cdr follow-to)))))
1199 ;; Fold long references line to follow RFC1036.
1200 (mail-position-on-field "References")
1201 (let ((begin (- (point) (length "References: ")))
1204 (if references (insert references))
1205 (if (and references message-id) (insert " "))
1206 (if message-id (insert message-id))
1207 ;; The region must end with a newline to fill the region
1208 ;; without inserting extra newline.
1209 (fill-region-as-paragraph begin (1+ (point))))
1210 (goto-char (point-min))
1212 (concat "^" (regexp-quote mail-header-separator) "$"))
1215 (let ((last (point)))
1217 (mail-yank-original nil))
1218 (run-hooks 'news-reply-header-hook)
1220 (let ((mail (current-buffer)))
1223 (gnus-configure-windows '(0 1 0))
1224 (switch-to-buffer mail))
1225 (gnus-configure-windows '(0 0 1))
1226 (switch-to-buffer-other-window mail))))))
1228 (defun gnus-mail-yank-original ()
1231 (mail-yank-original nil))
1232 (run-hooks 'news-reply-header-hook))
1234 (defun gnus-mail-send-and-exit ()
1236 (let ((cbuf (current-buffer)))
1237 (mail-send-and-exit nil)
1238 (if (get-buffer gnus-group-buffer)
1242 (let ((reply gnus-article-reply))
1243 (if (gnus-buffer-exists-p (car-safe reply))
1245 (set-buffer (car reply))
1247 (gnus-summary-mark-article-as-replied
1249 (and gnus-winconf-post-news
1250 (set-window-configuration gnus-winconf-post-news))
1251 (setq gnus-winconf-post-news nil)))))
1253 (defun gnus-forward-make-subject ()
1254 (concat "[" (if (memq 'mail (assoc (symbol-name
1255 (car (gnus-find-method-for-group
1256 gnus-newsgroup-name)))
1257 gnus-valid-select-methods))
1258 (gnus-fetch-field "From")
1259 gnus-newsgroup-name)
1260 "] " (or (gnus-fetch-field "Subject") "")))
1262 (defun gnus-forward-insert-buffer (buffer)
1263 (let ((beg (goto-char (point-max))))
1264 (insert "------- Start of forwarded message -------\n")
1265 (insert-buffer buffer)
1266 (goto-char (point-max))
1267 (insert "------- End of forwarded message -------\n")
1268 ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
1270 (while (setq beg (next-single-property-change (point) 'invisible))
1272 (delete-region beg (or (next-single-property-change
1276 (defun gnus-mail-forward-using-mail ()
1277 "Forward the current message to another user using mail."
1278 ;; This is almost a carbon copy of rmail-forward in rmail.el.
1279 (let ((forward-buffer (current-buffer))
1280 (subject (gnus-forward-make-subject)))
1281 ;; If only one window, use it for the mail buffer. Otherwise, use
1282 ;; another window for the mail buffer so that the Rmail buffer
1283 ;; remains visible and sending the mail will get back to it.
1284 (if (if (one-window-p t)
1285 (mail nil nil subject)
1286 (mail-other-window nil nil subject))
1288 (use-local-map (copy-keymap (current-local-map)))
1289 (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
1290 (gnus-forward-insert-buffer forward-buffer)
1291 ;; You have a chance to arrange the message.
1292 (run-hooks 'gnus-mail-forward-hook)))))
1294 (defun gnus-forward-using-post ()
1295 (let ((forward-buffer (current-buffer))
1296 (subject (gnus-forward-make-subject)))
1297 (gnus-post-news 'post nil nil nil nil subject)
1299 (gnus-forward-insert-buffer forward-buffer)
1300 ;; You have a chance to arrange the message.
1301 (run-hooks 'gnus-mail-forward-hook))))
1303 (defun gnus-mail-other-window-using-mail ()
1304 "Compose mail other window using mail."
1305 (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer))
1306 (use-local-map (copy-keymap (current-local-map)))
1307 (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit))
1311 ;;; gnus-message.el ends here