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