Initial revision

[emacs.git] / lisp / gnuspost.el

;;; 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)))

\f
;;; 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))
            )))
    ))

\f
;;; 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))
    ))