|
|
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 distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ;; moved posting and mail code from rnews.el ! 22: ;; [email protected] 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: (insert "In article " news-reply-yank-message-id ! 121: " " news-reply-yank-from " writes:\n\n")) ! 122: ! 123: (defun news-reply-newsgroups () ! 124: "Move point to end of Newsgroups: field. ! 125: RFC 850 constrains the Newsgroups: field to be a comma separated list of valid ! 126: newsgroups names at your site: ! 127: Newsgroups: news.misc,comp.misc,rec.misc" ! 128: (interactive) ! 129: (expand-abbrev) ! 130: (goto-char (point-min)) ! 131: (mail-position-on-field "Newsgroups")) ! 132: ! 133: (defun news-reply-followup-to () ! 134: "Move point to end of Followup-To: field. Create the field if none. ! 135: One usually requests followups to only one newsgroup. ! 136: RFC 850 constrains the Followup-To: field to be a comma separated list of valid ! 137: newsgroups names at your site, that are also in the Newsgroups: field: ! 138: Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc ! 139: Followup-To: news.misc,comp.misc,rec.misc" ! 140: (interactive) ! 141: (expand-abbrev) ! 142: (or (mail-position-on-field "Followup-To" t) ! 143: (progn (mail-position-on-field "newsgroups") ! 144: (insert "\nFollowup-To: "))) ! 145: ;; @@ could do a completing read based on the Newsgroups: field to ! 146: ;; @@ fill in the Followup-To: field ! 147: ) ! 148: ! 149: (defun news-reply-distribution () ! 150: "Move point to end of Distribution: optional field. ! 151: Create the field if none. Without this field the posting goes to all of ! 152: USENET. The field is used to restrict the posting to parts of USENET." ! 153: (interactive) ! 154: (expand-abbrev) ! 155: (mail-position-on-field "Distribution") ! 156: ;; @@could do a completing read based on the news library file: ! 157: ;; @@ ../distributions to fill in the field. ! 158: ) ! 159: ! 160: (defun news-reply-keywords () ! 161: "Move point to end of Keywords: optional field. Create the field if none. ! 162: Used as an aid to the news reader, it can contain a few, well selected keywords ! 163: identifying the message." ! 164: (interactive) ! 165: (expand-abbrev) ! 166: (mail-position-on-field "Keywords")) ! 167: ! 168: (defun news-reply-summary () ! 169: "Move point to end of Summary: optional field. Create the field if none. ! 170: Used as an aid to the news reader, it can contain a succinct ! 171: summary (abstract) of the message." ! 172: (interactive) ! 173: (expand-abbrev) ! 174: (mail-position-on-field "Summary")) ! 175: ! 176: (defun news-reply-signature () ! 177: "The inews program appends ~/.signature automatically." ! 178: (interactive) ! 179: (message "~/.signature will be appended automatically.")) ! 180: ! 181: (defun news-setup (to subject in-reply-to newsgroups replybuffer) ! 182: "Setup the news reply or posting buffer with the proper headers and in ! 183: news-reply-mode." ! 184: (setq mail-reply-buffer replybuffer) ! 185: (let ((mail-setup-hook nil)) ! 186: (if (null to) ! 187: ;; this hack is needed so that inews wont be confused by ! 188: ;; the fcc: and bcc: fields ! 189: (let ((mail-self-blind nil) ! 190: (mail-archive-file-name nil)) ! 191: (mail-setup to subject in-reply-to nil replybuffer) ! 192: (beginning-of-line) ! 193: (kill-line 1) ! 194: (goto-char (point-max))) ! 195: (mail-setup to subject in-reply-to nil replybuffer)) ! 196: ;;;(mail-position-on-field "Posting-Front-End") ! 197: ;;;(insert (emacs-version)) ! 198: (goto-char (point-max)) ! 199: (if (let ((case-fold-search t)) ! 200: (re-search-backward "^Subject:" (point-min) t)) ! 201: (progn (beginning-of-line) ! 202: (insert "Newsgroups: " (or newsgroups "") "\n") ! 203: (if (not newsgroups) ! 204: (backward-char 1) ! 205: (goto-char (point-max))))) ! 206: (run-hooks 'news-setup-hook))) ! 207: ! 208: (defun news-inews () ! 209: "Send a news message using inews." ! 210: (interactive) ! 211: (let* (newsgroups subject ! 212: (case-fold-search nil)) ! 213: (save-excursion ! 214: (save-restriction ! 215: (goto-char (point-min)) ! 216: (search-forward (concat "\n" mail-header-separator "\n")) ! 217: (narrow-to-region (point-min) (point)) ! 218: (setq newsgroups (mail-fetch-field "newsgroups") ! 219: subject (mail-fetch-field "subject"))) ! 220: (widen) ! 221: (goto-char (point-min)) ! 222: (run-hooks 'news-inews-hook) ! 223: (goto-char (point-min)) ! 224: (search-forward (concat "\n" mail-header-separator "\n")) ! 225: (replace-match "\n\n") ! 226: (goto-char (point-max)) ! 227: ;; require a newline at the end for inews to append .signature to ! 228: (or (= (preceding-char) ?\n) ! 229: (insert ?\n)) ! 230: (message "Posting to USENET...") ! 231: (call-process-region (point-min) (point-max) ! 232: news-inews-program nil 0 nil ! 233: "-h") ; take all header lines! ! 234: ;@@ setting of subject and newsgroups still needed? ! 235: ;"-t" subject ! 236: ;"-n" newsgroups ! 237: (message "Posting to USENET... done") ! 238: (goto-char (point-min)) ;restore internal header separator ! 239: (search-forward "\n\n") ! 240: (replace-match (concat "\n" mail-header-separator "\n")) ! 241: (set-buffer-modified-p nil)) ! 242: (and (fboundp 'bury-buffer) (bury-buffer)))) ! 243: ! 244: ;@@ shares some code with news-reply and news-post-news ! 245: (defun news-mail-reply () ! 246: "Mail a reply to the author of the current article. ! 247: While composing the reply, use \\[news-reply-yank-original] to yank the ! 248: original message into it." ! 249: (interactive) ! 250: (let (from cc subject date to reply-to ! 251: (buffer (current-buffer))) ! 252: (save-restriction ! 253: (narrow-to-region (point-min) (progn (goto-line (point-min)) ! 254: (search-forward "\n\n") ! 255: (- (point) 2))) ! 256: (setq from (mail-fetch-field "from") ! 257: subject (mail-fetch-field "subject") ! 258: reply-to (mail-fetch-field "reply-to") ! 259: date (mail-fetch-field "date")) ! 260: (setq to from) ! 261: (pop-to-buffer "*mail*") ! 262: (mail nil ! 263: (if reply-to reply-to to) ! 264: subject ! 265: (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) ! 266: (concat (if stop-pos (substring from 0 stop-pos) from) ! 267: "'s message of " ! 268: date)) ! 269: nil ! 270: buffer)))) ! 271: ! 272: ;@@ the guts of news-reply and news-post-news should be combined. -tower ! 273: (defun news-reply () ! 274: "Compose and post a reply (aka a followup) to the current article on USENET. ! 275: While composing the followup, use \\[news-reply-yank-original] to yank the ! 276: original message into it." ! 277: (interactive) ! 278: (if (y-or-n-p "Are you sure you want to followup to all of USENET? ") ! 279: (let (from cc subject date to followup-to newsgroups message-of ! 280: references distribution message-id ! 281: (buffer (current-buffer))) ! 282: (save-restriction ! 283: (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of ! 284: ;@@ of article file ! 285: (equal major-mode 'news-mode) ;@@ if rmail-mode, ! 286: ;@@ should show full headers ! 287: (progn ! 288: (news-show-all-headers) ;@@ should save/restore header state, ! 289: ;@@ but rnews.el lacks support ! 290: (narrow-to-region (point-min) (progn (goto-char (point-min)) ! 291: (search-forward "\n\n") ! 292: (- (point) 2))))) ! 293: (setq from (mail-fetch-field "from") ! 294: news-reply-yank-from from ! 295: ;; @@ not handling old Title: field ! 296: subject (mail-fetch-field "subject") ! 297: date (mail-fetch-field "date") ! 298: followup-to (mail-fetch-field "followup-to") ! 299: newsgroups (or followup-to ! 300: (mail-fetch-field "newsgroups")) ! 301: references (mail-fetch-field "references") ! 302: ;; @@ not handling old Article-I.D.: field ! 303: distribution (mail-fetch-field "distribution") ! 304: message-id (mail-fetch-field "message-id") ! 305: news-reply-yank-message-id message-id) ! 306: (pop-to-buffer "*post-news*") ! 307: (news-reply-mode) ! 308: (if (and (buffer-modified-p) ! 309: (not ! 310: (y-or-n-p "Unsent article being composed; erase it? "))) ! 311: () ! 312: (progn ! 313: (erase-buffer) ! 314: (and subject ! 315: (progn (if (string-match "\\`Re: " subject) ! 316: (while (string-match "\\`Re: " subject) ! 317: (setq subject (substring subject 4)))) ! 318: (setq subject (concat "Re: " subject)))) ! 319: (and from ! 320: (progn ! 321: (let ((stop-pos ! 322: (string-match " *at \\| *@ \\| *(\\| *<" from))) ! 323: (setq message-of ! 324: (concat ! 325: (if stop-pos (substring from 0 stop-pos) from) ! 326: "'s message of " ! 327: date))))) ! 328: (news-setup ! 329: nil ! 330: subject ! 331: message-of ! 332: newsgroups ! 333: buffer) ! 334: (if followup-to ! 335: (progn (news-reply-followup-to) ! 336: (insert followup-to))) ! 337: (if distribution ! 338: (progn ! 339: (mail-position-on-field "Distribution") ! 340: (insert distribution))) ! 341: (mail-position-on-field "References") ! 342: (if references ! 343: (insert references)) ! 344: (if (and references message-id) ! 345: (insert " ")) ! 346: (if message-id ! 347: (insert message-id)) ! 348: (goto-char (point-max)))))) ! 349: (message ""))) ! 350: ! 351: ;@@ the guts of news-reply and news-post-news should be combined. -tower ! 352: (defun news-post-news () ! 353: "Begin editing a new USENET news article to be posted. ! 354: Type \\[describe-mode] once editing the article to get a list of commands." ! 355: (interactive) ! 356: (if (y-or-n-p "Are you sure you want to post to all of USENET? ") ! 357: (let ((buffer (current-buffer))) ! 358: (save-restriction ! 359: (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of ! 360: ;@@ of article file ! 361: (equal major-mode 'news-mode) ;@@ if rmail-mode, ! 362: ;@@ should show full headers ! 363: (progn ! 364: (news-show-all-headers) ;@@ should save/restore header state, ! 365: ;@@ but rnews.el lacks support ! 366: (narrow-to-region (point-min) (progn (goto-char (point-min)) ! 367: (search-forward "\n\n") ! 368: (- (point) 2))))) ! 369: (setq news-reply-yank-from (mail-fetch-field "from") ! 370: ;; @@ not handling old Article-I.D.: field ! 371: news-reply-yank-message-id (mail-fetch-field "message-id"))) ! 372: (pop-to-buffer "*post-news*") ! 373: (news-reply-mode) ! 374: (if (and (buffer-modified-p) ! 375: (not (y-or-n-p "Unsent article being composed; erase it? "))) ! 376: () ;@@ not saving point from last time ! 377: (progn (erase-buffer) ! 378: (news-setup () () () () buffer)))) ! 379: (message ""))) ! 380: ! 381: (defun news-mail-other-window () ! 382: "Send mail in another window. ! 383: While composing the message, use \\[news-reply-yank-original] to yank the ! 384: original message into it." ! 385: (interactive) ! 386: (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.