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