lisp/gnuspost.el

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