lisp/gnuspost.el

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