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