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