Mercurial > emacs
annotate lisp/=gnuspost.el @ 17077:8f8c3d05b158
(byte-compile-file): Bind coding-system-for-write
instead of coding-system-for-read to 'no-conversion to disbale
code convertion by write-region.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 26 Feb 1997 11:59:40 +0000 |
parents | 7305dbef1911 |
children |
rev | line source |
---|---|
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; gnuspost.el --- post news commands for GNUS newsreader |
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
7300 | 3 ;; Copyright (C) 1989, 1990, 1993, 1994 Free Software Foundation, Inc. |
846
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
4 |
8100 | 5 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: news |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
7 |
267 | 8 ;; This file is part of GNU Emacs. |
9 | |
711
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
11 ;; it under the terms of the GNU General Public License as published by |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
711
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
13 ;; any later version. |
267 | 14 |
711
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
15 ;; GNU Emacs is distributed in the hope that it will be useful, |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
18 ;; GNU General Public License for more details. |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
19 |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
20 ;; You should have received a copy of the GNU General Public License |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
267 | 23 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
24 ;;; Code: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
25 |
267 | 26 (require 'gnus) |
27 | |
28 (defvar gnus-organization-file "/usr/lib/news/organization" | |
29 "*Local news organization file.") | |
30 | |
31 (defvar gnus-post-news-buffer "*post-news*") | |
32 (defvar gnus-winconf-post-news nil) | |
33 | |
34 (autoload 'news-reply-mode "rnewspost") | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
35 (autoload 'timezone-make-date-arpa-standard "timezone") |
267 | 36 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
37 ;;; Post news commands of GNUS Group Mode and Summary Mode |
267 | 38 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
39 (defun gnus-group-post-news () |
267 | 40 "Post an article." |
41 (interactive) | |
42 ;; Save window configuration. | |
43 (setq gnus-winconf-post-news (current-window-configuration)) | |
44 (unwind-protect | |
45 (gnus-post-news) | |
46 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
47 (not (zerop (buffer-size)))) | |
48 ;; Restore last window configuration. | |
49 (set-window-configuration gnus-winconf-post-news))) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
50 ;; We don't want to return to Summary buffer nor Article buffer later. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
51 (if (get-buffer gnus-summary-buffer) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
52 (bury-buffer gnus-summary-buffer)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
53 (if (get-buffer gnus-article-buffer) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
54 (bury-buffer gnus-article-buffer))) |
267 | 55 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
56 (defun gnus-summary-post-news () |
267 | 57 "Post an article." |
58 (interactive) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
59 (gnus-summary-select-article t nil) |
267 | 60 ;; Save window configuration. |
61 (setq gnus-winconf-post-news (current-window-configuration)) | |
62 (unwind-protect | |
63 (progn | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
64 (switch-to-buffer gnus-article-buffer) |
267 | 65 (widen) |
66 (delete-other-windows) | |
67 (gnus-post-news)) | |
68 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
69 (not (zerop (buffer-size)))) | |
70 ;; Restore last window configuration. | |
71 (set-window-configuration gnus-winconf-post-news))) | |
72 ;; We don't want to return to Article buffer later. | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
73 (bury-buffer gnus-article-buffer)) |
267 | 74 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
75 (defun gnus-summary-followup (yank) |
267 | 76 "Post a reply article. |
77 If prefix argument YANK is non-nil, original article is yanked automatically." | |
78 (interactive "P") | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
79 (gnus-summary-select-article t nil) |
267 | 80 ;; Check Followup-To: poster. |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
81 (set-buffer gnus-article-buffer) |
267 | 82 (if (and gnus-use-followup-to |
83 (string-equal "poster" (gnus-fetch-field "followup-to")) | |
84 (or (not (eq gnus-use-followup-to t)) | |
85 (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? ")))) | |
86 ;; Mail to the poster. GNUS is now RFC1036 compliant. | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
87 (gnus-summary-reply yank) |
267 | 88 ;; Save window configuration. |
89 (setq gnus-winconf-post-news (current-window-configuration)) | |
90 (unwind-protect | |
91 (progn | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
92 (switch-to-buffer gnus-article-buffer) |
267 | 93 (widen) |
94 (delete-other-windows) | |
95 (gnus-news-reply yank)) | |
96 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
97 (not (zerop (buffer-size)))) | |
98 ;; Restore last window configuration. | |
99 (set-window-configuration gnus-winconf-post-news))) | |
100 ;; We don't want to return to Article buffer later. | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
101 (bury-buffer gnus-article-buffer))) |
267 | 102 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
103 (defun gnus-summary-followup-with-original () |
267 | 104 "Post a reply article with original article." |
105 (interactive) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
106 (gnus-summary-followup t)) |
267 | 107 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
108 (defun gnus-summary-cancel-article () |
267 | 109 "Cancel an article you posted." |
110 (interactive) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
111 (gnus-summary-select-article t nil) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
112 (gnus-eval-in-buffer-window gnus-article-buffer |
267 | 113 (gnus-cancel-news))) |
114 | |
115 | |
116 ;;; Post a News using NNTP | |
117 | |
118 ;;;###autoload | |
9349
444f99f9695e
(sendnews, postnews): Use defalias.
Richard M. Stallman <rms@gnu.org>
parents:
8134
diff
changeset
|
119 (defalias 'sendnews 'gnus-post-news) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
120 |
267 | 121 ;;;###autoload |
9349
444f99f9695e
(sendnews, postnews): Use defalias.
Richard M. Stallman <rms@gnu.org>
parents:
8134
diff
changeset
|
122 (defalias 'postnews 'gnus-post-news) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
123 |
267 | 124 ;;;###autoload |
125 (defun gnus-post-news () | |
126 "Begin editing a new USENET news article to be posted. | |
127 Type \\[describe-mode] once editing the article to get a list of commands." | |
128 (interactive) | |
129 (if (or (not gnus-novice-user) | |
130 (y-or-n-p "Are you sure you want to post to all of USENET? ")) | |
131 (let ((artbuf (current-buffer)) | |
132 (newsgroups ;Default newsgroup. | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
133 (if (eq major-mode 'gnus-article-mode) gnus-newsgroup-name)) |
267 | 134 (subject nil) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
135 ;; Get default distribution. |
7517
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
136 (distribution (car gnus-local-distributions)) |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
137 (followup-to nil)) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
138 ;; Connect to NNTP server if not connected yet, and get |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
139 ;; several information. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
140 (if (not (gnus-server-opened)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
141 (progn |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
142 (gnus-start-news-server t) ;Confirm server. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
143 (gnus-setup-news))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
144 ;; Get current article information. |
267 | 145 (save-restriction |
146 (and (not (zerop (buffer-size))) | |
147 ;;(equal major-mode 'news-mode) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
148 (equal major-mode 'gnus-article-mode) |
267 | 149 (progn |
150 ;;(news-show-all-headers) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
151 (gnus-article-show-all-headers) |
267 | 152 (narrow-to-region (point-min) |
153 (progn (goto-char (point-min)) | |
154 (search-forward "\n\n") | |
155 (point))))) | |
156 (setq news-reply-yank-from (mail-fetch-field "from")) | |
157 (setq news-reply-yank-message-id (mail-fetch-field "message-id"))) | |
158 (pop-to-buffer gnus-post-news-buffer) | |
159 (news-reply-mode) | |
160 (gnus-overload-functions) | |
161 (if (and (buffer-modified-p) | |
162 (> (buffer-size) 0) | |
163 (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
164 ;; Continue composition. | |
165 ;; Make news-reply-yank-original work on the current article. | |
166 (setq mail-reply-buffer artbuf) | |
167 (erase-buffer) | |
168 (if gnus-interactive-post | |
169 ;; Newsgroups, subject and distribution are asked for. | |
170 ;; Suggested by yuki@flab.fujitsu.junet. | |
171 (progn | |
172 ;; Subscribed newsgroup names are required for | |
173 ;; completing read of newsgroup. | |
174 (or gnus-newsrc-assoc | |
175 (gnus-read-newsrc-file)) | |
176 ;; Which do you like? (UMERIN) | |
177 ;; (setq newsgroups (read-string "Newsgroups: " "general")) | |
178 (or newsgroups ;Use the default newsgroup. | |
7517
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
179 (let (group) |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
180 (while (not |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
181 (string= |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
182 (setq group |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
183 (completing-read "Newsgroup: " |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
184 gnus-newsrc-assoc |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
185 nil 'require-match)) |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
186 "")) |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
187 (or followup-to (setq followup-to group)) |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
188 (if newsgroups |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
189 (setq newsgroups (concat newsgroups "," group)) |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
190 (setq newsgroups group))))) |
267 | 191 (setq subject (read-string "Subject: ")) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
192 ;; Choose a distribution from gnus-distribution-list. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
193 ;; completing-read should not be used with |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
194 ;; 'require-match functionality in order to allow use |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
195 ;; of unknow distribution. |
5295
666b3dcc9905
(gnus-post-news): Call gnus-read-distributions-file.
Richard M. Stallman <rms@gnu.org>
parents:
5111
diff
changeset
|
196 (gnus-read-distributions-file) |
267 | 197 (setq distribution |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
198 (if (consp gnus-distribution-list) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
199 (completing-read "Distribution: " |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
200 gnus-distribution-list |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
201 nil nil ;Never 'require-match |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
202 distribution ;Default distribution. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
203 ) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
204 (read-string "Distribution: "))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
205 ;; Empty string is okay. |
267 | 206 ;;(if (string-equal distribution "") |
207 ;; (setq distribution nil)) | |
208 )) | |
209 (news-setup () subject () newsgroups artbuf) | |
210 ;; Make sure the article is posted by GNUS. | |
211 ;;(mail-position-on-field "Posting-Software") | |
212 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") | |
213 ;; Insert Distribution: field. | |
214 ;; Suggested by ichikawa@flab.fujitsu.junet. | |
215 (mail-position-on-field "Distribution") | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
216 (insert (or distribution "")) |
7517
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
217 ;; Add Followup-To header |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
218 (if followup-to |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
219 (progn |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
220 (mail-position-on-field "Followup-To") |
c9b4184540f5
(gnus-post-news): Handle followup-to field.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
221 (insert followup-to))) |
267 | 222 ;; Handle author copy using FCC field. |
223 (if gnus-author-copy | |
224 (progn | |
225 (mail-position-on-field "FCC") | |
226 (insert gnus-author-copy))) | |
227 (if gnus-interactive-post | |
228 ;; All fields are filled in. | |
229 (goto-char (point-max)) | |
230 ;; Move point to Newsgroup: field. | |
231 (goto-char (point-min)) | |
232 (end-of-line)) | |
233 )) | |
234 (message ""))) | |
235 | |
236 (defun gnus-news-reply (&optional yank) | |
237 "Compose and post a reply (aka a followup) to the current article on USENET. | |
238 While composing the followup, use \\[news-reply-yank-original] to yank the | |
239 original message into it." | |
240 (interactive) | |
241 (if (or (not gnus-novice-user) | |
242 (y-or-n-p "Are you sure you want to followup to all of USENET? ")) | |
243 (let (from cc subject date to followup-to newsgroups message-of | |
244 references distribution message-id | |
245 (artbuf (current-buffer))) | |
246 (save-restriction | |
247 (and (not (zerop (buffer-size))) | |
248 ;;(equal major-mode 'news-mode) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
249 (equal major-mode 'gnus-article-mode) |
267 | 250 (progn |
251 ;; (news-show-all-headers) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
252 (gnus-article-show-all-headers) |
267 | 253 (narrow-to-region (point-min) |
254 (progn (goto-char (point-min)) | |
255 (search-forward "\n\n") | |
256 (point))))) | |
257 (setq from (mail-fetch-field "from")) | |
5397
1209d8bbffd3
(gnus-news-reply): Handle reply-to field.
Richard M. Stallman <rms@gnu.org>
parents:
5295
diff
changeset
|
258 ;; Get reply-to working corrrectly for gnus-auto-mail-to-author (jpm) |
1209d8bbffd3
(gnus-news-reply): Handle reply-to field.
Richard M. Stallman <rms@gnu.org>
parents:
5295
diff
changeset
|
259 (setq reply-to (mail-fetch-field "reply-to")) |
267 | 260 (setq news-reply-yank-from from) |
261 (setq subject (mail-fetch-field "subject")) | |
262 (setq date (mail-fetch-field "date")) | |
263 (setq followup-to (mail-fetch-field "followup-to")) | |
264 ;; Ignore Followup-To: poster. | |
265 (if (or (null gnus-use-followup-to) ;Ignore followup-to: field. | |
266 (string-equal "" followup-to) ;Bogus header. | |
267 (string-equal "poster" followup-to)) | |
268 (setq followup-to nil)) | |
269 (setq newsgroups (or followup-to (mail-fetch-field "newsgroups"))) | |
270 (setq references (mail-fetch-field "references")) | |
271 (setq distribution (mail-fetch-field "distribution")) | |
272 (setq message-id (mail-fetch-field "message-id")) | |
273 (setq news-reply-yank-message-id message-id)) | |
274 (pop-to-buffer gnus-post-news-buffer) | |
275 (news-reply-mode) | |
276 (gnus-overload-functions) | |
277 (if (and (buffer-modified-p) | |
278 (> (buffer-size) 0) | |
279 (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
280 ;; Continue composition. | |
281 ;; Make news-reply-yank-original work on current article. | |
282 (setq mail-reply-buffer artbuf) | |
283 (erase-buffer) | |
284 (and subject | |
285 (setq subject | |
286 (concat "Re: " (gnus-simplify-subject subject 're-only)))) | |
287 (and from | |
288 (progn | |
289 (let ((stop-pos | |
290 (string-match " *at \\| *@ \\| *(\\| *<" from))) | |
291 (setq message-of | |
292 (concat | |
293 (if stop-pos (substring from 0 stop-pos) from) | |
294 "'s message of " | |
295 date))))) | |
296 (news-setup nil subject message-of newsgroups artbuf) | |
297 (if followup-to | |
298 (progn (news-reply-followup-to) | |
299 (insert followup-to))) | |
300 ;; Fold long references line to follow RFC1036. | |
301 (mail-position-on-field "References") | |
302 (let ((begin (point)) | |
303 (fill-column 79) | |
304 (fill-prefix "\t")) | |
305 (if references | |
306 (insert references)) | |
307 (if (and references message-id) | |
308 (insert " ")) | |
309 (if message-id | |
310 (insert message-id)) | |
311 ;; The region must end with a newline to fill the region | |
312 ;; without inserting extra newline. | |
313 (fill-region-as-paragraph begin (1+ (point)))) | |
314 ;; Make sure the article is posted by GNUS. | |
315 ;;(mail-position-on-field "Posting-Software") | |
316 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") | |
317 ;; Distribution must be the same as original article. | |
318 (mail-position-on-field "Distribution") | |
319 (insert (or distribution "")) | |
320 ;; Handle author copy using FCC field. | |
321 (if gnus-author-copy | |
322 (progn | |
323 (mail-position-on-field "FCC") | |
324 (insert gnus-author-copy))) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
325 ;; Insert To: FROM field, which is expected to mail the |
5397
1209d8bbffd3
(gnus-news-reply): Handle reply-to field.
Richard M. Stallman <rms@gnu.org>
parents:
5295
diff
changeset
|
326 ;; message to the author of the article too. Use Reply-To |
1209d8bbffd3
(gnus-news-reply): Handle reply-to field.
Richard M. Stallman <rms@gnu.org>
parents:
5295
diff
changeset
|
327 ;; field like gnus-mail-reply-using-m* (jpm). |
1209d8bbffd3
(gnus-news-reply): Handle reply-to field.
Richard M. Stallman <rms@gnu.org>
parents:
5295
diff
changeset
|
328 (if (and gnus-auto-mail-to-author (or reply-to from)) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
329 (progn |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
330 (goto-char (point-min)) |
5397
1209d8bbffd3
(gnus-news-reply): Handle reply-to field.
Richard M. Stallman <rms@gnu.org>
parents:
5295
diff
changeset
|
331 (insert "To: " (or reply-to from) "\n"))) |
267 | 332 (goto-char (point-max))) |
333 ;; Yank original article automatically. | |
334 (if yank | |
335 (let ((last (point))) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
336 ;;(goto-char (point-max)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
337 ;; Insert at current point. |
267 | 338 (news-reply-yank-original nil) |
339 (goto-char last))) | |
340 ) | |
341 (message ""))) | |
342 | |
343 (defun gnus-inews-news () | |
344 "Send a news message." | |
345 (interactive) | |
346 (let* ((case-fold-search nil) | |
347 (server-running (gnus-server-opened))) | |
348 (save-excursion | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
349 ;; Connect to default NNTP server if necessary. |
267 | 350 ;; Suggested by yuki@flab.fujitsu.junet. |
351 (gnus-start-news-server) ;Use default server. | |
352 ;; NNTP server must be opened before current buffer is modified. | |
353 (widen) | |
354 (goto-char (point-min)) | |
355 (run-hooks 'news-inews-hook) | |
8134
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
356 (save-restriction |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
357 (narrow-to-region |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
358 (point-min) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
359 (progn |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
360 (goto-char (point-min)) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
361 (search-forward (concat "\n" mail-header-separator "\n")) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
362 (point))) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
363 |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
364 ;; Correct newsgroups field: change sequence of spaces to comma and |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
365 ;; eliminate spaces around commas. Eliminate imbedded line breaks. |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
366 (goto-char (point-min)) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
367 (if (search-forward-regexp "^Newsgroups: +" nil t) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
368 (save-restriction |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
369 (narrow-to-region |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
370 (point) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
371 (if (re-search-forward "^[^ \t]" nil 'end) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
372 (match-beginning 0) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
373 (point-max))) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
374 (goto-char (point-min)) |
8134
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
375 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
376 (goto-char (point-min)) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
377 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",") |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
378 )) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
379 |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
380 ;; Mail the message too if To: or Cc: exists. |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
381 (if (or (mail-fetch-field "to" nil t) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
382 (mail-fetch-field "cc" nil t)) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
383 (if gnus-mail-send-method |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
384 (progn |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
385 (message "Sending via mail...") |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
386 (widen) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
387 (funcall gnus-mail-send-method) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
388 (message "Sending via mail... done")) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
389 (ding) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
390 (message "No mailer defined. To: and/or Cc: fields ignored.") |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
391 (sit-for 1)))) |
7b7bb255393e
(gnus-inews-news): Allow newsgroups to be separated
Richard M. Stallman <rms@gnu.org>
parents:
8112
diff
changeset
|
392 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
393 ;; Send to NNTP server. |
267 | 394 (message "Posting to USENET...") |
395 (if (gnus-inews-article) | |
396 (message "Posting to USENET... done") | |
397 ;; We cannot signal an error. | |
398 (ding) (message "Article rejected: %s" (gnus-status-message))) | |
399 (set-buffer-modified-p nil)) | |
400 ;; If NNTP server is opened by gnus-inews-news, close it by myself. | |
401 (or server-running | |
402 (gnus-close-server)) | |
403 (and (fboundp 'bury-buffer) (bury-buffer)) | |
404 ;; Restore last window configuration. | |
405 (and gnus-winconf-post-news | |
406 (set-window-configuration gnus-winconf-post-news)) | |
407 (setq gnus-winconf-post-news nil) | |
408 )) | |
409 | |
410 (defun gnus-cancel-news () | |
411 "Cancel an article you posted." | |
412 (interactive) | |
413 (if (yes-or-no-p "Do you really want to cancel this article? ") | |
414 (let ((from nil) | |
415 (newsgroups nil) | |
416 (message-id nil) | |
417 (distribution nil)) | |
418 (save-excursion | |
419 ;; Get header info. from original article. | |
420 (save-restriction | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
421 (gnus-article-show-all-headers) |
267 | 422 (goto-char (point-min)) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
423 (search-forward "\n\n" nil 'move) |
267 | 424 (narrow-to-region (point-min) (point)) |
425 (setq from (mail-fetch-field "from")) | |
426 (setq newsgroups (mail-fetch-field "newsgroups")) | |
427 (setq message-id (mail-fetch-field "message-id")) | |
428 (setq distribution (mail-fetch-field "distribution"))) | |
429 ;; Verify if the article is absolutely user's by comparing | |
430 ;; user id with value of its From: field. | |
431 (if (not | |
432 (string-equal | |
433 (downcase (mail-strip-quoted-names from)) | |
434 (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) | |
435 (progn | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
436 (ding) (message "This article is not yours.")) |
267 | 437 ;; Make control article. |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
438 (set-buffer (get-buffer-create " *GNUS-canceling*")) |
12166
4ef1d241407c
(gnus-cancel-news): Use `buffer-disable-undo'.
Karl Heuer <kwzh@gnu.org>
parents:
9349
diff
changeset
|
439 (buffer-disable-undo (current-buffer)) |
267 | 440 (erase-buffer) |
441 (insert "Newsgroups: " newsgroups "\n" | |
442 "Subject: cancel " message-id "\n" | |
443 "Control: cancel " message-id "\n" | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
444 ;; We should not use the first value of |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
445 ;; `gnus-distribution-list' as default value, |
267 | 446 ;; because distribution must be as same as original |
447 ;; article. | |
448 "Distribution: " (or distribution "") "\n" | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
449 mail-header-separator "\n" |
267 | 450 ) |
451 ;; Send the control article to NNTP server. | |
452 (message "Canceling your article...") | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
453 (if (gnus-inews-article) |
267 | 454 (message "Canceling your article... done") |
455 (ding) (message "Failed to cancel your article")) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
456 ;; Kill the article buffer. |
267 | 457 (kill-buffer (current-buffer)) |
458 ))) | |
459 )) | |
460 | |
461 | |
462 ;;; Lowlevel inews interface | |
463 | |
464 (defun gnus-inews-article () | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
465 "Post an article in current buffer using NNTP protocol." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
466 (let ((artbuf (current-buffer)) |
267 | 467 (tmpbuf (get-buffer-create " *GNUS-posting*"))) |
468 (save-excursion | |
469 (set-buffer tmpbuf) | |
12166
4ef1d241407c
(gnus-cancel-news): Use `buffer-disable-undo'.
Karl Heuer <kwzh@gnu.org>
parents:
9349
diff
changeset
|
470 (buffer-disable-undo (current-buffer)) |
267 | 471 (erase-buffer) |
472 (insert-buffer-substring artbuf) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
473 ;; Remove the header separator. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
474 (goto-char (point-min)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
475 (search-forward (concat "\n" mail-header-separator "\n")) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
476 (replace-match "\n\n") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
477 (goto-char (point-max)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
478 ;; require a newline at the end for inews to append .signature to |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
479 (or (= (preceding-char) ?\n) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
480 (insert ?\n)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
481 ;; This hook may insert a signature. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
482 (run-hooks 'gnus-prepare-article-hook) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
483 ;; Prepare article headers. All message body such as signature |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
484 ;; must be inserted before Lines: field is prepared. |
267 | 485 (save-restriction |
486 (goto-char (point-min)) | |
487 (search-forward "\n\n") | |
488 (narrow-to-region (point-min) (point)) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
489 (gnus-inews-insert-headers)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
490 ;; Run final inews hooks. This hook may do FCC. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
491 ;; The article must be saved before being posted because |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
492 ;; `gnus-request-post' modifies the buffer. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
493 (run-hooks 'gnus-inews-article-hook) |
267 | 494 ;; Post an article to NNTP server. |
495 ;; Return NIL if post failed. | |
496 (prog1 | |
497 (gnus-request-post) | |
498 (kill-buffer (current-buffer))) | |
499 ))) | |
500 | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
501 (defun gnus-inews-insert-headers () |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
502 "Prepare article headers. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
503 Fields already prepared in the buffer are not modified. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
504 Fields in gnus-required-headers will be generated." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
505 (save-excursion |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
506 (let ((date (gnus-inews-date)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
507 (message-id (gnus-inews-message-id)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
508 (organization (gnus-inews-organization))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
509 (goto-char (point-min)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
510 (or (mail-fetch-field "path") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
511 (and (memq 'Path gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
512 (insert "Path: " (gnus-inews-path) "\n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
513 (or (mail-fetch-field "from") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
514 (and (memq 'From gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
515 (insert "From: " (gnus-inews-user-name) "\n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
516 ;; If there is no subject, make Subject: field. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
517 (or (mail-fetch-field "subject") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
518 (and (memq 'Subject gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
519 (insert "Subject: \n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
520 ;; If there is no newsgroups, make Newsgroups: field. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
521 (or (mail-fetch-field "newsgroups") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
522 (and (memq 'Newsgroups gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
523 (insert "Newsgroups: \n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
524 (or (mail-fetch-field "message-id") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
525 (and message-id |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
526 (memq 'Message-ID gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
527 (insert "Message-ID: " message-id "\n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
528 (or (mail-fetch-field "date") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
529 (and date |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
530 (memq 'Date gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
531 (insert "Date: " date "\n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
532 ;; Optional fields in RFC977 and RFC1036 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
533 (or (mail-fetch-field "organization") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
534 (and organization |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
535 (memq 'Organization gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
536 (let ((begin (point)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
537 (fill-column 79) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
538 (fill-prefix "\t")) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
539 (insert "Organization: " organization "\n") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
540 (fill-region-as-paragraph begin (point))))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
541 (or (mail-fetch-field "distribution") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
542 (and (memq 'Distribution gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
543 (insert "Distribution: \n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
544 (or (mail-fetch-field "lines") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
545 (and (memq 'Lines gnus-required-headers) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
546 (insert "Lines: " (gnus-inews-lines) "\n"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
547 ))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
548 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
549 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
550 ;; Utility functions. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
551 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
552 (defun gnus-inews-insert-signature () |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
553 "Insert signature file in current article buffer. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
554 If there is a file named .signature-DISTRIBUTION, it is used instead |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
555 of usual .signature when the distribution of the article is |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
556 DISTRIBUTION. Set the variable to nil to prevent appending the |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
557 signature file automatically. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
558 Signature file is specified by the variable gnus-signature-file." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
559 (save-excursion |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
560 (save-restriction |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
561 ;; Change signature file by distribution. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
562 ;; Suggested by hyoko@flab.fujitsu.co.jp. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
563 (let ((signature |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
564 (if gnus-signature-file |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
565 (expand-file-name gnus-signature-file nil))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
566 (distribution nil)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
567 (goto-char (point-min)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
568 (search-forward "\n\n") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
569 (narrow-to-region (point-min) (point)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
570 (setq distribution (mail-fetch-field "distribution")) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
571 (widen) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
572 (if signature |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
573 (progn |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
574 (if (file-exists-p (concat signature "-" distribution)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
575 (setq signature (concat signature "-" distribution))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
576 ;; Insert signature. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
577 (if (file-exists-p signature) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
578 (progn |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
579 (goto-char (point-max)) |
12166
4ef1d241407c
(gnus-cancel-news): Use `buffer-disable-undo'.
Karl Heuer <kwzh@gnu.org>
parents:
9349
diff
changeset
|
580 (insert "-- \n") |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
581 (insert-file-contents signature))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
582 )))))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
583 |
267 | 584 (defun gnus-inews-do-fcc () |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
585 "Process FCC: fields in current article buffer. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
586 Unless the first character of the field is `|', the article is saved |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
587 to the specified file using the function specified by the variable |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
588 gnus-author-copy-saver. The default function rmail-output saves in |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
589 Unix mailbox format. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
590 If the first character is `|', the contents of the article is send to |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
591 a program specified by the rest of the value." |
267 | 592 (let ((fcc-list nil) |
593 (fcc-file nil) | |
594 (case-fold-search t)) ;Should ignore case. | |
595 (save-excursion | |
596 (save-restriction | |
597 (goto-char (point-min)) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
598 (search-forward "\n\n") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
599 (narrow-to-region (point-min) (point)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
600 (goto-char (point-min)) |
267 | 601 (while (re-search-forward "^FCC:[ \t]*" nil t) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
602 (setq fcc-list |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
603 (cons (buffer-substring |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
604 (point) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
605 (progn |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
606 (end-of-line) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
607 (skip-chars-backward " \t") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
608 (point))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
609 fcc-list)) |
267 | 610 (delete-region (match-beginning 0) |
611 (progn (forward-line 1) (point)))) | |
612 ;; Process FCC operations. | |
613 (widen) | |
614 (while fcc-list | |
615 (setq fcc-file (car fcc-list)) | |
616 (setq fcc-list (cdr fcc-list)) | |
617 (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) | |
618 (let ((program (substring fcc-file | |
619 (match-beginning 1) (match-end 1)))) | |
620 ;; Suggested by yuki@flab.fujitsu.junet. | |
621 ;; Send article to named program. | |
622 (call-process-region (point-min) (point-max) shell-file-name | |
623 nil nil nil "-c" program) | |
624 )) | |
625 (t | |
626 ;; Suggested by hyoko@flab.fujitsu.junet. | |
627 ;; Save article in Unix mail format by default. | |
5111
d9fb93d75f74
(gnus-inews-do-fcc): If gnus-author-copy-saver
Richard M. Stallman <rms@gnu.org>
parents:
5110
diff
changeset
|
628 (if (and gnus-author-copy-saver |
d9fb93d75f74
(gnus-inews-do-fcc): If gnus-author-copy-saver
Richard M. Stallman <rms@gnu.org>
parents:
5110
diff
changeset
|
629 (not (eq gnus-author-copy-saver 'rmail-output))) |
5110
c002b7320691
(gnus-inews-do-fcc): Use gnus-output-to-rmail
Richard M. Stallman <rms@gnu.org>
parents:
4172
diff
changeset
|
630 (funcall gnus-author-copy-saver fcc-file) |
13119
7305dbef1911
(gnus-inews-do-fcc): Use mail-file-babyl-p.
Richard M. Stallman <rms@gnu.org>
parents:
12166
diff
changeset
|
631 (if (and (file-readable-p fcc-file) |
7305dbef1911
(gnus-inews-do-fcc): Use mail-file-babyl-p.
Richard M. Stallman <rms@gnu.org>
parents:
12166
diff
changeset
|
632 (mail-file-babyl-p fcc-file)) |
5110
c002b7320691
(gnus-inews-do-fcc): Use gnus-output-to-rmail
Richard M. Stallman <rms@gnu.org>
parents:
4172
diff
changeset
|
633 (gnus-output-to-rmail fcc-file) |
c002b7320691
(gnus-inews-do-fcc): Use gnus-output-to-rmail
Richard M. Stallman <rms@gnu.org>
parents:
4172
diff
changeset
|
634 (rmail-output fcc-file 1 t t))) |
267 | 635 )) |
636 ) | |
637 )) | |
638 )) | |
639 | |
640 (defun gnus-inews-path () | |
641 "Return uucp path." | |
642 (let ((login-name (gnus-inews-login-name))) | |
643 (cond ((null gnus-use-generic-path) | |
644 (concat gnus-nntp-server "!" login-name)) | |
645 ((stringp gnus-use-generic-path) | |
646 ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. | |
647 (concat gnus-use-generic-path "!" login-name)) | |
648 (t login-name)) | |
649 )) | |
650 | |
651 (defun gnus-inews-user-name () | |
8070
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
652 "Return user's network address as `NAME@DOMAIN (FULLNAME)'." |
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
653 (let ((full-name (gnus-inews-full-name))) |
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
654 (concat (if (or gnus-user-login-name gnus-use-generic-from |
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
655 gnus-local-domain (getenv "DOMAINNAME")) |
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
656 (concat (gnus-inews-login-name) "@" |
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
657 (gnus-inews-domain-name gnus-use-generic-from)) |
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
658 user-mail-address) |
267 | 659 ;; User's full name. |
660 (cond ((string-equal full-name "") "") | |
661 ((string-equal full-name "&") ;Unix hack. | |
662 (concat " (" login-name ")")) | |
663 (t | |
664 (concat " (" full-name ")"))) | |
665 ))) | |
666 | |
667 (defun gnus-inews-login-name () | |
668 "Return user login name. | |
5910
287191542bb3
(gnus-inews-login-name): Remove unnecessary (getenv "LOGNAME") and (getenv
Karl Heuer <kwzh@gnu.org>
parents:
5397
diff
changeset
|
669 Got from the variable `gnus-user-login-name' and the function |
287191542bb3
(gnus-inews-login-name): Remove unnecessary (getenv "LOGNAME") and (getenv
Karl Heuer <kwzh@gnu.org>
parents:
5397
diff
changeset
|
670 `user-login-name'." |
287191542bb3
(gnus-inews-login-name): Remove unnecessary (getenv "LOGNAME") and (getenv
Karl Heuer <kwzh@gnu.org>
parents:
5397
diff
changeset
|
671 (or gnus-user-login-name (user-login-name))) |
267 | 672 |
673 (defun gnus-inews-full-name () | |
674 "Return user full name. | |
8070
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
675 Got from the variable `gnus-user-full-name', the environment variable |
6f2b80526abc
(gnus-inews-user-name, gnus-inews-domain-name):
Richard M. Stallman <rms@gnu.org>
parents:
7517
diff
changeset
|
676 NAME, and the function `user-full-name'." |
267 | 677 (or gnus-user-full-name |
678 (getenv "NAME") (user-full-name))) | |
679 | |
680 (defun gnus-inews-domain-name (&optional genericfrom) | |
681 "Return user's domain name. | |
682 If optional argument GENERICFROM is a string, use it as the domain | |
683 name; if it is non-nil, strip of local host name from the domain name. | |
684 If the function `system-name' returns full internet name and the | |
685 domain is undefined, the domain name is got from it." | |
8112
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
686 (and (null gnus-local-domain) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
687 (boundp 'gnus-your-domain) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
688 (setq gnus-local-domain gnus-your-domain)) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
689 (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
690 (let ((domain (or (if (stringp genericfrom) genericfrom) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
691 (getenv "DOMAINNAME") |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
692 gnus-local-domain |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
693 ;; Function `system-name' may return full internet name. |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
694 ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>. |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
695 (if (string-match "\\." (system-name)) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
696 (substring (system-name) (match-end 0))) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
697 (read-string "Domain name (no host): "))) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
698 (host (or (if (string-match "\\." (system-name)) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
699 (substring (system-name) 0 (match-beginning 0))) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
700 (system-name)))) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
701 (if (string-equal "." (substring domain 0 1)) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
702 (setq domain (substring domain 1))) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
703 ;; Support GENERICFROM as same as standard Bnews system. |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
704 ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
705 (cond ((null genericfrom) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
706 (concat host "." domain)) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
707 ;;((stringp genericfrom) genericfrom) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
708 (t domain))) |
63ed4f3eb8d1
(gnus-inews-domain-name): Once again test gnus-your-domain.
Richard M. Stallman <rms@gnu.org>
parents:
8100
diff
changeset
|
709 (substring user-mail-address (1+ (string-match "@" user-mail-address))))) |
267 | 710 |
711 (defun gnus-inews-message-id () | |
712 "Generate unique Message-ID for user." | |
713 ;; Message-ID should not contain a slash and should be terminated by | |
714 ;; a number. I don't know the reason why it is so. | |
715 (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">")) | |
716 | |
717 (defun gnus-inews-unique-id () | |
718 "Generate unique ID from user name and current time." | |
719 (let ((date (current-time-string)) | |
720 (name (gnus-inews-login-name))) | |
721 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)" | |
722 date) | |
723 (concat (upcase name) "." | |
724 (substring date (match-beginning 6) (match-end 6)) ;Year | |
725 (substring date (match-beginning 1) (match-end 1)) ;Month | |
726 (substring date (match-beginning 2) (match-end 2)) ;Day | |
727 (substring date (match-beginning 3) (match-end 3)) ;Hour | |
728 (substring date (match-beginning 4) (match-end 4)) ;Minute | |
729 (substring date (match-beginning 5) (match-end 5)) ;Second | |
730 ) | |
731 (error "Cannot understand current-time-string: %s." date)) | |
732 )) | |
733 | |
3495
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
734 (defun gnus-current-time-zone (time) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
735 "The local time zone in effect at TIME, or nil if not known." |
4172
33ace0ef7c4d
(gnus-current-time-zone): Fix typo.
Richard M. Stallman <rms@gnu.org>
parents:
3506
diff
changeset
|
736 (let ((z (and (fboundp 'current-time-zone) (current-time-zone time)))) |
3495
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
737 (if (and z (car z)) z gnus-local-timezone))) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
738 |
267 | 739 (defun gnus-inews-date () |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
740 "Date string of today. |
3495
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
741 If `current-time-zone' works, or if `gnus-local-timezone' is set correctly, |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
742 this yields a date that conforms to RFC 822. Otherwise a buggy date will |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
743 be generated; this might work with some older news servers." |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
744 (let* ((now (and (fboundp 'current-time) (current-time))) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
745 (zone (gnus-current-time-zone now))) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
746 (if zone |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
747 (gnus-inews-valid-date now zone) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
748 ;; No timezone info. |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
749 (gnus-inews-buggy-date now)))) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
750 |
3495
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
751 (defun gnus-inews-valid-date (&optional time zone) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
752 "A date string that represents TIME and conforms to the Usenet standard. |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
753 TIME is optional and defaults to the current time. |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
754 Some older versions of Emacs always act as if TIME is nil. |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
755 The optional argument ZONE specifies the local time zone (default GMT)." |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
756 (timezone-make-date-arpa-standard |
3495
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
757 (if (fboundp 'current-time) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
758 (current-time-string time) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
759 (current-time-string)) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
760 zone "GMT")) |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
761 |
3495
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
762 (defun gnus-inews-buggy-date (&optional time) |
3506
4114a1d07f7c
(gnus-inews-buggy-date): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
3495
diff
changeset
|
763 "A buggy date string that represents TIME. |
3495
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
764 TIME is optional and defaults to the current time. |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
765 Some older versions of Emacs always act as if TIME is nil." |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
766 (let ((date (if (fboundp 'current-time) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
767 (current-time-string time) |
ba3e81f00939
(gnus-current-time-zone): New function, which tries
Richard M. Stallman <rms@gnu.org>
parents:
2843
diff
changeset
|
768 (current-time-string)))) |
267 | 769 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" |
770 date) | |
771 (concat (substring date (match-beginning 2) (match-end 2)) ;Day | |
772 " " | |
773 (substring date (match-beginning 1) (match-end 1)) ;Month | |
774 " " | |
775 (substring date (match-beginning 4) (match-end 4)) ;Year | |
776 " " | |
777 (substring date (match-beginning 3) (match-end 3))) ;Time | |
778 (error "Cannot understand current-time-string: %s." date)) | |
779 )) | |
780 | |
781 (defun gnus-inews-organization () | |
782 "Return user's organization. | |
783 The ORGANIZATION environment variable is used if defined. | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
784 If not, the variable gnus-local-organization is used instead. |
267 | 785 If the value begins with a slash, it is taken as the name of a file |
786 containing the organization." | |
787 ;; The organization must be got in this order since the ORGANIZATION | |
788 ;; environment variable is intended for user specific while | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
789 ;; gnus-local-organization is for machine or organization specific. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
790 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
791 ;; Note: compatibility hack. This will be removed in the next version. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
792 (and (null gnus-local-organization) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
793 (boundp 'gnus-your-organization) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
794 (setq gnus-local-organization gnus-your-organization)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
795 ;; End of compatibility hack. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
796 (let* ((private-file (expand-file-name "~/.organization" nil)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
797 (organization (or (getenv "ORGANIZATION") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
798 gnus-local-organization |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
799 private-file))) |
267 | 800 (and (stringp organization) |
4172
33ace0ef7c4d
(gnus-current-time-zone): Fix typo.
Richard M. Stallman <rms@gnu.org>
parents:
3506
diff
changeset
|
801 (> (length organization) 0) |
267 | 802 (string-equal (substring organization 0 1) "/") |
803 ;; Get it from the user and system file. | |
804 ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath). | |
805 (let ((dist (mail-fetch-field "distribution"))) | |
806 (setq organization | |
807 (cond ((file-exists-p (concat organization "-" dist)) | |
808 (concat organization "-" dist)) | |
809 ((file-exists-p organization) organization) | |
810 ((file-exists-p gnus-organization-file) | |
811 gnus-organization-file) | |
812 (t organization))) | |
813 )) | |
814 (cond ((not (stringp organization)) nil) | |
815 ((and (string-equal (substring organization 0 1) "/") | |
816 (file-exists-p organization)) | |
817 ;; If the first character is `/', assume it is the name of | |
818 ;; a file containing the organization. | |
819 (save-excursion | |
820 (let ((tmpbuf (get-buffer-create " *GNUS organization*"))) | |
821 (set-buffer tmpbuf) | |
822 (erase-buffer) | |
823 (insert-file-contents organization) | |
824 (prog1 (buffer-string) | |
825 (kill-buffer tmpbuf)) | |
826 ))) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
827 ((string-equal organization private-file) nil) ;No such file |
267 | 828 (t organization)) |
829 )) | |
584 | 830 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
831 (defun gnus-inews-lines () |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
832 "Count the number of lines and return numeric string." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
833 (save-excursion |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
834 (save-restriction |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
835 (widen) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
836 (goto-char (point-min)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
837 (search-forward "\n\n" nil 'move) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
838 (int-to-string (count-lines (point) (point-max)))))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2601
diff
changeset
|
839 |
584 | 840 (provide 'gnuspost) |
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
841 |
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
842 ;;; gnuspost.el ends here |