![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rnews.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to rnews.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 ! root 1: ;;; Netnews reader for gnu emacs ! 2: ;; Copyright (C) 1985 Free Software Foundation ! 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: ! 22: ;;; Created Sun Mar 10,1985 at 21:35:01 ads and sundar ! 23: ;;; Should do the point pdl stuff sometime ! 24: ;;; finito except pdl.... Sat Mar 16,1985 at 06:43:44 ! 25: ;;; lets keep the summary stuff out until we get it working .. ! 26: ;;; sundar Wed Apr 10,1985 at 16:32:06 ! 27: ;;; hack slash maim. mly Thu 18 Apr, 1985 06:11:14 ! 28: ;;; news-add-news-group / 'stead of . bug tower Mon Mar 3 15:39:44 EST 1986 ! 29: ;;; news-mail-reply from anywhere in buffer tower Wed Mar 12 11:15:03 EST 1986 ! 30: ;;; modified to correct reentrance bug, to not bother with groups that ! 31: ;;; received no new traffic since last read completely, to find out ! 32: ;;; what traffic a group has available much more quickly when ! 33: ;;; possible, to do some completing reads for group names - should ! 34: ;;; be much faster... ! 35: ;;; KING@KESTREL, Thu Mar 13 09:03:28 1986 ! 36: ;;; fixed doc error tower Sun Mar 16 14:25:43 EST 1986 ! 37: (require 'mail-utils) ! 38: ! 39: ;Now in paths.el. ! 40: ;(defvar news-path "/usr/spool/news/" ! 41: ; "The root directory below which all news files are stored.") ! 42: ;(defvar news-inews-program "inews" ! 43: ; "Function to post news.") ! 44: ! 45: (defvar news-startup-file "$HOME/.newsrc" "Contains ~/.newsrc") ! 46: (defvar news-certification-file "$HOME/.news-dates" "Contains ~/.news-dates") ! 47: ! 48: ;;; random headers that we decide to ignore. ! 49: (defvar news-ignored-headers ! 50: "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Followup-To:\\|^Expires:\\|^Date-Received:\\|^Organization:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:" ! 51: "All random fields within the header of a message.") ! 52: ! 53: (defvar news-mode-map nil) ! 54: (defvar news-read-first-time-p t) ! 55: ;; Contains the (dotified) news groups of which you are a member. ! 56: (defvar news-user-group-list nil) ! 57: ! 58: (defvar news-current-news-group nil) ! 59: (defvar news-current-group-begin nil) ! 60: (defvar news-current-group-end nil) ! 61: (defvar news-current-certifications nil ! 62: "An assoc list of a group name and the time at which it is ! 63: known that the grop had no new traffic") ! 64: (defvar news-current-certifiable nil ! 65: "The time when the directory we are now working on was written") ! 66: ! 67: ! 68: (defvar news-message-filter nil ! 69: "User specifiable filter function that will be called during ! 70: formatting of the news file") ! 71: ! 72: ;(defvar news-mode-group-string "Starting-Up" ! 73: ; "Mode line group name info is held in this variable") ! 74: (defvar news-list-of-files nil ! 75: "Global variable in which we store the list of files ! 76: associated with the current newsgroup") ! 77: (defvar news-list-of-files-possibly-bogus nil ! 78: "variable indicating we only are guessing at which files are available. ! 79: Not currently used.") ! 80: ! 81: ;; association list in which we store lists of the form ! 82: ;; (pointified-group-name (first last old-last)) ! 83: (defvar news-group-article-assoc nil) ! 84: ! 85: (defvar news-current-message-number 0 "Displayed Article Number") ! 86: (defvar news-total-current-group 0 "Total no of messages in group") ! 87: ! 88: (defvar news-unsubscribe-groups ()) ! 89: (defvar news-point-pdl () "List of visited news messages.") ! 90: (defvar news-no-jumps-p t) ! 91: (defvar news-buffer () "Buffer into which news files are read.") ! 92: ! 93: (defmacro caar (x) (list 'car (list 'car x))) ! 94: (defmacro cadr (x) (list 'car (list 'cdr x))) ! 95: (defmacro cdar (x) (list 'cdr (list 'car x))) ! 96: (defmacro caddr (x) (list 'car (list 'cdr (list 'cdr x)))) ! 97: (defmacro cadar (x) (list 'car (list 'cdr (list 'car x)))) ! 98: (defmacro caadr (x) (list 'car (list 'car (list 'cdr x)))) ! 99: (defmacro cdadr (x) (list 'cdr (list 'car (list 'cdr x)))) ! 100: ! 101: (defmacro news-wins (pfx index) ! 102: (` (file-exists-p (concat (, pfx) "/" (int-to-string (, index)))))) ! 103: ! 104: (defvar news-max-plausible-gap 2 ! 105: "* In an rnews directory, the maximum possible gap size. ! 106: A gap is a sequence of missing messages between two messages that exist. ! 107: An empty file does not contribute to a gap -- it ends one.") ! 108: ! 109: (defun news-find-first-and-last (prefix base) ! 110: (and (news-wins prefix base) ! 111: (cons (news-find-first-or-last prefix base -1) ! 112: (news-find-first-or-last prefix base 1)))) ! 113: ! 114: (defmacro // (a1 a2) ! 115: ;;; a form of / that guarantees that (/ -1 2) = 0 ! 116: (if (zerop (/ -1 2)) ! 117: (` (/ (, a1) (, a2))) ! 118: (` (if (< (, a1) 0) ! 119: (- (/ (- (, a1)) (, a2))) ! 120: (/ (, a1) (, a2)))))) ! 121: ! 122: (defun news-find-first-or-last (pfx base dirn) ! 123: ;; first use powers of two to find a plausible cieling ! 124: (let ((original-dir dirn)) ! 125: (while (news-wins pfx (+ base dirn)) ! 126: (setq dirn (* dirn 2))) ! 127: (setq dirn (// dirn 2)) ! 128: ;;; Then use a binary search to find the high water mark ! 129: (let ((offset (// dirn 2))) ! 130: (while (/= offset 0) ! 131: (if (news-wins pfx (+ base dirn offset)) ! 132: (setq dirn (+ dirn offset))) ! 133: (setq offset (// offset 2)))) ! 134: ;;; If this high-water mark is bogus, recurse. ! 135: (let ((offset (* news-max-plausible-gap original-dir))) ! 136: (while (and (/= offset 0) (not (news-wins pfx (+ base dirn offset)))) ! 137: (setq offset (- offset original-dir))) ! 138: (if (= offset 0) ! 139: (+ base dirn) ! 140: (news-find-first-or-last pfx (+ base dirn offset) original-dir))))) ! 141: ! 142: (defun rnews () ! 143: "Read netnews for groups for which you are a member and add or delete groups. ! 144: You can reply to articles posted and send articles to any group. ! 145: Type Help m once reading news to get a list of rnews commands." ! 146: (interactive) ! 147: (let ((last-buffer (buffer-name))) ! 148: (switch-to-buffer (setq news-buffer (get-buffer-create "*news*"))) ! 149: (news-mode) ! 150: (setq news-buffer-save last-buffer) ! 151: (setq buffer-read-only nil) ! 152: (erase-buffer) ! 153: (setq buffer-read-only t) ! 154: (set-buffer-modified-p t) ! 155: (sit-for 0) ! 156: (message "Getting new net news...") ! 157: (news-set-mode-line) ! 158: (news-get-certifications) ! 159: (news-get-new-news))) ! 160: ! 161: (defun news-group-certification (group) ! 162: (cdr-safe (assoc group news-current-certifications))) ! 163: ! 164: ! 165: (defun news-set-current-certifiable () ! 166: ;;; Record the date that corresponds to the directory you are about to check ! 167: (let ((file (concat news-path ! 168: (string-subst-char ?/ ?. news-current-news-group)))) ! 169: (setq news-current-certifiable ! 170: (nth 5 (file-attributes ! 171: (or (file-symlink-p file) file)))))) ! 172: ! 173: (defun news-get-certifications () ! 174: ;;; Read the certified-read file from last session ! 175: (save-excursion ! 176: (save-window-excursion ! 177: (setq news-current-certifications ! 178: (car-safe ! 179: (condition-case var ! 180: (let* ! 181: ((file (substitute-in-file-name news-certification-file)) ! 182: (buf (find-file-noselect file))) ! 183: (and (file-exists-p file) ! 184: (progn ! 185: (switch-to-buffer buf 'norecord) ! 186: (unwind-protect ! 187: (read-from-string (buffer-string)) ! 188: (kill-buffer buf))))) ! 189: (error nil))))))) ! 190: ! 191: (defun news-write-certifications () ! 192: ;;; Write a certification file. This is an assoc list of group names with ! 193: ;;;doubletons that represent mod times of the directory when group is read ! 194: ;;;completely. ! 195: (save-excursion ! 196: (save-window-excursion ! 197: (with-output-to-temp-buffer ! 198: "*CeRtIfIcAtIoNs*" ! 199: (print news-current-certifications)) ! 200: (let ((buf (get-buffer "*CeRtIfIcAtIoNs*"))) ! 201: (switch-to-buffer buf) ! 202: (write-file (substitute-in-file-name news-certification-file)) ! 203: (kill-buffer buf))))) ! 204: ! 205: (defun news-set-current-group-certification () ! 206: (let ((cgc (assoc news-current-news-group news-current-certifications))) ! 207: (if cgc (setcdr cgc news-current-certifiable) ! 208: (push (cons news-current-news-group news-current-certifiable) ! 209: news-current-certifications)))) ! 210: ! 211: (defun news-set-minor-modes () ! 212: "Creates a minor mode list that has group name, total articles, ! 213: and attribute for current article." ! 214: (setq minor-modes (list (cons 'foo ! 215: (concat news-current-message-number ! 216: "/" ! 217: news-total-current-group ! 218: (news-get-attribute-string)))))) ! 219: ! 220: (defun news-set-message-counters () ! 221: "Scan through current news-groups filelist to figure out how many messages ! 222: are there. Set counters for use with minor mode display." ! 223: (if (null news-list-of-files) ! 224: (setq news-current-message-number 0))) ! 225: ! 226: (if news-mode-map ! 227: nil ! 228: (setq news-mode-map (make-keymap)) ! 229: (suppress-keymap news-mode-map) ! 230: (define-key news-mode-map "." 'beginning-of-buffer) ! 231: (define-key news-mode-map " " 'scroll-up) ! 232: (define-key news-mode-map "\177" 'scroll-down) ! 233: (define-key news-mode-map "n" 'news-next-message) ! 234: (define-key news-mode-map "c" 'news-make-link-to-message) ! 235: (define-key news-mode-map "p" 'news-previous-message) ! 236: (define-key news-mode-map "j" 'news-goto-message) ! 237: (define-key news-mode-map "q" 'news-exit) ! 238: (define-key news-mode-map "e" 'news-exit) ! 239: (define-key news-mode-map "\ej" 'news-goto-news-group) ! 240: (define-key news-mode-map "\en" 'news-next-group) ! 241: (define-key news-mode-map "\ep" 'news-previous-group) ! 242: (define-key news-mode-map "l" 'news-list-news-groups) ! 243: (define-key news-mode-map "?" 'describe-mode) ! 244: (define-key news-mode-map "g" 'news-get-new-news) ! 245: (define-key news-mode-map "f" 'news-reply) ! 246: (define-key news-mode-map "m" 'news-mail-other-window) ! 247: (define-key news-mode-map "a" 'news-post-news) ! 248: (define-key news-mode-map "r" 'news-mail-reply) ! 249: (define-key news-mode-map "o" 'news-save-item-in-file) ! 250: (define-key news-mode-map "t" 'news-show-all-headers) ! 251: (define-key news-mode-map "x" 'news-force-update) ! 252: (define-key news-mode-map "A" 'news-add-news-group) ! 253: (define-key news-mode-map "u" 'news-unsubscribe-current-group) ! 254: (define-key news-mode-map "U" 'news-unsubscribe-group)) ! 255: ! 256: (defun news-mode () ! 257: "News Mode is used by M-x rnews for editing News files. ! 258: All normal editing commands are turned off. ! 259: Instead, these commands are available: ! 260: ! 261: . move point to front of this news article (same as Meta-<). ! 262: Space scroll to next screen of this news article. ! 263: Delete scroll down previous page of this news article. ! 264: n move to next news article, possibly next group. ! 265: p move to previous news article, possibly previous group. ! 266: j jump to news article specified by numeric position. ! 267: M-j jump to news group. ! 268: M-n goto next news group. ! 269: M-p goto previous news group. ! 270: l list all the news groups with current status. ! 271: ? print this help message. ! 272: g get new net news. ! 273: f post follow-up article to the net. ! 274: a post a news article. ! 275: A add a newsgroup. ! 276: o save the current article in the named file (append if file exists). ! 277: c \"copy\" (actually link) current or prefix-arg msg to file. ! 278: warning: target directory and message file must be on same device ! 279: (UNIX magic) ! 280: t show all the headers this news article originally had. ! 281: q quit reading news after updating .newsrc file. ! 282: e exit updating .newsrc file. ! 283: m mail a news article. Same as C-x 4 m. ! 284: x update last message seen to be the current message. ! 285: r reply to this news article. Like m but initializes some fields. ! 286: u unsubscribe from current newsgroup. ! 287: U unsubscribe from specified newsgroup." ! 288: (interactive) ! 289: (kill-all-local-variables) ! 290: (make-local-variable 'news-read-first-time-p) ! 291: (setq news-read-first-time-p t) ! 292: (make-local-variable 'news-current-news-group) ! 293: ; (setq news-current-news-group "??") ! 294: (make-local-variable 'news-current-group-begin) ! 295: (setq news-current-group-begin 0) ! 296: (make-local-variable 'news-current-message-number) ! 297: (setq news-current-message-number 0) ! 298: (make-local-variable 'news-total-current-group) ! 299: (make-local-variable 'news-buffer-save) ! 300: (make-local-variable 'version-control) ! 301: (setq version-control 'never) ! 302: (make-local-variable 'news-point-pdl) ! 303: ; This breaks it. I don't have time to figure out why. -- RMS ! 304: ; (make-local-variable 'news-group-article-assoc) ! 305: (setq major-mode 'news-mode) ! 306: (setq mode-name "NEWS") ! 307: (news-set-mode-line) ! 308: (set-syntax-table text-mode-syntax-table) ! 309: (use-local-map news-mode-map) ! 310: (setq local-abbrev-table text-mode-abbrev-table) ! 311: (run-hooks 'news-mode-hook)) ! 312: ! 313: (defun string-subst-char (new old string) ! 314: (let (index) ! 315: (setq old (regexp-quote (char-to-string old)) ! 316: string (substring string 0)) ! 317: (while (setq index (string-match old string)) ! 318: (aset string index new))) ! 319: string) ! 320: ! 321: ;;; update read message number ! 322: (defmacro news-update-message-read (ngroup nno) ! 323: (list 'setcar ! 324: (list 'cdadr ! 325: (list 'assoc ngroup 'news-group-article-assoc)) ! 326: nno)) ! 327: ! 328: (defun news-parse-range (number-string) ! 329: "Parse string representing range of numbers of he form <a>-<b> ! 330: to a list (a . b)" ! 331: (let ((n (string-match "-" number-string))) ! 332: (if n ! 333: (cons (string-to-int (substring number-string 0 n)) ! 334: (string-to-int (substring number-string (1+ n)))) ! 335: (setq n (string-to-int number-string)) ! 336: (cons n n)))) ! 337: ! 338: ;(defun is-in (elt lis) ! 339: ; (catch 'foo ! 340: ; (while lis ! 341: ; (if (equal (car lis) elt) ! 342: ; (throw 'foo t) ! 343: ; (setq lis (cdr lis)))))) ! 344: ! 345: ! 346: (defun news-get-new-news () ! 347: "Get new netnews if there is any for the current user." ! 348: (interactive) ! 349: (if (not (null news-user-group-list)) ! 350: (news-update-newsrc-file)) ! 351: (setq news-group-article-assoc ()) ! 352: (setq news-user-group-list ()) ! 353: (message "Looking up .newsrc file...") ! 354: (let ((file (substitute-in-file-name news-startup-file)) ! 355: (temp-user-groups ())) ! 356: (save-excursion ! 357: (let ((newsrcbuf (find-file-noselect file)) ! 358: start end endofline tem) ! 359: (set-buffer newsrcbuf) ! 360: (goto-char 0) ! 361: (while (search-forward ": " nil t) ! 362: (setq end (point)) ! 363: (beginning-of-line) ! 364: (setq start (point)) ! 365: (end-of-line) ! 366: (setq endofline (point)) ! 367: (setq tem (buffer-substring start (- end 2))) ! 368: (let ((range (news-parse-range ! 369: (buffer-substring end endofline)))) ! 370: ! 371: ; (if (is-in tem temp-user-groups) ! 372: ; (progn ! 373: ; (setq temp-user-groups (delq tem temp-user-groups)) ! 374: ; (setq news-group-article-assoc ! 375: ; (delq (assoc tem news-group-article-assoc) ! 376: ; news-group-article-assoc)) ! 377: ; (message "Subscribed to the same group twice?"))) ! 378: ! 379: (setq temp-user-groups (cons tem temp-user-groups) ! 380: news-group-article-assoc ! 381: (cons (list tem (list (car range) ! 382: (cdr range) ! 383: (cdr range))) ! 384: news-group-article-assoc)))) ! 385: (kill-buffer newsrcbuf))) ! 386: (setq temp-user-groups (nreverse temp-user-groups)) ! 387: (message "Prefrobnicating...") ! 388: (switch-to-buffer news-buffer) ! 389: (setq news-user-group-list temp-user-groups) ! 390: (while (and temp-user-groups ! 391: (not (news-read-files-into-buffer ! 392: (car temp-user-groups) nil))) ! 393: (setq temp-user-groups (cdr temp-user-groups))) ! 394: (if (null temp-user-groups) ! 395: (message "No news is good news.") ! 396: (message "")))) ! 397: ! 398: (defun news-list-news-groups () ! 399: "Display all the news groups to which you belong." ! 400: (interactive) ! 401: (if (null news-user-group-list) ! 402: (message "No user groups read yet!") ! 403: (let ((buffer-read-only ())) ! 404: (setq mode-line-format "--%%--[q: to goback, space: scroll-forward, delete:scroll-backward] %M --%--") ! 405: (local-set-key " " 'scroll-up) ! 406: (local-set-key "\177" 'scroll-down) ! 407: (local-set-key "q" 'news-get-back) ! 408: (goto-char 0) ! 409: (save-excursion ! 410: (erase-buffer) ! 411: (insert ! 412: "News Group Msg No. News Group Msg No.\n") ! 413: (insert ! 414: "------------------------- -------------------------\n") ! 415: (let ((temp news-user-group-list) ! 416: (flag nil)) ! 417: (while temp ! 418: (let ((item (assoc (car temp) news-group-article-assoc))) ! 419: (insert (car item)) ! 420: (indent-to (if flag 52 20)) ! 421: (insert (int-to-string (cadr (cadr item)))) ! 422: (if flag ! 423: (insert "\n") ! 424: (indent-to 33)) ! 425: (setq temp (cdr temp) flag (not flag))))))))) ! 426: ! 427: (defun news-get-back () ! 428: "Called when you quit from seeing the news groups list." ! 429: (interactive) ! 430: (let ((buffer-read-only ())) ! 431: (erase-buffer) ! 432: (local-set-key "q" 'news-exit) ! 433: (news-set-mode-line) ! 434: (news-read-in-file ! 435: (concat news-path ! 436: (string-subst-char ?/ ?. news-current-news-group) ! 437: "/" (int-to-string news-current-message-number))))) ! 438: ! 439: (defun strcpyn (str1 str2 len) ! 440: (if (string= str2 "") ! 441: str1 ! 442: (while (>= len 0) ! 443: (aset str1 len (aref str2 len)) ! 444: (setq len (1- len))) ! 445: str1)) ! 446: ! 447: ;; Mode line hack ! 448: (defun news-set-mode-line () ! 449: "Set mode line string to something useful." ! 450: (let ((tem (1- (length news-current-news-group))) ! 451: (idx 0) ! 452: (buffer-modified-p ())) ! 453: (setq mode-line-format ! 454: (concat "--%1*%1*-NEWS: " ! 455: (if (> tem 15) ! 456: news-current-news-group ! 457: (let ((string (make-string 16 ? ))) ! 458: (setq idx 0) ! 459: (while (<= idx tem) ! 460: (aset string idx (aref news-current-news-group idx)) ! 461: (setq idx (1+ idx))) ! 462: string)) ! 463: " [" ! 464: (if (integerp news-current-message-number) ! 465: (int-to-string news-current-message-number) ! 466: "??") ! 467: "/" ! 468: (if (integerp news-current-group-end) ! 469: (int-to-string news-current-group-end) ! 470: news-current-group-end) ! 471: "] %M ----%3p-%-")) ! 472: (set-buffer-modified-p t) ! 473: (sit-for 0))) ! 474: ! 475: (defun news-goto-news-group (gp) ! 476: "Takes a string and goes to that news group." ! 477: (interactive (list (completing-read "NewsGroup: " ! 478: news-group-article-assoc))) ! 479: (message "Jumping to news group %s..." gp) ! 480: (news-select-news-group gp) ! 481: (message "Jumping to news group %s... done." gp)) ! 482: ! 483: (defun news-select-news-group (gp) ! 484: (let ((grp (assoc gp news-group-article-assoc))) ! 485: (if (null grp) ! 486: (error "No more news groups") ! 487: (progn ! 488: (news-update-message-read news-current-news-group ! 489: (cdar news-point-pdl)) ! 490: (news-read-files-into-buffer (car grp) nil) ! 491: (news-set-mode-line))))) ! 492: ! 493: (defun news-goto-message (arg) ! 494: "Goes to the article ARG in current newsgroup." ! 495: (interactive "p") ! 496: (if (null current-prefix-arg) ! 497: (setq arg (read-no-blanks-input "Go to article: " ""))) ! 498: (news-select-message arg)) ! 499: ! 500: (defun news-select-message (arg) ! 501: (if (stringp arg) (setq arg (string-to-int arg))) ! 502: (let ((file (concat news-path ! 503: (string-subst-char ?/ ?. news-current-news-group) ! 504: "/" arg))) ! 505: (if (file-exists-p file) ! 506: (let ((buffer-read-only ())) ! 507: (if (= arg ! 508: (or (cadr (memq (cdar news-point-pdl) news-list-of-files)) ! 509: 0)) ! 510: (setcdr (car news-point-pdl) arg)) ! 511: (setq news-current-message-number arg) ! 512: (news-read-in-file file) ! 513: (news-set-mode-line)) ! 514: (error "Article %d nonexistent" arg)))) ! 515: ! 516: (defun news-force-update () ! 517: "updates the position of last article read in the current news group" ! 518: (interactive) ! 519: (setcdr (car news-point-pdl) news-current-message-number) ! 520: (message "Updated to %d" news-current-message-number)) ! 521: ! 522: (defun news-next-message (arg) ! 523: "Move ARG messages forward within one newsgroup. ! 524: Negative ARG moves backward. ! 525: If ARG is 1 or -1, moves to next or previous newsgroup if at end." ! 526: (interactive "p") ! 527: (let ((no (+ arg news-current-message-number))) ! 528: (if (or (< no news-current-group-begin) ! 529: (> no news-current-group-end)) ! 530: (cond ((= arg 1) ! 531: (news-set-current-group-certification) ! 532: (news-next-group) ! 533: (while (null news-list-of-files) ! 534: (news-next-group))) ! 535: ((= arg -1) ! 536: (news-previous-group) ! 537: (while (null news-list-of-files) ! 538: (news-previous-group))) ! 539: (t (error "Article out of range"))) ! 540: (let ((plist (news-get-motion-lists ! 541: news-current-message-number ! 542: news-list-of-files))) ! 543: (if (< arg 0) ! 544: (news-select-message (nth (1- (- arg)) (car (cdr plist)))) ! 545: (news-select-message (nth (1- arg) (car plist)))))))) ! 546: ! 547: (defun news-previous-message (arg) ! 548: "Move ARG messages backward in current newsgroup. ! 549: With no arg or arg of 1, move one message ! 550: and move to previous newsgroup if at beginning. ! 551: A negative ARG means move forward." ! 552: (interactive "p") ! 553: (news-next-message (- arg))) ! 554: ! 555: (defun news-move-to-group (arg) ! 556: "Given arg move forward or backward to a new newsgroup." ! 557: (let ((cg news-current-news-group)) ! 558: (let ((plist (news-get-motion-lists cg news-user-group-list)) ! 559: ngrp) ! 560: (if (< arg 0) ! 561: (or (setq ngrp (nth (1- (- arg)) (cadr plist))) ! 562: (error "No more news groups")) ! 563: (or (setq ngrp (nth arg (car plist))) ! 564: (error "No previous news groups"))) ! 565: (news-select-news-group ngrp)))) ! 566: ! 567: (defun news-next-group () ! 568: "Moves to the next user group." ! 569: (interactive) ! 570: ; (message "Moving to next group...") ! 571: (news-move-to-group 0)) ! 572: ; (message "Moving to next group... done.") ! 573: ! 574: (defun news-previous-group () ! 575: "Moves to the previous user group." ! 576: (interactive) ! 577: ; (message "Moving to previous group...") ! 578: (news-move-to-group -1)) ! 579: ; (message "Moving to previous group... done.") ! 580: ! 581: (defun news-get-motion-lists (arg listy) ! 582: "Given a msgnumber/group this will return a list of two lists; ! 583: one for moving forward and one for moving backward." ! 584: (let ((temp listy) ! 585: (result ())) ! 586: (catch 'out ! 587: (while temp ! 588: (if (equal (car temp) arg) ! 589: (throw 'out (cons (cdr temp) (list result))) ! 590: (setq result (nconc (list (car temp)) result)) ! 591: (setq temp (cdr temp))))))) ! 592: ! 593: ;; miscellaneous io routines ! 594: (defun news-read-in-file (filename) ! 595: (erase-buffer) ! 596: (let ((start (point))) ! 597: (insert-file-contents filename) ! 598: (news-convert-format) ! 599: (goto-char start) ! 600: (forward-line 1) ! 601: (if (eobp) ! 602: (message "(Empty file?)") ! 603: (goto-char start)))) ! 604: ! 605: (defun news-convert-format () ! 606: (save-excursion ! 607: (save-restriction ! 608: (let* ((start (point)) ! 609: (end (condition-case () ! 610: (progn (search-forward "\n\n") (point)) ! 611: (error nil))) ! 612: has-from has-date) ! 613: (cond (end ! 614: (narrow-to-region start end) ! 615: (goto-char start) ! 616: (setq has-from (search-forward "\nFrom:" nil t)) ! 617: (cond ((and (not has-from) has-date) ! 618: (goto-char start) ! 619: (search-forward "\nDate:") ! 620: (beginning-of-line) ! 621: (kill-line) (kill-line))) ! 622: (news-delete-headers start) ! 623: (goto-char start))))))) ! 624: ! 625: (defun news-show-all-headers () ! 626: "Redisplay current news item with all original headers" ! 627: (interactive) ! 628: (let (news-ignored-headers) ! 629: (news-get-back))) ! 630: ! 631: (defun news-delete-headers (pos) ! 632: (goto-char pos) ! 633: (and (stringp news-ignored-headers) ! 634: (while (re-search-forward news-ignored-headers nil t) ! 635: (beginning-of-line) ! 636: (delete-region (point) ! 637: (progn (re-search-forward "\n[^ \t]") ! 638: (forward-char -1) ! 639: (point)))))) ! 640: ! 641: (defun news-exit () ! 642: "Quit news reading session and update the newsrc file." ! 643: (interactive) ! 644: (if (y-or-n-p "Do you really wanna quit reading news ? ") ! 645: (progn (message "Updating .newsrc...") ! 646: (news-update-newsrc-file) ! 647: (news-write-certifications) ! 648: (message "Updating .newsrc... done") ! 649: (message "Now do some real work") ! 650: (and (fboundp 'bury-buffer) (bury-buffer (current-buffer))) ! 651: (switch-to-buffer news-buffer-save) ! 652: (setq news-user-group-list ())) ! 653: (message ""))) ! 654: ! 655: (defun news-update-newsrc-file () ! 656: "Updates the newsrc file in the users home dir." ! 657: (let ((newsrcbuf (find-file-noselect ! 658: (substitute-in-file-name news-startup-file))) ! 659: (tem news-user-group-list) ! 660: group) ! 661: (save-excursion ! 662: (if (not (null news-current-news-group)) ! 663: (news-update-message-read news-current-news-group ! 664: (cdar news-point-pdl))) ! 665: (switch-to-buffer newsrcbuf) ! 666: (while tem ! 667: (setq group (assoc (car tem) ! 668: news-group-article-assoc)) ! 669: (if (= (cadr (cadr group)) (caddr (cadr group))) ! 670: nil ! 671: (goto-char 0) ! 672: (if (search-forward (concat (car group) ": ") nil t) ! 673: (kill-line nil) ! 674: (insert (car group) ": \n") (backward-char 1)) ! 675: (insert (int-to-string (car (cadr group))) "-" ! 676: (int-to-string (cadr (cadr group))))) ! 677: (setq tem (cdr tem))) ! 678: (while news-unsubscribe-groups ! 679: (setq group (assoc (car news-unsubscribe-groups) ! 680: news-group-article-assoc)) ! 681: (goto-char 0) ! 682: (if (search-forward (concat (car group) ": ") nil t) ! 683: (progn ! 684: (backward-char 2) ! 685: (kill-line nil) ! 686: (insert "! " (int-to-string (car (cadr group))) ! 687: "-" (int-to-string (cadr (cadr group)))))) ! 688: (setq news-unsubscribe-groups (cdr news-unsubscribe-groups))) ! 689: (save-buffer) ! 690: (kill-buffer (current-buffer))))) ! 691: ! 692: ! 693: (defun news-unsubscribe-group (group) ! 694: "Removes you from newgroup GROUP." ! 695: (interactive (list (completing-read "Unsubscribe from group: " ! 696: news-group-article-assoc))) ! 697: (news-unsubscribe-internal group)) ! 698: ! 699: (defun news-unsubscribe-current-group () ! 700: "Removes you from the newsgroup you are now reading." ! 701: (interactive) ! 702: (if (y-or-n-p "Do you really want to unsubscribe from this group ? ") ! 703: (news-unsubscribe-internal news-current-news-group))) ! 704: ! 705: (defun news-unsubscribe-internal (group) ! 706: (let ((tem (assoc group news-group-article-assoc))) ! 707: (if tem ! 708: (progn ! 709: (setq news-unsubscribe-groups (cons group news-unsubscribe-groups)) ! 710: (news-update-message-read group (cdar news-point-pdl)) ! 711: (if (equal group news-current-news-group) ! 712: (news-next-group)) ! 713: (message "Member-p of %s ==> nil" group)) ! 714: (error "No such group: %s" group)))) ! 715: ! 716: (defun news-save-item-in-file (file) ! 717: "Save the current article that is being read by appending to a file." ! 718: (interactive "FSave item in file: ") ! 719: (append-to-file (point-min) (point-max) file)) ! 720: ! 721: (defun news-get-pruned-list-of-files (gp-list end-file-no) ! 722: "Given a news group it does an ls to give all files in the news group. ! 723: The arg must be in slashified format." ! 724: (let ! 725: ((answer ! 726: (and ! 727: (not (and end-file-no ! 728: (equal (news-set-current-certifiable) ! 729: (news-group-certification gp-list)) ! 730: (setq news-list-of-files nil ! 731: news-list-of-files-possibly-bogus t))) ! 732: (let* ((file-directory (concat news-path ! 733: (string-subst-char ?/ ?. gp-list))) ! 734: tem ! 735: (last-winner ! 736: (and end-file-no ! 737: (news-wins file-directory end-file-no) ! 738: (news-find-first-or-last file-directory end-file-no 1)))) ! 739: (setq news-list-of-files-possibly-bogus t news-list-of-files nil) ! 740: (if last-winner ! 741: (progn ! 742: (setq news-list-of-files-possibly-bogus t ! 743: news-current-group-end last-winner) ! 744: (while (> last-winner end-file-no) ! 745: (push last-winner news-list-of-files) ! 746: (setq last-winner (1- last-winner))) ! 747: news-list-of-files) ! 748: (if (not (file-directory-p file-directory)) ! 749: nil ! 750: (setq news-list-of-files ! 751: (setq tem (directory-files file-directory))) ! 752: (while tem ! 753: (if (or (not (string-match "^[0-9]*$" (car tem))) ! 754: ; dont get confused by directories that look like numbers ! 755: (file-directory-p ! 756: (concat file-directory "/" (car tem))) ! 757: (<= (string-to-int (car tem)) end-file-no)) ! 758: (setq news-list-of-files ! 759: (delq (car tem) news-list-of-files))) ! 760: (setq tem (cdr tem))) ! 761: (if (null news-list-of-files) ! 762: (progn (setq news-current-group-end 0) ! 763: nil) ! 764: (setq news-list-of-files ! 765: (mapcar 'string-to-int news-list-of-files)) ! 766: (setq news-list-of-files (sort news-list-of-files '<)) ! 767: (setq news-current-group-end ! 768: (elt news-list-of-files ! 769: (1- (length news-list-of-files)))) ! 770: news-list-of-files))))))) ! 771: (or answer (progn (news-set-current-group-certification) nil)))) ! 772: ! 773: (defun news-read-files-into-buffer (group reversep) ! 774: (let* ((files-start-end (cadr (assoc group news-group-article-assoc))) ! 775: (start-file-no (car files-start-end)) ! 776: (end-file-no (cadr files-start-end)) ! 777: (buffer-read-only nil)) ! 778: ! 779: (setq news-current-news-group group) ! 780: (setq news-current-message-number nil) ! 781: (setq news-current-group-end nil) ! 782: (news-set-mode-line) ! 783: (news-get-pruned-list-of-files group end-file-no) ! 784: (news-set-mode-line) ! 785: ;; should be a lot smarter than this if we have to move ! 786: ;; around correctly. ! 787: (setq news-point-pdl (list (cons (car files-start-end) ! 788: (cadr files-start-end)))) ! 789: (if (null news-list-of-files) ! 790: (progn (erase-buffer) ! 791: (setq news-current-group-end end-file-no) ! 792: (setq news-current-group-begin end-file-no) ! 793: (setq news-current-message-number end-file-no) ! 794: (news-set-mode-line) ! 795: ; (message "No new articles in " group " group.") ! 796: nil) ! 797: (setq news-current-group-begin (car news-list-of-files)) ! 798: (if reversep ! 799: (setq news-current-message-number news-current-group-end) ! 800: (if (> (car news-list-of-files) end-file-no) ! 801: (setcdr (car news-point-pdl) (car news-list-of-files))) ! 802: (setq news-current-message-number news-current-group-begin)) ! 803: (news-set-message-counters) ! 804: (news-set-mode-line) ! 805: (news-read-in-file (concat news-path ! 806: (string-subst-char ?/ ?. group) ! 807: "/" ! 808: (int-to-string ! 809: news-current-message-number))) ! 810: (news-set-message-counters) ! 811: (news-set-mode-line) ! 812: t))) ! 813: ! 814: ! 815: ;;; Replying and posting news items are done by these functions. ! 816: ;;; imported from rmail and modified to work with rnews ... ! 817: ;;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes. ! 818: ;;; this is done so that rnews can operate independently from rmail.el and sendmail and ! 819: ;;; dosen't have to autoload these functions. ! 820: ! 821: ;;;>> Nuked by Mly to autoload those functions again, as the duplication of ! 822: ;;;>> code was making maintenance too difficult. ! 823: ! 824: (defvar news-reply-mode-map () "Mode map used by news-reply.") ! 825: ! 826: (or news-reply-mode-map ! 827: (progn (setq news-reply-mode-map (make-keymap)) ! 828: (define-key news-reply-mode-map "\C-c?" 'describe-mode) ! 829: (define-key news-reply-mode-map "\C-ct" 'mail-to) ! 830: (define-key news-reply-mode-map "\C-cb" 'mail-bcc) ! 831: (define-key news-reply-mode-map "\C-cc" 'mail-cc) ! 832: (define-key news-reply-mode-map "\C-cs" 'mail-subject) ! 833: (define-key news-reply-mode-map "\C-cy" 'mail-yank-original) ! 834: (define-key news-reply-mode-map "\C-c\C-c" 'news-inews) ! 835: (define-key news-reply-mode-map "\C-c\C-s" 'news-inews))) ! 836: ! 837: (defun news-reply-mode () ! 838: "Major mode for editing news to be posted on netnews. ! 839: Like Text Mode but with these additional commands: ! 840: \\{news-reply-mode-map}" ! 841: (interactive) ! 842: ;; require... ! 843: (or (fboundp 'mail-setup) (load "sendmail")) ! 844: (kill-all-local-variables) ! 845: (make-local-variable 'mail-reply-buffer) ! 846: (setq mail-reply-buffer nil) ! 847: (set-syntax-table text-mode-syntax-table) ! 848: (use-local-map news-reply-mode-map) ! 849: (setq local-abbrev-table text-mode-abbrev-table) ! 850: (setq major-mode 'news-reply-mode) ! 851: (setq mode-name "News") ! 852: (make-local-variable 'paragraph-separate) ! 853: (make-local-variable 'paragraph-start) ! 854: (setq paragraph-start (concat "^" mail-header-separator "$\\|" ! 855: paragraph-start)) ! 856: (setq paragraph-separate (concat "^" mail-header-separator "$\\|" ! 857: paragraph-separate)) ! 858: (run-hooks 'text-mode-hook 'news-reply-mode-hook)) ! 859: ! 860: (defun news-setup (to subject in-reply-to newsgroups replybuffer) ! 861: (setq mail-reply-buffer replybuffer) ! 862: (let ((mail-setup-hook nil)) ! 863: (if (null to) ! 864: ;; this hack is needed so that inews wont be confused by ! 865: ;; the fcc: and bcc: fields ! 866: (let ((mail-self-blind nil) ! 867: (mail-archive-file-name nil)) ! 868: (mail-setup to subject in-reply-to nil replybuffer) ! 869: (beginning-of-line) ! 870: (kill-line 1) ! 871: (goto-char (point-max))) ! 872: (mail-setup to subject in-reply-to nil replybuffer)) ! 873: (goto-char (point-max)) ! 874: (if (let ((case-fold-search t)) ! 875: (re-search-backward "^Subject:" (point-min) t)) ! 876: (progn (beginning-of-line) ! 877: (insert "Newsgroups: " (or newsgroups "") "\n") ! 878: (if (not newsgroups) ! 879: (backward-char 1) ! 880: (goto-char (point-max))))) ! 881: (run-hooks 'news-setup-hook))) ! 882: ! 883: (defun news-inews () ! 884: "Send a news message using inews." ! 885: (interactive) ! 886: (let* (newsgroups subject ! 887: (case-fold-search nil)) ! 888: (save-restriction ! 889: (goto-char (point-min)) ! 890: (search-forward (concat "\n" mail-header-separator "\n")) ! 891: (narrow-to-region (point-min) (point)) ! 892: (setq newsgroups (mail-fetch-field "newsgroups") ! 893: subject (mail-fetch-field "subject"))) ! 894: (widen) ! 895: (goto-char (point-min)) ! 896: (search-forward (concat "\n" mail-header-separator "\n")) ! 897: (message "Posting to the net...") ! 898: (call-process-region (point) (point-max) ! 899: news-inews-program nil 0 nil ! 900: "-t" subject ! 901: "-n" newsgroups) ! 902: (message "Posting to the net... done") ! 903: (set-buffer-modified-p nil) ! 904: (delete-windows-on (current-buffer)) ! 905: (and (fboundp 'bury-buffer) (bury-buffer (current-buffer))))) ! 906: ! 907: (defun news-mail-reply () ! 908: "Mail a reply to the author of the current article. ! 909: While composing the reply, use \\[mail-yank-original] to yank the original message into it." ! 910: (interactive) ! 911: (let (from cc subject date to reply-to ! 912: (buffer (current-buffer))) ! 913: (save-restriction ! 914: (narrow-to-region (point-min) (progn (goto-line (point-min)) ! 915: (search-forward "\n\n") ! 916: (- (point) 2))) ! 917: (setq from (mail-fetch-field "from") ! 918: subject (mail-fetch-field "subject") ! 919: reply-to (mail-fetch-field "reply-to") ! 920: date (mail-fetch-field "date")) ! 921: (setq to from) ! 922: (pop-to-buffer "*mail*") ! 923: (mail nil ! 924: (if reply-to reply-to to) ! 925: subject ! 926: (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) ! 927: (concat (if stop-pos (substring from 0 stop-pos) from) ! 928: "'s message of " ! 929: date)) ! 930: nil ! 931: buffer)))) ! 932: ! 933: (defun news-reply () ! 934: "Compose and send a reply to the current article to the net. ! 935: While composing the reply, use \\[mail-yank-original] to yank the original message into it." ! 936: (interactive) ! 937: (if (y-or-n-p "Are you sure you want to reply to the net? ") ! 938: (let (from cc subject date to newsgroups ! 939: (buffer (current-buffer))) ! 940: (save-restriction ! 941: (narrow-to-region (point-min) (progn (search-forward "\n\n") ! 942: (- (point) 2))) ! 943: (setq from (mail-fetch-field "from") ! 944: subject (mail-fetch-field "subject") ! 945: date (mail-fetch-field "date") ! 946: newsgroups (mail-fetch-field "newsgroups")) ! 947: (pop-to-buffer "*post-news*") ! 948: (news-reply-mode) ! 949: (erase-buffer) ! 950: (news-setup ! 951: nil ! 952: subject ! 953: (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) ! 954: (concat (if stop-pos (substring from 0 stop-pos) from) ! 955: "'s message of " ! 956: date)) ! 957: newsgroups ! 958: buffer))) ! 959: (message ""))) ! 960: ! 961: (defun news-post-news () ! 962: "Begin editing a news article to be posted." ! 963: (interactive) ! 964: (pop-to-buffer "*post-news*") ! 965: (news-reply-mode) ! 966: (erase-buffer) ! 967: (news-setup () () () () ())) ! 968: ! 969: (defun news-add-news-group (gp) ! 970: "Add you to news group named GROUP (a string)." ! 971: ; (completing-read ...) ! 972: (interactive "sAdd news group: ") ! 973: (let ((file-dir (concat news-path (string-subst-char ?/ ?. gp)))) ! 974: (save-excursion ! 975: (if (null (assoc gp news-group-article-assoc)) ! 976: (let ((newsrcbuf (find-file-noselect ! 977: (substitute-in-file-name news-startup-file)))) ! 978: (if (file-directory-p file-dir) ! 979: (progn ! 980: (switch-to-buffer newsrcbuf) ! 981: (end-of-buffer) ! 982: (insert (string-subst-char ?. ?\ gp) ": 1-1\n") ! 983: (save-buffer) ! 984: (kill-buffer (current-buffer)) ! 985: (message "Added %s to your current list of newsgroups." gp)) ! 986: (message "Newsgroup %s doesn't exist." gp))) ! 987: (message "Already subscribed to group %s." gp))))) ! 988: ! 989: (defun news-mail-other-window () ! 990: "Send mail in another window. ! 991: While composing the message, use \\[mail-yank-original] to yank the ! 992: original message into it." ! 993: (interactive) ! 994: (mail-other-window nil nil nil nil nil (current-buffer))) ! 995: ! 996: (defun news-make-link-to-message (number newname) ! 997: "Forges a link to an rnews message numbered number (current if no arg) ! 998: Good for hanging on to a message that might or might not be ! 999: automatically deleted." ! 1000: (interactive "P ! 1001: FName to link to message: ") ! 1002: (add-name-to-file ! 1003: (concat news-path ! 1004: (string-subst-char ?/ ?. news-current-news-group) ! 1005: "/" (if number ! 1006: (prefix-numeric-value number) ! 1007: news-current-message-number)) ! 1008: newname)) ! 1009: ! 1010:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.