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

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