code.delx.au - gnu-emacs/blob - lisp/mail/rnewspost.el

   1 ;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs
   2
   3 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Keywords: mail, 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 ;; Change Log:
  25
  26 ;; moved posting and mail code from rnews.el
  27 ;;      tower@prep.ai.mit.edu Wed Oct 29 1986
  28 ;; brought posting code almost up to the revision of RFC 850 for News 2.11
  29 ;; - couldn't see handling the special meaning of the Keyword: poster
  30 ;; - not worth the code space to support the old A news Title: (which
  31 ;;   Subject: replaced) and Article-I.D.: (which Message-ID: replaced)
  32 ;;      tower@prep Nov 86
  33 ;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body
  34 ;;      tower@prep 21 Nov 86
  35 ;; added (require 'rnews)       tower@prep 22 Apr 87
  36 ;; restricted call of news-show-all-headers in news-post-news & news-reply
  37 ;;      tower@prep 28 Apr 87
  38 ;; commented out Posting-Front-End to save USENET bytes tower@prep Jul 31 87
  39 ;; commented out -n and -t args in news-inews     tower@prep 15 Oct 87
  40
  41 ;Now in paths.el.
  42 ;(defvar news-inews-program "inews"
  43 ;  "Function to post news.")
  44
  45 ;; Replying and posting news items are done by these functions.
  46 ;; imported from rmail and modified to work with rnews ...
  47 ;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes.
  48 ;; this is done so that rnews can operate independently from rmail.el and
  49 ;; sendmail and dosen't have to autoload these functions.
  50 ;;
  51 ;;; >> Nuked by Mly to autoload those functions again, as the duplication of
  52 ;;; >>  code was making maintenance too difficult.
  53
  54 ;;; Code:
  55
  56 (require 'sendmail)
  57 (require 'rnews)
  58
  59 (defvar news-reply-mode-map () "Mode map used by news-reply.")
  60
  61 (or news-reply-mode-map
  62     (progn
  63       (setq news-reply-mode-map (make-keymap))
  64       (define-key news-reply-mode-map "\C-c?" 'describe-mode)
  65       (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
  66       (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
  67       (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
  68       (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
  69       (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
  70       (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
  71       (define-key news-reply-mode-map "\C-c\C-t" 'mail-text)
  72       (define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body)
  73       (define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature)
  74       (define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original)
  75       (define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
  76       (define-key news-reply-mode-map "\C-c\C-c" 'news-inews)
  77       (define-key news-reply-mode-map "\C-c\C-s" 'news-inews)))
  78
  79 (defun news-reply-mode ()
  80   "Major mode for editing news to be posted on USENET.
  81 First-time posters are asked to please read the articles in newsgroup:
  82                                                      news.announce.newusers .
  83 Like Text Mode but with these additional commands:
  84
  85 C-c C-s  news-inews (post the message)    C-c C-c  news-inews
  86 C-c C-f  move to a header field (and create it if there isn't):
  87          C-c C-f C-n  move to Newsgroups:       C-c C-f C-s  move to Subj:
  88          C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
  89          C-c C-f C-d  move to Distribution:     C-c C-f C-a  move to Summary:
  90 C-c C-y  news-reply-yank-original (insert current message, in NEWS).
  91 C-c C-q  mail-fill-yanked-message (fill what was yanked).
  92 C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13)."
  93   (interactive)
  94   ;; require...
  95   (or (fboundp 'mail-setup) (load "sendmail"))
  96   (kill-all-local-variables)
  97   (make-local-variable 'mail-reply-buffer)
  98   (setq mail-reply-buffer nil)
  99   (set-syntax-table text-mode-syntax-table)
 100   (use-local-map news-reply-mode-map)
 101   (setq local-abbrev-table text-mode-abbrev-table)
 102   (setq major-mode 'news-reply-mode)
 103   (setq mode-name "News Reply")
 104   (make-local-variable 'paragraph-separate)
 105   (make-local-variable 'paragraph-start)
 106   (setq paragraph-start (concat "^" mail-header-separator "$\\|"
 107                                 paragraph-start))
 108   (setq paragraph-separate (concat "^" mail-header-separator "$\\|"
 109                                    paragraph-separate))
 110   (run-hooks 'text-mode-hook 'news-reply-mode-hook))
 111
 112 (defvar news-reply-yank-from
 113   "Save `From:' field for `news-reply-yank-original'."
 114   "")
 115
 116 (defvar news-reply-yank-message-id
 117   "Save `Message-Id:' field for `news-reply-yank-original'."
 118   "")
 119
 120 (defun news-reply-yank-original (arg)
 121   "Insert the message being replied to, if any (in Mail mode).
 122 Puts point before the text and mark after.
 123 Indents each nonblank line ARG spaces (default 3).
 124 Just \\[universal-argument] as argument means don't indent
 125 and don't delete any header fields."
 126   (interactive "P")
 127   (mail-yank-original arg)
 128   (exchange-point-and-mark)
 129   (run-hooks 'news-reply-header-hook))
 130
 131 (defvar news-reply-header-hook
 132   '(lambda ()
 133          (insert "In article " news-reply-yank-message-id
 134                          " " news-reply-yank-from " writes:\n\n"))
 135   "Hook for inserting a header at the top of a yanked message.")
 136
 137 (defun news-reply-newsgroups ()
 138   "Move point to end of `Newsgroups:' field.
 139 RFC 850 constrains the `Newsgroups:' field to be a comma-separated list
 140 of valid newsgroup names at your site.  For example,
 141    Newsgroups: news.misc,comp.misc,rec.misc"
 142   (interactive)
 143   (expand-abbrev)
 144   (goto-char (point-min))
 145   (mail-position-on-field "Newsgroups"))
 146
 147 (defun news-reply-followup-to ()
 148   "Move point to end of `Followup-To:' field.  Create the field if none.
 149 One usually requests followups to only one newsgroup.
 150 RFC 850 constrains the `Followup-To:' field to be a comma-separated list
 151 of valid newsgroups names at your site, and it must be a subset of the
 152 `Newsgroups:' field.  For example:
 153    Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
 154    Followup-To: news.misc,comp.misc,rec.misc"
 155   (interactive)
 156   (expand-abbrev)
 157   (or (mail-position-on-field "Followup-To" t)
 158       (progn (mail-position-on-field "newsgroups")
 159              (insert "\nFollowup-To: ")))
 160          ;; @@ could do a completing read based on the Newsgroups: field to
 161          ;; @@ fill in the Followup-To: field
 162 )
 163
 164 (defun news-reply-distribution ()
 165   "Move point to end of `Distribution:' optional field.
 166 Create the field if none.  Without this field the posting goes to all of
 167 USENET.  The field is used to restrict the posting to parts of USENET."
 168   (interactive)
 169   (expand-abbrev)
 170   (mail-position-on-field "Distribution")
 171   ;; @@could do a completing read based on the news library file:
 172   ;; @@    ../distributions  to fill in the field.
 173   )
 174
 175 (defun news-reply-keywords ()
 176   "Move point to end of `Keywords:' optional field.  Create the field if none.
 177 Used as an aid to the news reader, it can contain a few, well selected keywords
 178 identifying the message."
 179   (interactive)
 180   (expand-abbrev)
 181   (mail-position-on-field "Keywords"))
 182
 183 (defun news-reply-summary ()
 184   "Move point to end of `Summary:' optional field.  Create the field if none.
 185 Used as an aid to the news reader, it can contain a succinct
 186 summary (abstract) of the message."
 187   (interactive)
 188   (expand-abbrev)
 189   (mail-position-on-field "Summary"))
 190
 191 (defun news-reply-signature ()
 192   "The inews program appends ~/.signature automatically."
 193   (interactive)
 194   (message "~/.signature will be appended automatically."))
 195
 196 (defun news-setup (to subject in-reply-to newsgroups replybuffer)
 197   "Set up the news reply or posting buffer with the proper headers and mode."
 198   (setq mail-reply-buffer replybuffer)
 199   (let ((mail-setup-hook nil))
 200     (if (null to)
 201         ;; this hack is needed so that inews wont be confused by
 202         ;; the fcc: and bcc: fields
 203         (let ((mail-self-blind nil)
 204               (mail-archive-file-name nil))
 205           (mail-setup to subject in-reply-to nil replybuffer nil)
 206           (beginning-of-line)
 207           (delete-region (point) (progn (forward-line 1) (point)))
 208           (goto-char (point-max)))
 209       (mail-setup to subject in-reply-to nil replybuffer nil))
 210     ;;;(mail-position-on-field "Posting-Front-End")
 211     ;;;(insert (emacs-version))
 212     (goto-char (point-max))
 213     (if (let ((case-fold-search t))
 214           (re-search-backward "^Subject:" (point-min) t))
 215         (progn (beginning-of-line)
 216                (insert "Newsgroups: " (or newsgroups "") "\n")
 217                (if (not newsgroups)
 218                    (backward-char 1)
 219                  (goto-char (point-max)))))
 220     (run-hooks 'news-setup-hook)))
 221
 222 (defun news-inews ()
 223   "Send a news message using inews."
 224   (interactive)
 225   (let* (newsgroups subject
 226                     (case-fold-search nil))
 227     (save-excursion
 228       (save-restriction
 229         (goto-char (point-min))
 230         (search-forward (concat "\n" mail-header-separator "\n"))
 231         (narrow-to-region (point-min) (point))
 232         (setq newsgroups (mail-fetch-field "newsgroups")
 233               subject (mail-fetch-field "subject")))
 234       (widen)
 235       (goto-char (point-min))
 236       (run-hooks 'news-inews-hook)
 237       (goto-char (point-min))
 238       (search-forward (concat "\n" mail-header-separator "\n"))
 239       (replace-match "\n\n")
 240       (goto-char (point-max))
 241       ;; require a newline at the end for inews to append .signature to
 242       (or (= (preceding-char) ?\n)
 243           (insert ?\n))
 244       (message "Posting to USENET...")
 245       (call-process-region (point-min) (point-max)
 246                            news-inews-program nil 0 nil
 247                            "-h")        ; take all header lines!
 248                            ;@@ setting of subject and newsgroups still needed?
 249                            ;"-t" subject
 250                            ;"-n" newsgroups
 251       (message "Posting to USENET... done")
 252       (goto-char (point-min))           ;restore internal header separator
 253       (search-forward "\n\n")
 254       (replace-match (concat "\n" mail-header-separator "\n"))
 255       (set-buffer-modified-p nil))
 256     (and (fboundp 'bury-buffer) (bury-buffer))))
 257
 258 ;@@ shares some code with news-reply and news-post-news
 259 (defun news-mail-reply ()
 260   "Mail a reply to the author of the current article.
 261 While composing the reply, use \\[news-reply-yank-original] to yank the
 262 original message into it."
 263   (interactive)
 264   (let (from cc subject date to reply-to
 265              (buffer (current-buffer)))
 266     (save-restriction
 267       (narrow-to-region (point-min) (progn (goto-line (point-min))
 268                                            (search-forward "\n\n")
 269                                            (- (point) 1)))
 270       (setq from (mail-fetch-field "from")
 271             subject (mail-fetch-field "subject")
 272             reply-to (mail-fetch-field "reply-to")
 273             date (mail-fetch-field "date")))
 274     (setq to from)
 275     (pop-to-buffer "*mail*")
 276     (mail nil
 277           (if reply-to reply-to to)
 278           subject
 279           (let ((stop-pos (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
 280             (concat (if stop-pos (substring from 0 stop-pos) from)
 281                     "'s message of "
 282                     date))
 283           nil
 284          buffer)))
 285
 286 ;@@ the guts of news-reply and news-post-news should be combined. -tower
 287 (defun news-reply ()
 288   "Compose and post a reply (aka a followup) to the current article on USENET.
 289 While composing the followup, use \\[news-reply-yank-original] to yank the
 290 original message into it."
 291   (interactive)
 292   (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
 293       (let (from cc subject date to followup-to newsgroups message-of
 294                  references distribution message-id
 295                  (buffer (current-buffer)))
 296         (save-restriction
 297           (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
 298                                         ;@@     of article file
 299                (equal major-mode 'news-mode) ;@@ if rmail-mode,
 300                                         ;@@     should show full headers
 301                (progn
 302                  (news-show-all-headers) ;@@ should save/restore header state,
 303                                         ;@@     but rnews.el lacks support
 304                  (narrow-to-region (point-min) (progn (goto-char (point-min))
 305                                                       (search-forward "\n\n")
 306                                                       (- (point) 1)))))
 307           (setq from (mail-fetch-field "from")
 308                 news-reply-yank-from from
 309                 ;; @@ not handling old Title: field
 310                 subject (mail-fetch-field "subject")
 311                 date (mail-fetch-field "date")
 312                 followup-to (mail-fetch-field "followup-to")
 313                 newsgroups (or followup-to
 314                                (mail-fetch-field "newsgroups"))
 315                 references (mail-fetch-field "references")
 316                 ;; @@ not handling old Article-I.D.: field
 317                 distribution (mail-fetch-field "distribution")
 318                 message-id (mail-fetch-field "message-id")
 319                 news-reply-yank-message-id message-id)
 320           (pop-to-buffer "*post-news*")
 321           (news-reply-mode)
 322           (if (and (buffer-modified-p)
 323                    (not
 324                     (y-or-n-p "Unsent article being composed; erase it? ")))
 325               ()
 326             (progn
 327               (erase-buffer)
 328               (and subject
 329                    (progn (if (string-match "\\`Re: " subject)
 330                               (while (string-match "\\`Re: " subject)
 331                                 (setq subject (substring subject 4))))
 332                           (setq subject (concat "Re: " subject))))
 333               (and from
 334                    (progn
 335                      (let ((stop-pos
 336                             (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
 337                        (setq message-of
 338                              (concat
 339                               (if stop-pos (substring from 0 stop-pos) from)
 340                               "'s message of "
 341                               date)))))
 342               (news-setup
 343                nil
 344                subject
 345                message-of
 346                newsgroups
 347                buffer)
 348               (if followup-to
 349                   (progn (news-reply-followup-to)
 350                          (insert followup-to)))
 351               (if distribution
 352                   (progn
 353                     (mail-position-on-field "Distribution")
 354                     (insert distribution)))
 355               (mail-position-on-field "References")
 356               (if references
 357                   (insert references))
 358               (if (and references message-id)
 359                   (insert " "))
 360               (if message-id
 361                   (insert message-id))
 362               (goto-char (point-max))))))
 363     (message "")))
 364
 365 ;@@ the guts of news-reply and news-post-news should be combined. -tower
 366 ;;;###autoload
 367 (defun news-post-news ()
 368   "Begin editing a new USENET news article to be posted.
 369 Type \\[describe-mode] once editing the article to get a list of commands."
 370   (interactive)
 371   (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
 372       (let ((buffer (current-buffer)))
 373         (save-restriction
 374           (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
 375                                         ;@@     of article file
 376                (equal major-mode 'news-mode) ;@@ if rmail-mode,
 377                                         ;@@     should show full headers
 378                (progn
 379                  (news-show-all-headers) ;@@ should save/restore header state,
 380                                         ;@@     but rnews.el lacks support
 381                  (narrow-to-region (point-min) (progn (goto-char (point-min))
 382                                                       (search-forward "\n\n")
 383                                                       (- (point) 1)))))
 384           (setq news-reply-yank-from (mail-fetch-field "from")
 385                 ;; @@ not handling old Article-I.D.: field
 386                 news-reply-yank-message-id (mail-fetch-field "message-id")))
 387         (pop-to-buffer "*post-news*")
 388         (news-reply-mode)
 389         (if (and (buffer-modified-p)
 390                  (not (y-or-n-p "Unsent article being composed; erase it? ")))
 391             ()                          ;@@ not saving point from last time
 392           (progn (erase-buffer)
 393                  (news-setup () () () () buffer))))
 394   (message "")))
 395
 396 (defun news-mail-other-window ()
 397   "Send mail in another window.
 398 While composing the message, use \\[news-reply-yank-original] to yank the
 399 original message into it."
 400   (interactive)
 401   (mail-other-window nil nil nil nil nil (current-buffer)))
 402
 403 ;;; rnewspost.el ends here