*** empty log message ***
[bpt/emacs.git] / lisp / gnuspost.el
CommitLineData
1a06eabd
ER
1;;; gnuspost.el --- post news commands for GNUS newsreader
2
e5167999
ER
3;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
4;; Last-Modified: 10 Jun 1992
fd7fa35a 5;; Keywords: news
e5167999 6
2f790b20
JB
7;; $Header: gnuspost.el,v 1.2 90/03/23 13:25:16 umerin Locked $
8
e5167999
ER
9;; Copyright (C) 1989, 1990 Free Software Foundation, Inc.
10
2f790b20
JB
11;; This file is part of GNU Emacs.
12
08b684de
RS
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
e5167999 15;; the Free Software Foundation; either version 2, or (at your option)
08b684de
RS
16;; any later version.
17
2f790b20 18;; GNU Emacs is distributed in the hope that it will be useful,
08b684de
RS
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING. If not, write to
25;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
2f790b20 26
e5167999
ER
27;;; Code:
28
2f790b20
JB
29(require 'gnus)
30
31(defvar gnus-organization-file "/usr/lib/news/organization"
32 "*Local news organization file.")
33
34(defvar gnus-post-news-buffer "*post-news*")
35(defvar gnus-winconf-post-news nil)
36
37(autoload 'news-reply-mode "rnewspost")
38
39;;; Post news commands of GNUS Group Mode and Subject Mode
40
41(defun gnus-Group-post-news ()
42 "Post an article."
43 (interactive)
44 ;; Save window configuration.
45 (setq gnus-winconf-post-news (current-window-configuration))
46 (unwind-protect
47 (gnus-post-news)
48 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
49 (not (zerop (buffer-size))))
50 ;; Restore last window configuration.
51 (set-window-configuration gnus-winconf-post-news)))
52 ;; We don't want to return to Subject buffer nor Article buffer later.
53 (if (get-buffer gnus-Subject-buffer)
54 (bury-buffer gnus-Subject-buffer))
55 (if (get-buffer gnus-Article-buffer)
56 (bury-buffer gnus-Article-buffer)))
57
58(defun gnus-Subject-post-news ()
59 "Post an article."
60 (interactive)
61 (gnus-Subject-select-article t nil)
62 ;; Save window configuration.
63 (setq gnus-winconf-post-news (current-window-configuration))
64 (unwind-protect
65 (progn
66 (switch-to-buffer gnus-Article-buffer)
67 (widen)
68 (delete-other-windows)
69 (gnus-post-news))
70 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
71 (not (zerop (buffer-size))))
72 ;; Restore last window configuration.
73 (set-window-configuration gnus-winconf-post-news)))
74 ;; We don't want to return to Article buffer later.
75 (bury-buffer gnus-Article-buffer))
76
77(defun gnus-Subject-post-reply (yank)
78 "Post a reply article.
79If prefix argument YANK is non-nil, original article is yanked automatically."
80 (interactive "P")
81 (gnus-Subject-select-article t nil)
82 ;; Check Followup-To: poster.
83 (set-buffer gnus-Article-buffer)
84 (if (and gnus-use-followup-to
85 (string-equal "poster" (gnus-fetch-field "followup-to"))
86 (or (not (eq gnus-use-followup-to t))
87 (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? "))))
88 ;; Mail to the poster. GNUS is now RFC1036 compliant.
89 (gnus-Subject-mail-reply yank)
90 ;; Save window configuration.
91 (setq gnus-winconf-post-news (current-window-configuration))
92 (unwind-protect
93 (progn
94 (switch-to-buffer gnus-Article-buffer)
95 (widen)
96 (delete-other-windows)
97 (gnus-news-reply yank))
98 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
99 (not (zerop (buffer-size))))
100 ;; Restore last window configuration.
101 (set-window-configuration gnus-winconf-post-news)))
102 ;; We don't want to return to Article buffer later.
103 (bury-buffer gnus-Article-buffer)))
104
105(defun gnus-Subject-post-reply-with-original ()
106 "Post a reply article with original article."
107 (interactive)
108 (gnus-Subject-post-reply t))
109
110(defun gnus-Subject-cancel-article ()
111 "Cancel an article you posted."
112 (interactive)
113 (gnus-Subject-select-article t nil)
114 (gnus-eval-in-buffer-window gnus-Article-buffer
115 (gnus-cancel-news)))
116
117\f
118;;; Post a News using NNTP
119
120;;;###autoload
121(fset 'sendnews 'gnus-post-news)
122;;;###autoload
123(fset 'postnews 'gnus-post-news)
124;;;###autoload
125(defun gnus-post-news ()
126 "Begin editing a new USENET news article to be posted.
127Type \\[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.
133 (if (eq major-mode 'gnus-Article-mode) gnus-newsgroup-name))
134 (subject nil)
135 (distribution nil))
136 (save-restriction
137 (and (not (zerop (buffer-size)))
138 ;;(equal major-mode 'news-mode)
139 (equal major-mode 'gnus-Article-mode)
140 (progn
141 ;;(news-show-all-headers)
142 (gnus-Article-show-all-headers)
143 (narrow-to-region (point-min)
144 (progn (goto-char (point-min))
145 (search-forward "\n\n")
146 (point)))))
147 (setq news-reply-yank-from (mail-fetch-field "from"))
148 (setq news-reply-yank-message-id (mail-fetch-field "message-id")))
149 (pop-to-buffer gnus-post-news-buffer)
150 (news-reply-mode)
151 (gnus-overload-functions)
152 (if (and (buffer-modified-p)
153 (> (buffer-size) 0)
154 (not (y-or-n-p "Unsent article being composed; erase it? ")))
155 ;; Continue composition.
156 ;; Make news-reply-yank-original work on the current article.
157 (setq mail-reply-buffer artbuf)
158 (erase-buffer)
159 (if gnus-interactive-post
160 ;; Newsgroups, subject and distribution are asked for.
161 ;; Suggested by yuki@flab.fujitsu.junet.
162 (progn
163 ;; Subscribed newsgroup names are required for
164 ;; completing read of newsgroup.
165 (or gnus-newsrc-assoc
166 (gnus-read-newsrc-file))
167 ;; Which do you like? (UMERIN)
168 ;; (setq newsgroups (read-string "Newsgroups: " "general"))
169 (or newsgroups ;Use the default newsgroup.
170 (setq newsgroups
171 (completing-read "Newsgroup: " gnus-newsrc-assoc
172 nil 'require-match
173 newsgroups ;Default newsgroup.
174 )))
175 (setq subject (read-string "Subject: "))
176 (setq distribution
177 (substring newsgroups 0 (string-match "\\." newsgroups)))
178 (if (string-equal distribution newsgroups)
179 ;; Newsgroup may be general or control. In this
180 ;; case, use default distribution.
181 (setq distribution gnus-default-distribution))
182 (setq distribution
183 (read-string "Distribution: " distribution))
184 ;; An empty string is ok to ignore gnus-default-distribution.
185 ;;(if (string-equal distribution "")
186 ;; (setq distribution nil))
187 ))
188 (news-setup () subject () newsgroups artbuf)
189 ;; Make sure the article is posted by GNUS.
190 ;;(mail-position-on-field "Posting-Software")
191 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
192 ;; Insert Distribution: field.
193 ;; Suggested by ichikawa@flab.fujitsu.junet.
194 (mail-position-on-field "Distribution")
195 (insert (or distribution gnus-default-distribution ""))
196 ;; Handle author copy using FCC field.
197 (if gnus-author-copy
198 (progn
199 (mail-position-on-field "FCC")
200 (insert gnus-author-copy)))
201 (if gnus-interactive-post
202 ;; All fields are filled in.
203 (goto-char (point-max))
204 ;; Move point to Newsgroup: field.
205 (goto-char (point-min))
206 (end-of-line))
207 ))
208 (message "")))
209
210(defun gnus-news-reply (&optional yank)
211 "Compose and post a reply (aka a followup) to the current article on USENET.
212While composing the followup, use \\[news-reply-yank-original] to yank the
213original message into it."
214 (interactive)
215 (if (or (not gnus-novice-user)
216 (y-or-n-p "Are you sure you want to followup to all of USENET? "))
217 (let (from cc subject date to followup-to newsgroups message-of
218 references distribution message-id
219 (artbuf (current-buffer)))
220 (save-restriction
221 (and (not (zerop (buffer-size)))
222 ;;(equal major-mode 'news-mode)
223 (equal major-mode 'gnus-Article-mode)
224 (progn
225 ;; (news-show-all-headers)
226 (gnus-Article-show-all-headers)
227 (narrow-to-region (point-min)
228 (progn (goto-char (point-min))
229 (search-forward "\n\n")
230 (point)))))
231 (setq from (mail-fetch-field "from"))
232 (setq news-reply-yank-from from)
233 (setq subject (mail-fetch-field "subject"))
234 (setq date (mail-fetch-field "date"))
235 (setq followup-to (mail-fetch-field "followup-to"))
236 ;; Ignore Followup-To: poster.
237 (if (or (null gnus-use-followup-to) ;Ignore followup-to: field.
238 (string-equal "" followup-to) ;Bogus header.
239 (string-equal "poster" followup-to))
240 (setq followup-to nil))
241 (setq newsgroups (or followup-to (mail-fetch-field "newsgroups")))
242 (setq references (mail-fetch-field "references"))
243 (setq distribution (mail-fetch-field "distribution"))
244 (setq message-id (mail-fetch-field "message-id"))
245 (setq news-reply-yank-message-id message-id))
246 (pop-to-buffer gnus-post-news-buffer)
247 (news-reply-mode)
248 (gnus-overload-functions)
249 (if (and (buffer-modified-p)
250 (> (buffer-size) 0)
251 (not (y-or-n-p "Unsent article being composed; erase it? ")))
252 ;; Continue composition.
253 ;; Make news-reply-yank-original work on current article.
254 (setq mail-reply-buffer artbuf)
255 (erase-buffer)
256 (and subject
257 (setq subject
258 (concat "Re: " (gnus-simplify-subject subject 're-only))))
259 (and from
260 (progn
261 (let ((stop-pos
262 (string-match " *at \\| *@ \\| *(\\| *<" from)))
263 (setq message-of
264 (concat
265 (if stop-pos (substring from 0 stop-pos) from)
266 "'s message of "
267 date)))))
268 (news-setup nil subject message-of newsgroups artbuf)
269 (if followup-to
270 (progn (news-reply-followup-to)
271 (insert followup-to)))
272 ;; Fold long references line to follow RFC1036.
273 (mail-position-on-field "References")
274 (let ((begin (point))
275 (fill-column 79)
276 (fill-prefix "\t"))
277 (if references
278 (insert references))
279 (if (and references message-id)
280 (insert " "))
281 (if message-id
282 (insert message-id))
283 ;; The region must end with a newline to fill the region
284 ;; without inserting extra newline.
285 (fill-region-as-paragraph begin (1+ (point))))
286 ;; Make sure the article is posted by GNUS.
287 ;;(mail-position-on-field "Posting-Software")
288 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
289 ;; Distribution must be the same as original article.
290 (mail-position-on-field "Distribution")
291 (insert (or distribution ""))
292 ;; Handle author copy using FCC field.
293 (if gnus-author-copy
294 (progn
295 (mail-position-on-field "FCC")
296 (insert gnus-author-copy)))
297 (goto-char (point-max)))
298 ;; Yank original article automatically.
299 (if yank
300 (let ((last (point)))
301 (goto-char (point-max))
302 (news-reply-yank-original nil)
303 (goto-char last)))
304 )
305 (message "")))
306
307(defun gnus-inews-news ()
308 "Send a news message."
309 (interactive)
310 (let* ((case-fold-search nil)
311 (server-running (gnus-server-opened)))
312 (save-excursion
313 ;; It is possible to post a news without reading news using
314 ;; `gnus' before.
315 ;; Suggested by yuki@flab.fujitsu.junet.
316 (gnus-start-news-server) ;Use default server.
317 ;; NNTP server must be opened before current buffer is modified.
318 (widen)
319 (goto-char (point-min))
320 (run-hooks 'news-inews-hook)
321 (goto-char (point-min))
322 (search-forward (concat "\n" mail-header-separator "\n"))
323 (replace-match "\n\n")
324 (goto-char (point-max))
325 ;; require a newline at the end for inews to append .signature to
326 (or (= (preceding-char) ?\n)
327 (insert ?\n))
328 (message "Posting to USENET...")
329 ;; Post to NNTP server.
330 (if (gnus-inews-article)
331 (message "Posting to USENET... done")
332 ;; We cannot signal an error.
333 (ding) (message "Article rejected: %s" (gnus-status-message)))
334 (goto-char (point-min)) ;restore internal header separator
335 (search-forward "\n\n")
336 (replace-match (concat "\n" mail-header-separator "\n"))
337 (set-buffer-modified-p nil))
338 ;; If NNTP server is opened by gnus-inews-news, close it by myself.
339 (or server-running
340 (gnus-close-server))
341 (and (fboundp 'bury-buffer) (bury-buffer))
342 ;; Restore last window configuration.
343 (and gnus-winconf-post-news
344 (set-window-configuration gnus-winconf-post-news))
345 (setq gnus-winconf-post-news nil)
346 ))
347
348(defun gnus-cancel-news ()
349 "Cancel an article you posted."
350 (interactive)
351 (if (yes-or-no-p "Do you really want to cancel this article? ")
352 (let ((from nil)
353 (newsgroups nil)
354 (message-id nil)
355 (distribution nil))
356 (save-excursion
357 ;; Get header info. from original article.
358 (save-restriction
359 (gnus-Article-show-all-headers)
360 (goto-char (point-min))
361 (search-forward "\n\n")
362 (narrow-to-region (point-min) (point))
363 (setq from (mail-fetch-field "from"))
364 (setq newsgroups (mail-fetch-field "newsgroups"))
365 (setq message-id (mail-fetch-field "message-id"))
366 (setq distribution (mail-fetch-field "distribution")))
367 ;; Verify if the article is absolutely user's by comparing
368 ;; user id with value of its From: field.
369 (if (not
370 (string-equal
371 (downcase (mail-strip-quoted-names from))
372 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
373 (progn
374 (ding) (message "This article is not yours"))
375 ;; Make control article.
376 (set-buffer (get-buffer-create " *GNUS-posting*"))
377 (buffer-flush-undo (current-buffer))
378 (erase-buffer)
379 (insert "Newsgroups: " newsgroups "\n"
380 "Subject: cancel " message-id "\n"
381 "Control: cancel " message-id "\n"
382 ;; We should not use the value of
383 ;; `gnus-default-distribution' as default value,
384 ;; because distribution must be as same as original
385 ;; article.
386 "Distribution: " (or distribution "") "\n"
387 )
388 ;; Prepare article headers.
389 (gnus-inews-insert-headers)
390 (goto-char (point-max))
391 ;; Insert empty line.
392 (insert "\n")
393 ;; Send the control article to NNTP server.
394 (message "Canceling your article...")
395 (if (gnus-request-post)
396 (message "Canceling your article... done")
397 (ding) (message "Failed to cancel your article"))
398 (kill-buffer (current-buffer))
399 )))
400 ))
401
402\f
403;;; Lowlevel inews interface
404
405(defun gnus-inews-article ()
406 "NNTP inews interface."
407 (let ((signature
408 (if gnus-signature-file
409 (expand-file-name gnus-signature-file nil)))
410 (distribution nil)
411 (artbuf (current-buffer))
412 (tmpbuf (get-buffer-create " *GNUS-posting*")))
413 (save-excursion
414 (set-buffer tmpbuf)
415 (buffer-flush-undo (current-buffer))
416 (erase-buffer)
417 (insert-buffer-substring artbuf)
418 ;; Get distribution.
419 (save-restriction
420 (goto-char (point-min))
421 (search-forward "\n\n")
422 (narrow-to-region (point-min) (point))
423 (setq distribution (mail-fetch-field "distribution")))
424 (widen)
425 (if signature
426 (progn
427 ;; Change signature file by distribution.
428 ;; Suggested by hyoko@flab.fujitsu.junet.
429 (if (file-exists-p (concat signature "-" distribution))
430 (setq signature (concat signature "-" distribution)))
431 ;; Insert signature.
432 (if (file-exists-p signature)
433 (progn
434 (goto-char (point-max))
435 (insert "--\n")
436 (insert-file-contents signature)))
437 ))
438 ;; Prepare article headers.
439 (save-restriction
440 (goto-char (point-min))
441 (search-forward "\n\n")
442 (narrow-to-region (point-min) (point))
443 (gnus-inews-insert-headers)
444 ;; Save author copy of posted article. The article must be
445 ;; copied before being posted because `gnus-request-post'
446 ;; modifies the buffer.
447 (let ((case-fold-search t))
448 ;; Find and handle any FCC fields.
449 (goto-char (point-min))
450 (if (re-search-forward "^FCC:" nil t)
451 (gnus-inews-do-fcc))))
452 (widen)
453 ;; Run final inews hooks.
454 (run-hooks 'gnus-Inews-article-hook)
455 ;; Post an article to NNTP server.
456 ;; Return NIL if post failed.
457 (prog1
458 (gnus-request-post)
459 (kill-buffer (current-buffer)))
460 )))
461
462(defun gnus-inews-do-fcc ()
463 "Process FCC: fields."
464 (let ((fcc-list nil)
465 (fcc-file nil)
466 (case-fold-search t)) ;Should ignore case.
467 (save-excursion
468 (save-restriction
469 (goto-char (point-min))
470 (while (re-search-forward "^FCC:[ \t]*" nil t)
471 (setq fcc-list (cons (buffer-substring (point)
472 (progn
473 (end-of-line)
474 (skip-chars-backward " \t")
475 (point)))
476 fcc-list))
477 (delete-region (match-beginning 0)
478 (progn (forward-line 1) (point))))
479 ;; Process FCC operations.
480 (widen)
481 (while fcc-list
482 (setq fcc-file (car fcc-list))
483 (setq fcc-list (cdr fcc-list))
484 (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
485 (let ((program (substring fcc-file
486 (match-beginning 1) (match-end 1))))
487 ;; Suggested by yuki@flab.fujitsu.junet.
488 ;; Send article to named program.
489 (call-process-region (point-min) (point-max) shell-file-name
490 nil nil nil "-c" program)
491 ))
492 (t
493 ;; Suggested by hyoko@flab.fujitsu.junet.
494 ;; Save article in Unix mail format by default.
495 (funcall (or gnus-author-copy-saver 'rmail-output) fcc-file)
496 ))
497 )
498 ))
499 ))
500
501(defun gnus-inews-insert-headers ()
502 "Prepare article headers.
503Path:, From:, Subject: and Distribution: are generated.
504Message-ID:, Date: and Organization: are optional."
505 (save-excursion
506 (let ((date (gnus-inews-date))
507 (message-id (gnus-inews-message-id))
508 (organization (gnus-inews-organization)))
509 ;; Insert from the top of headers.
510 (goto-char (point-min))
511 (insert "Path: " (gnus-inews-path) "\n")
512 (insert "From: " (gnus-inews-user-name) "\n")
513 ;; If there is no subject, make Subject: field.
514 (or (mail-fetch-field "subject")
515 (insert "Subject: \n"))
516 ;; Insert random headers.
517 (if message-id
518 (insert "Message-ID: " message-id "\n"))
519 (if date
520 (insert "Date: " date "\n"))
521 (if organization
522 (let ((begin (point))
523 (fill-column 79)
524 (fill-prefix "\t"))
525 (insert "Organization: " organization "\n")
526 (fill-region-as-paragraph begin (point))))
527 (or (mail-fetch-field "distribution")
528 (insert "Distribution: \n"))
529 )))
530
531(defun gnus-inews-path ()
532 "Return uucp path."
533 (let ((login-name (gnus-inews-login-name)))
534 (cond ((null gnus-use-generic-path)
535 (concat gnus-nntp-server "!" login-name))
536 ((stringp gnus-use-generic-path)
537 ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
538 (concat gnus-use-generic-path "!" login-name))
539 (t login-name))
540 ))
541
542(defun gnus-inews-user-name ()
543 "Return user's network address as `NAME@DOMAIN (FULL NAME)'."
544 (let ((login-name (gnus-inews-login-name))
545 (full-name (gnus-inews-full-name)))
546 (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from)
547 ;; User's full name.
548 (cond ((string-equal full-name "") "")
549 ((string-equal full-name "&") ;Unix hack.
550 (concat " (" login-name ")"))
551 (t
552 (concat " (" full-name ")")))
553 )))
554
555(defun gnus-inews-login-name ()
556 "Return user login name.
557Got from the variable `gnus-user-login-name', the environment variables
558USER and LOGNAME, and the function `user-login-name'."
559 (or gnus-user-login-name
560 (getenv "USER") (getenv "LOGNAME") (user-login-name)))
561
562(defun gnus-inews-full-name ()
563 "Return user full name.
564Got from the variable `gnus-user-full-name', the environment variable
565NAME, and the function `user-full-name'."
566 (or gnus-user-full-name
567 (getenv "NAME") (user-full-name)))
568
569(defun gnus-inews-domain-name (&optional genericfrom)
570 "Return user's domain name.
571If optional argument GENERICFROM is a string, use it as the domain
572name; if it is non-nil, strip of local host name from the domain name.
573If the function `system-name' returns full internet name and the
574domain is undefined, the domain name is got from it."
575 (let ((domain (or (if (stringp genericfrom) genericfrom)
576 (getenv "DOMAINNAME")
577 gnus-your-domain
578 ;; Function `system-name' may return full internet name.
579 ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
580 (if (string-match "\\." (system-name))
581 (substring (system-name) (match-end 0)))
582 (read-string "Domain name (no host): ")))
583 (host (or (if (string-match "\\." (system-name))
584 (substring (system-name) 0 (match-beginning 0)))
585 (system-name))))
586 (if (string-equal "." (substring domain 0 1))
587 (setq domain (substring domain 1)))
588 (if (null gnus-your-domain)
589 (setq gnus-your-domain domain))
590 ;; Support GENERICFROM as same as standard Bnews system.
591 ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
592 (cond ((null genericfrom)
593 (concat host "." domain))
594 ;;((stringp genericfrom) genericfrom)
595 (t domain))
596 ))
597
598(defun gnus-inews-message-id ()
599 "Generate unique Message-ID for user."
600 ;; Message-ID should not contain a slash and should be terminated by
601 ;; a number. I don't know the reason why it is so.
602 (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">"))
603
604(defun gnus-inews-unique-id ()
605 "Generate unique ID from user name and current time."
606 (let ((date (current-time-string))
607 (name (gnus-inews-login-name)))
608 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
609 date)
610 (concat (upcase name) "."
611 (substring date (match-beginning 6) (match-end 6)) ;Year
612 (substring date (match-beginning 1) (match-end 1)) ;Month
613 (substring date (match-beginning 2) (match-end 2)) ;Day
614 (substring date (match-beginning 3) (match-end 3)) ;Hour
615 (substring date (match-beginning 4) (match-end 4)) ;Minute
616 (substring date (match-beginning 5) (match-end 5)) ;Second
617 )
618 (error "Cannot understand current-time-string: %s." date))
619 ))
620
621(defun gnus-inews-date ()
622 "Bnews date format string of today. Time zone is ignored."
623 ;; Insert buggy date (time zone is ignored), but I don't worry about
624 ;; it since inews will rewrite it.
625 (let ((date (current-time-string)))
626 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
627 date)
628 (concat (substring date (match-beginning 2) (match-end 2)) ;Day
629 " "
630 (substring date (match-beginning 1) (match-end 1)) ;Month
631 " "
632 (substring date (match-beginning 4) (match-end 4)) ;Year
633 " "
634 (substring date (match-beginning 3) (match-end 3))) ;Time
635 (error "Cannot understand current-time-string: %s." date))
636 ))
637
638(defun gnus-inews-organization ()
639 "Return user's organization.
640The ORGANIZATION environment variable is used if defined.
641If not, the variable `gnus-your-organization' is used instead.
642If the value begins with a slash, it is taken as the name of a file
643containing the organization."
644 ;; The organization must be got in this order since the ORGANIZATION
645 ;; environment variable is intended for user specific while
646 ;; gnus-your-organization is for machine or organization specific.
647 (let ((organization (or (getenv "ORGANIZATION")
648 gnus-your-organization
649 (expand-file-name "~/.organization" nil))))
650 (and (stringp organization)
651 (string-equal (substring organization 0 1) "/")
652 ;; Get it from the user and system file.
653 ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath).
654 (let ((dist (mail-fetch-field "distribution")))
655 (setq organization
656 (cond ((file-exists-p (concat organization "-" dist))
657 (concat organization "-" dist))
658 ((file-exists-p organization) organization)
659 ((file-exists-p gnus-organization-file)
660 gnus-organization-file)
661 (t organization)))
662 ))
663 (cond ((not (stringp organization)) nil)
664 ((and (string-equal (substring organization 0 1) "/")
665 (file-exists-p organization))
666 ;; If the first character is `/', assume it is the name of
667 ;; a file containing the organization.
668 (save-excursion
669 (let ((tmpbuf (get-buffer-create " *GNUS organization*")))
670 (set-buffer tmpbuf)
671 (erase-buffer)
672 (insert-file-contents organization)
673 (prog1 (buffer-string)
674 (kill-buffer tmpbuf))
675 )))
676 (t organization))
677 ))
49116ac0
JB
678
679(provide 'gnuspost)
1a06eabd
ER
680
681;;; gnuspost.el ends here