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