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