summaryrefslogtreecommitdiff
path: root/lisp/=gnuspost.el
diff options
context:
space:
mode:
authorJim Blandy <jimb@redhat.com>1991-05-13 21:21:58 +0000
committerJim Blandy <jimb@redhat.com>1991-05-13 21:21:58 +0000
commitab6404f6b6cd33a9fb57e13612ecfe70487c2299 (patch)
tree240646a8313d88c5dc81653ea22c8231ccfc3fd5 /lisp/=gnuspost.el
parent8b99182cf7b2064152bf482ec2db9e49ad474845 (diff)
downloademacs-ab6404f6b6cd33a9fb57e13612ecfe70487c2299.tar.gz
Initial revision
Diffstat (limited to 'lisp/=gnuspost.el')
-rw-r--r--lisp/=gnuspost.el672
1 files changed, 672 insertions, 0 deletions
diff --git a/lisp/=gnuspost.el b/lisp/=gnuspost.el
new file mode 100644
index 00000000000..d40982d1def
--- /dev/null
+++ b/lisp/=gnuspost.el
@@ -0,0 +1,672 @@
+;;; Post news commands for GNUS newsreader
+;; Copyright (C) 1989 Fujitsu Laboratories LTD.
+;; Copyright (C) 1989, 1990 Masanobu UMEDA
+;; $Header: gnuspost.el,v 1.2 90/03/23 13:25:16 umerin Locked $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY. No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing. Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License. A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities. It should be in a
+;; file named COPYING. Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+(provide 'gnuspost)
+(require 'gnus)
+
+(defvar gnus-organization-file "/usr/lib/news/organization"
+ "*Local news organization file.")
+
+(defvar gnus-post-news-buffer "*post-news*")
+(defvar gnus-winconf-post-news nil)
+
+(autoload 'news-reply-mode "rnewspost")
+
+;;; Post news commands of GNUS Group Mode and Subject Mode
+
+(defun gnus-Group-post-news ()
+ "Post an article."
+ (interactive)
+ ;; Save window configuration.
+ (setq gnus-winconf-post-news (current-window-configuration))
+ (unwind-protect
+ (gnus-post-news)
+ (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
+ (not (zerop (buffer-size))))
+ ;; Restore last window configuration.
+ (set-window-configuration gnus-winconf-post-news)))
+ ;; We don't want to return to Subject buffer nor Article buffer later.
+ (if (get-buffer gnus-Subject-buffer)
+ (bury-buffer gnus-Subject-buffer))
+ (if (get-buffer gnus-Article-buffer)
+ (bury-buffer gnus-Article-buffer)))
+
+(defun gnus-Subject-post-news ()
+ "Post an article."
+ (interactive)
+ (gnus-Subject-select-article t nil)
+ ;; Save window configuration.
+ (setq gnus-winconf-post-news (current-window-configuration))
+ (unwind-protect
+ (progn
+ (switch-to-buffer gnus-Article-buffer)
+ (widen)
+ (delete-other-windows)
+ (gnus-post-news))
+ (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
+ (not (zerop (buffer-size))))
+ ;; Restore last window configuration.
+ (set-window-configuration gnus-winconf-post-news)))
+ ;; We don't want to return to Article buffer later.
+ (bury-buffer gnus-Article-buffer))
+
+(defun gnus-Subject-post-reply (yank)
+ "Post a reply article.
+If prefix argument YANK is non-nil, original article is yanked automatically."
+ (interactive "P")
+ (gnus-Subject-select-article t nil)
+ ;; Check Followup-To: poster.
+ (set-buffer gnus-Article-buffer)
+ (if (and gnus-use-followup-to
+ (string-equal "poster" (gnus-fetch-field "followup-to"))
+ (or (not (eq gnus-use-followup-to t))
+ (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? "))))
+ ;; Mail to the poster. GNUS is now RFC1036 compliant.
+ (gnus-Subject-mail-reply yank)
+ ;; Save window configuration.
+ (setq gnus-winconf-post-news (current-window-configuration))
+ (unwind-protect
+ (progn
+ (switch-to-buffer gnus-Article-buffer)
+ (widen)
+ (delete-other-windows)
+ (gnus-news-reply yank))
+ (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
+ (not (zerop (buffer-size))))
+ ;; Restore last window configuration.
+ (set-window-configuration gnus-winconf-post-news)))
+ ;; We don't want to return to Article buffer later.
+ (bury-buffer gnus-Article-buffer)))
+
+(defun gnus-Subject-post-reply-with-original ()
+ "Post a reply article with original article."
+ (interactive)
+ (gnus-Subject-post-reply t))
+
+(defun gnus-Subject-cancel-article ()
+ "Cancel an article you posted."
+ (interactive)
+ (gnus-Subject-select-article t nil)
+ (gnus-eval-in-buffer-window gnus-Article-buffer
+ (gnus-cancel-news)))
+
+
+;;; Post a News using NNTP
+
+;;;###autoload
+(fset 'sendnews 'gnus-post-news)
+;;;###autoload
+(fset 'postnews 'gnus-post-news)
+;;;###autoload
+(defun gnus-post-news ()
+ "Begin editing a new USENET news article to be posted.
+Type \\[describe-mode] once editing the article to get a list of commands."
+ (interactive)
+ (if (or (not gnus-novice-user)
+ (y-or-n-p "Are you sure you want to post to all of USENET? "))
+ (let ((artbuf (current-buffer))
+ (newsgroups ;Default newsgroup.
+ (if (eq major-mode 'gnus-Article-mode) gnus-newsgroup-name))
+ (subject nil)
+ (distribution nil))
+ (save-restriction
+ (and (not (zerop (buffer-size)))
+ ;;(equal major-mode 'news-mode)
+ (equal major-mode 'gnus-Article-mode)
+ (progn
+ ;;(news-show-all-headers)
+ (gnus-Article-show-all-headers)
+ (narrow-to-region (point-min)
+ (progn (goto-char (point-min))
+ (search-forward "\n\n")
+ (point)))))
+ (setq news-reply-yank-from (mail-fetch-field "from"))
+ (setq news-reply-yank-message-id (mail-fetch-field "message-id")))
+ (pop-to-buffer gnus-post-news-buffer)
+ (news-reply-mode)
+ (gnus-overload-functions)
+ (if (and (buffer-modified-p)
+ (> (buffer-size) 0)
+ (not (y-or-n-p "Unsent article being composed; erase it? ")))
+ ;; Continue composition.
+ ;; Make news-reply-yank-original work on the current article.
+ (setq mail-reply-buffer artbuf)
+ (erase-buffer)
+ (if gnus-interactive-post
+ ;; Newsgroups, subject and distribution are asked for.
+ ;; Suggested by yuki@flab.fujitsu.junet.
+ (progn
+ ;; Subscribed newsgroup names are required for
+ ;; completing read of newsgroup.
+ (or gnus-newsrc-assoc
+ (gnus-read-newsrc-file))
+ ;; Which do you like? (UMERIN)
+ ;; (setq newsgroups (read-string "Newsgroups: " "general"))
+ (or newsgroups ;Use the default newsgroup.
+ (setq newsgroups
+ (completing-read "Newsgroup: " gnus-newsrc-assoc
+ nil 'require-match
+ newsgroups ;Default newsgroup.
+ )))
+ (setq subject (read-string "Subject: "))
+ (setq distribution
+ (substring newsgroups 0 (string-match "\\." newsgroups)))
+ (if (string-equal distribution newsgroups)
+ ;; Newsgroup may be general or control. In this
+ ;; case, use default distribution.
+ (setq distribution gnus-default-distribution))
+ (setq distribution
+ (read-string "Distribution: " distribution))
+ ;; An empty string is ok to ignore gnus-default-distribution.
+ ;;(if (string-equal distribution "")
+ ;; (setq distribution nil))
+ ))
+ (news-setup () subject () newsgroups artbuf)
+ ;; Make sure the article is posted by GNUS.
+ ;;(mail-position-on-field "Posting-Software")
+ ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
+ ;; Insert Distribution: field.
+ ;; Suggested by ichikawa@flab.fujitsu.junet.
+ (mail-position-on-field "Distribution")
+ (insert (or distribution gnus-default-distribution ""))
+ ;; Handle author copy using FCC field.
+ (if gnus-author-copy
+ (progn
+ (mail-position-on-field "FCC")
+ (insert gnus-author-copy)))
+ (if gnus-interactive-post
+ ;; All fields are filled in.
+ (goto-char (point-max))
+ ;; Move point to Newsgroup: field.
+ (goto-char (point-min))
+ (end-of-line))
+ ))
+ (message "")))
+
+(defun gnus-news-reply (&optional yank)
+ "Compose and post a reply (aka a followup) to the current article on USENET.
+While composing the followup, use \\[news-reply-yank-original] to yank the
+original message into it."
+ (interactive)
+ (if (or (not gnus-novice-user)
+ (y-or-n-p "Are you sure you want to followup to all of USENET? "))
+ (let (from cc subject date to followup-to newsgroups message-of
+ references distribution message-id
+ (artbuf (current-buffer)))
+ (save-restriction
+ (and (not (zerop (buffer-size)))
+ ;;(equal major-mode 'news-mode)
+ (equal major-mode 'gnus-Article-mode)
+ (progn
+ ;; (news-show-all-headers)
+ (gnus-Article-show-all-headers)
+ (narrow-to-region (point-min)
+ (progn (goto-char (point-min))
+ (search-forward "\n\n")
+ (point)))))
+ (setq from (mail-fetch-field "from"))
+ (setq news-reply-yank-from from)
+ (setq subject (mail-fetch-field "subject"))
+ (setq date (mail-fetch-field "date"))
+ (setq followup-to (mail-fetch-field "followup-to"))
+ ;; Ignore Followup-To: poster.
+ (if (or (null gnus-use-followup-to) ;Ignore followup-to: field.
+ (string-equal "" followup-to) ;Bogus header.
+ (string-equal "poster" followup-to))
+ (setq followup-to nil))
+ (setq newsgroups (or followup-to (mail-fetch-field "newsgroups")))
+ (setq references (mail-fetch-field "references"))
+ (setq distribution (mail-fetch-field "distribution"))
+ (setq message-id (mail-fetch-field "message-id"))
+ (setq news-reply-yank-message-id message-id))
+ (pop-to-buffer gnus-post-news-buffer)
+ (news-reply-mode)
+ (gnus-overload-functions)
+ (if (and (buffer-modified-p)
+ (> (buffer-size) 0)
+ (not (y-or-n-p "Unsent article being composed; erase it? ")))
+ ;; Continue composition.
+ ;; Make news-reply-yank-original work on current article.
+ (setq mail-reply-buffer artbuf)
+ (erase-buffer)
+ (and subject
+ (setq subject
+ (concat "Re: " (gnus-simplify-subject subject 're-only))))
+ (and from
+ (progn
+ (let ((stop-pos
+ (string-match " *at \\| *@ \\| *(\\| *<" from)))
+ (setq message-of
+ (concat
+ (if stop-pos (substring from 0 stop-pos) from)
+ "'s message of "
+ date)))))
+ (news-setup nil subject message-of newsgroups artbuf)
+ (if followup-to
+ (progn (news-reply-followup-to)
+ (insert followup-to)))
+ ;; Fold long references line to follow RFC1036.
+ (mail-position-on-field "References")
+ (let ((begin (point))
+ (fill-column 79)
+ (fill-prefix "\t"))
+ (if references
+ (insert references))
+ (if (and references message-id)
+ (insert " "))
+ (if message-id
+ (insert message-id))
+ ;; The region must end with a newline to fill the region
+ ;; without inserting extra newline.
+ (fill-region-as-paragraph begin (1+ (point))))
+ ;; Make sure the article is posted by GNUS.
+ ;;(mail-position-on-field "Posting-Software")
+ ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
+ ;; Distribution must be the same as original article.
+ (mail-position-on-field "Distribution")
+ (insert (or distribution ""))
+ ;; Handle author copy using FCC field.
+ (if gnus-author-copy
+ (progn
+ (mail-position-on-field "FCC")
+ (insert gnus-author-copy)))
+ (goto-char (point-max)))
+ ;; Yank original article automatically.
+ (if yank
+ (let ((last (point)))
+ (goto-char (point-max))
+ (news-reply-yank-original nil)
+ (goto-char last)))
+ )
+ (message "")))
+
+(defun gnus-inews-news ()
+ "Send a news message."
+ (interactive)
+ (let* ((case-fold-search nil)
+ (server-running (gnus-server-opened)))
+ (save-excursion
+ ;; It is possible to post a news without reading news using
+ ;; `gnus' before.
+ ;; Suggested by yuki@flab.fujitsu.junet.
+ (gnus-start-news-server) ;Use default server.
+ ;; NNTP server must be opened before current buffer is modified.
+ (widen)
+ (goto-char (point-min))
+ (run-hooks 'news-inews-hook)
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n"))
+ (replace-match "\n\n")
+ (goto-char (point-max))
+ ;; require a newline at the end for inews to append .signature to
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ (message "Posting to USENET...")
+ ;; Post to NNTP server.
+ (if (gnus-inews-article)
+ (message "Posting to USENET... done")
+ ;; We cannot signal an error.
+ (ding) (message "Article rejected: %s" (gnus-status-message)))
+ (goto-char (point-min)) ;restore internal header separator
+ (search-forward "\n\n")
+ (replace-match (concat "\n" mail-header-separator "\n"))
+ (set-buffer-modified-p nil))
+ ;; If NNTP server is opened by gnus-inews-news, close it by myself.
+ (or server-running
+ (gnus-close-server))
+ (and (fboundp 'bury-buffer) (bury-buffer))
+ ;; Restore last window configuration.
+ (and gnus-winconf-post-news
+ (set-window-configuration gnus-winconf-post-news))
+ (setq gnus-winconf-post-news nil)
+ ))
+
+(defun gnus-cancel-news ()
+ "Cancel an article you posted."
+ (interactive)
+ (if (yes-or-no-p "Do you really want to cancel this article? ")
+ (let ((from nil)
+ (newsgroups nil)
+ (message-id nil)
+ (distribution nil))
+ (save-excursion
+ ;; Get header info. from original article.
+ (save-restriction
+ (gnus-Article-show-all-headers)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (narrow-to-region (point-min) (point))
+ (setq from (mail-fetch-field "from"))
+ (setq newsgroups (mail-fetch-field "newsgroups"))
+ (setq message-id (mail-fetch-field "message-id"))
+ (setq distribution (mail-fetch-field "distribution")))
+ ;; Verify if the article is absolutely user's by comparing
+ ;; user id with value of its From: field.
+ (if (not
+ (string-equal
+ (downcase (mail-strip-quoted-names from))
+ (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
+ (progn
+ (ding) (message "This article is not yours"))
+ ;; Make control article.
+ (set-buffer (get-buffer-create " *GNUS-posting*"))
+ (buffer-flush-undo (current-buffer))
+ (erase-buffer)
+ (insert "Newsgroups: " newsgroups "\n"
+ "Subject: cancel " message-id "\n"
+ "Control: cancel " message-id "\n"
+ ;; We should not use the value of
+ ;; `gnus-default-distribution' as default value,
+ ;; because distribution must be as same as original
+ ;; article.
+ "Distribution: " (or distribution "") "\n"
+ )
+ ;; Prepare article headers.
+ (gnus-inews-insert-headers)
+ (goto-char (point-max))
+ ;; Insert empty line.
+ (insert "\n")
+ ;; Send the control article to NNTP server.
+ (message "Canceling your article...")
+ (if (gnus-request-post)
+ (message "Canceling your article... done")
+ (ding) (message "Failed to cancel your article"))
+ (kill-buffer (current-buffer))
+ )))
+ ))
+
+
+;;; Lowlevel inews interface
+
+(defun gnus-inews-article ()
+ "NNTP inews interface."
+ (let ((signature
+ (if gnus-signature-file
+ (expand-file-name gnus-signature-file nil)))
+ (distribution nil)
+ (artbuf (current-buffer))
+ (tmpbuf (get-buffer-create " *GNUS-posting*")))
+ (save-excursion
+ (set-buffer tmpbuf)
+ (buffer-flush-undo (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring artbuf)
+ ;; Get distribution.
+ (save-restriction
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (narrow-to-region (point-min) (point))
+ (setq distribution (mail-fetch-field "distribution")))
+ (widen)
+ (if signature
+ (progn
+ ;; Change signature file by distribution.
+ ;; Suggested by hyoko@flab.fujitsu.junet.
+ (if (file-exists-p (concat signature "-" distribution))
+ (setq signature (concat signature "-" distribution)))
+ ;; Insert signature.
+ (if (file-exists-p signature)
+ (progn
+ (goto-char (point-max))
+ (insert "--\n")
+ (insert-file-contents signature)))
+ ))
+ ;; Prepare article headers.
+ (save-restriction
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (narrow-to-region (point-min) (point))
+ (gnus-inews-insert-headers)
+ ;; Save author copy of posted article. The article must be
+ ;; copied before being posted because `gnus-request-post'
+ ;; modifies the buffer.
+ (let ((case-fold-search t))
+ ;; Find and handle any FCC fields.
+ (goto-char (point-min))
+ (if (re-search-forward "^FCC:" nil t)
+ (gnus-inews-do-fcc))))
+ (widen)
+ ;; Run final inews hooks.
+ (run-hooks 'gnus-Inews-article-hook)
+ ;; Post an article to NNTP server.
+ ;; Return NIL if post failed.
+ (prog1
+ (gnus-request-post)
+ (kill-buffer (current-buffer)))
+ )))
+
+(defun gnus-inews-do-fcc ()
+ "Process FCC: fields."
+ (let ((fcc-list nil)
+ (fcc-file nil)
+ (case-fold-search t)) ;Should ignore case.
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (while (re-search-forward "^FCC:[ \t]*" nil t)
+ (setq fcc-list (cons (buffer-substring (point)
+ (progn
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ fcc-list))
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ ;; Process FCC operations.
+ (widen)
+ (while fcc-list
+ (setq fcc-file (car fcc-list))
+ (setq fcc-list (cdr fcc-list))
+ (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
+ (let ((program (substring fcc-file
+ (match-beginning 1) (match-end 1))))
+ ;; Suggested by yuki@flab.fujitsu.junet.
+ ;; Send article to named program.
+ (call-process-region (point-min) (point-max) shell-file-name
+ nil nil nil "-c" program)
+ ))
+ (t
+ ;; Suggested by hyoko@flab.fujitsu.junet.
+ ;; Save article in Unix mail format by default.
+ (funcall (or gnus-author-copy-saver 'rmail-output) fcc-file)
+ ))
+ )
+ ))
+ ))
+
+(defun gnus-inews-insert-headers ()
+ "Prepare article headers.
+Path:, From:, Subject: and Distribution: are generated.
+Message-ID:, Date: and Organization: are optional."
+ (save-excursion
+ (let ((date (gnus-inews-date))
+ (message-id (gnus-inews-message-id))
+ (organization (gnus-inews-organization)))
+ ;; Insert from the top of headers.
+ (goto-char (point-min))
+ (insert "Path: " (gnus-inews-path) "\n")
+ (insert "From: " (gnus-inews-user-name) "\n")
+ ;; If there is no subject, make Subject: field.
+ (or (mail-fetch-field "subject")
+ (insert "Subject: \n"))
+ ;; Insert random headers.
+ (if message-id
+ (insert "Message-ID: " message-id "\n"))
+ (if date
+ (insert "Date: " date "\n"))
+ (if organization
+ (let ((begin (point))
+ (fill-column 79)
+ (fill-prefix "\t"))
+ (insert "Organization: " organization "\n")
+ (fill-region-as-paragraph begin (point))))
+ (or (mail-fetch-field "distribution")
+ (insert "Distribution: \n"))
+ )))
+
+(defun gnus-inews-path ()
+ "Return uucp path."
+ (let ((login-name (gnus-inews-login-name)))
+ (cond ((null gnus-use-generic-path)
+ (concat gnus-nntp-server "!" login-name))
+ ((stringp gnus-use-generic-path)
+ ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
+ (concat gnus-use-generic-path "!" login-name))
+ (t login-name))
+ ))
+
+(defun gnus-inews-user-name ()
+ "Return user's network address as `NAME@DOMAIN (FULL NAME)'."
+ (let ((login-name (gnus-inews-login-name))
+ (full-name (gnus-inews-full-name)))
+ (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from)
+ ;; User's full name.
+ (cond ((string-equal full-name "") "")
+ ((string-equal full-name "&") ;Unix hack.
+ (concat " (" login-name ")"))
+ (t
+ (concat " (" full-name ")")))
+ )))
+
+(defun gnus-inews-login-name ()
+ "Return user login name.
+Got from the variable `gnus-user-login-name', the environment variables
+USER and LOGNAME, and the function `user-login-name'."
+ (or gnus-user-login-name
+ (getenv "USER") (getenv "LOGNAME") (user-login-name)))
+
+(defun gnus-inews-full-name ()
+ "Return user full name.
+Got from the variable `gnus-user-full-name', the environment variable
+NAME, and the function `user-full-name'."
+ (or gnus-user-full-name
+ (getenv "NAME") (user-full-name)))
+
+(defun gnus-inews-domain-name (&optional genericfrom)
+ "Return user's domain name.
+If optional argument GENERICFROM is a string, use it as the domain
+name; if it is non-nil, strip of local host name from the domain name.
+If the function `system-name' returns full internet name and the
+domain is undefined, the domain name is got from it."
+ (let ((domain (or (if (stringp genericfrom) genericfrom)
+ (getenv "DOMAINNAME")
+ gnus-your-domain
+ ;; Function `system-name' may return full internet name.
+ ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
+ (if (string-match "\\." (system-name))
+ (substring (system-name) (match-end 0)))
+ (read-string "Domain name (no host): ")))
+ (host (or (if (string-match "\\." (system-name))
+ (substring (system-name) 0 (match-beginning 0)))
+ (system-name))))
+ (if (string-equal "." (substring domain 0 1))
+ (setq domain (substring domain 1)))
+ (if (null gnus-your-domain)
+ (setq gnus-your-domain domain))
+ ;; Support GENERICFROM as same as standard Bnews system.
+ ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
+ (cond ((null genericfrom)
+ (concat host "." domain))
+ ;;((stringp genericfrom) genericfrom)
+ (t domain))
+ ))
+
+(defun gnus-inews-message-id ()
+ "Generate unique Message-ID for user."
+ ;; Message-ID should not contain a slash and should be terminated by
+ ;; a number. I don't know the reason why it is so.
+ (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">"))
+
+(defun gnus-inews-unique-id ()
+ "Generate unique ID from user name and current time."
+ (let ((date (current-time-string))
+ (name (gnus-inews-login-name)))
+ (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
+ date)
+ (concat (upcase name) "."
+ (substring date (match-beginning 6) (match-end 6)) ;Year
+ (substring date (match-beginning 1) (match-end 1)) ;Month
+ (substring date (match-beginning 2) (match-end 2)) ;Day
+ (substring date (match-beginning 3) (match-end 3)) ;Hour
+ (substring date (match-beginning 4) (match-end 4)) ;Minute
+ (substring date (match-beginning 5) (match-end 5)) ;Second
+ )
+ (error "Cannot understand current-time-string: %s." date))
+ ))
+
+(defun gnus-inews-date ()
+ "Bnews date format string of today. Time zone is ignored."
+ ;; Insert buggy date (time zone is ignored), but I don't worry about
+ ;; it since inews will rewrite it.
+ (let ((date (current-time-string)))
+ (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
+ date)
+ (concat (substring date (match-beginning 2) (match-end 2)) ;Day
+ " "
+ (substring date (match-beginning 1) (match-end 1)) ;Month
+ " "
+ (substring date (match-beginning 4) (match-end 4)) ;Year
+ " "
+ (substring date (match-beginning 3) (match-end 3))) ;Time
+ (error "Cannot understand current-time-string: %s." date))
+ ))
+
+(defun gnus-inews-organization ()
+ "Return user's organization.
+The ORGANIZATION environment variable is used if defined.
+If not, the variable `gnus-your-organization' is used instead.
+If the value begins with a slash, it is taken as the name of a file
+containing the organization."
+ ;; The organization must be got in this order since the ORGANIZATION
+ ;; environment variable is intended for user specific while
+ ;; gnus-your-organization is for machine or organization specific.
+ (let ((organization (or (getenv "ORGANIZATION")
+ gnus-your-organization
+ (expand-file-name "~/.organization" nil))))
+ (and (stringp organization)
+ (string-equal (substring organization 0 1) "/")
+ ;; Get it from the user and system file.
+ ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath).
+ (let ((dist (mail-fetch-field "distribution")))
+ (setq organization
+ (cond ((file-exists-p (concat organization "-" dist))
+ (concat organization "-" dist))
+ ((file-exists-p organization) organization)
+ ((file-exists-p gnus-organization-file)
+ gnus-organization-file)
+ (t organization)))
+ ))
+ (cond ((not (stringp organization)) nil)
+ ((and (string-equal (substring organization 0 1) "/")
+ (file-exists-p organization))
+ ;; If the first character is `/', assume it is the name of
+ ;; a file containing the organization.
+ (save-excursion
+ (let ((tmpbuf (get-buffer-create " *GNUS organization*")))
+ (set-buffer tmpbuf)
+ (erase-buffer)
+ (insert-file-contents organization)
+ (prog1 (buffer-string)
+ (kill-buffer tmpbuf))
+ )))
+ (t organization))
+ ))