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