![[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 [Apple XNU] / GNUtools / emacs / lisp|
Return to rnews.el CVS log | Up to [Apple XNU] / GNUtools / emacs / 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 free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20: ;; Created Sun Mar 10,1985 at 21:35:01 ads and [email protected]
21: ;; Should do the point pdl stuff sometime
22: ;; finito except pdl.... Sat Mar 16,1985 at 06:43:44
23: ;; lets keep the summary stuff out until we get it working ..
24: ;; [email protected] Wed Apr 10,1985 at 16:32:06
25: ;; hack slash maim. [email protected] Thu 18 Apr, 1985 06:11:14
26: ;; modified to correct reentrance bug, to not bother with groups that
27: ;; received no new traffic since last read completely, to find out
28: ;; what traffic a group has available much more quickly when
29: ;; possible, to do some completing reads for group names - should
30: ;; be much faster...
31: ;; [email protected], Thu Mar 13 09:03:28 1986
32: ;; made news-{next,previous}-group skip groups with no new messages; and
33: ;; added checking for unsubscribed groups to news-add-news-group
34: ;; [email protected] Jul 18 1986
35: ;; bound rmail-output to C-o; and changed header-field commands binding to
36: ;; agree with the new C-c C-f usage in sendmail
37: ;; tower@prep Sep 3 1986
38: ;; added news-rotate-buffer-body
39: ;; tower@prep Oct 17 1986
40: ;; made messages more user friendly, cleanuped news-inews
41: ;; move posting and mail code to new file rnewpost.el
42: ;; tower@prep Oct 29 1986
43: ;; added caesar-region, rename news-caesar-buffer-body, hacked accordingly
44: ;; tower@prep Nov 21 1986
45: ;; added (provide 'rnews) tower@prep 22 Apr 87
46: (provide 'rnews)
47: (require 'mail-utils)
48:
49: (autoload 'rmail-output "rmailout"
50: "Append this message to Unix mail file named FILE-NAME."
51: t)
52:
53: (autoload 'news-reply "rnewspost"
54: "Compose and post a reply to the current article on USENET.
55: While composing the reply, use \\[mail-yank-original] to yank the original
56: message into it."
57: t)
58:
59: (autoload 'news-mail-other-window "rnewspost"
60: "Send mail in another window.
61: While composing the message, use \\[mail-yank-original] to yank the
62: original message into it."
63: t)
64:
65: (autoload 'news-post-news "rnewspost"
66: "Begin editing a new USENET news article to be posted."
67: t)
68:
69: (autoload 'news-mail-reply "rnewspost"
70: "Mail a reply to the author of the current article.
71: While composing the reply, use \\[mail-yank-original] to yank the original
72: message into it."
73: t)
74:
75: (defvar rmail-last-file (expand-file-name "~/mbox.news"))
76:
77: ;Now in paths.el.
78: ;(defvar news-path "/usr/spool/news/"
79: ; "The root directory below which all news files are stored.")
80:
81: (defvar news-startup-file "$HOME/.newsrc" "Contains ~/.newsrc")
82: (defvar news-certification-file "$HOME/.news-dates" "Contains ~/.news-dates")
83:
84: ;; random headers that we decide to ignore.
85: (defvar news-ignored-headers
86: "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
87: "All random fields within the header of a message.")
88:
89: (defvar news-mode-map nil)
90: (defvar news-read-first-time-p t)
91: ;; Contains the (dotified) news groups of which you are a member.
92: (defvar news-user-group-list nil)
93:
94: (defvar news-current-news-group nil)
95: (defvar news-current-group-begin nil)
96: (defvar news-current-group-end nil)
97: (defvar news-current-certifications nil
98: "An assoc list of a group name and the time at which it is
99: known that the group had no new traffic")
100: (defvar news-current-certifiable nil
101: "The time when the directory we are now working on was written")
102:
103: (defvar news-message-filter nil
104: "User specifiable filter function that will be called during
105: formatting of the news file")
106:
107: ;(defvar news-mode-group-string "Starting-Up"
108: ; "Mode line group name info is held in this variable")
109: (defvar news-list-of-files nil
110: "Global variable in which we store the list of files
111: associated with the current newsgroup")
112: (defvar news-list-of-files-possibly-bogus nil
113: "variable indicating we only are guessing at which files are available.
114: Not currently used.")
115:
116: ;; association list in which we store lists of the form
117: ;; (pointified-group-name (first last old-last))
118: (defvar news-group-article-assoc nil)
119:
120: (defvar news-current-message-number 0 "Displayed Article Number")
121: (defvar news-total-current-group 0 "Total no of messages in group")
122:
123: (defvar news-unsubscribe-groups ())
124: (defvar news-point-pdl () "List of visited news messages.")
125: (defvar news-no-jumps-p t)
126: (defvar news-buffer () "Buffer into which news files are read.")
127:
128: (defmacro news-push (item ref)
129: (list 'setq ref (list 'cons item ref)))
130:
131: (defmacro news-cadr (x) (list 'car (list 'cdr x)))
132: (defmacro news-cdar (x) (list 'cdr (list 'car x)))
133: (defmacro news-caddr (x) (list 'car (list 'cdr (list 'cdr x))))
134: (defmacro news-cadar (x) (list 'car (list 'cdr (list 'car x))))
135: (defmacro news-caadr (x) (list 'car (list 'car (list 'cdr x))))
136: (defmacro news-cdadr (x) (list 'cdr (list 'car (list 'cdr x))))
137:
138: (defmacro news-wins (pfx index)
139: (` (file-exists-p (concat (, pfx) "/" (int-to-string (, index))))))
140:
141: (defvar news-max-plausible-gap 2
142: "* In an rnews directory, the maximum possible gap size.
143: A gap is a sequence of missing messages between two messages that exist.
144: An empty file does not contribute to a gap -- it ends one.")
145:
146: (defun news-find-first-and-last (prefix base)
147: (and (news-wins prefix base)
148: (cons (news-find-first-or-last prefix base -1)
149: (news-find-first-or-last prefix base 1))))
150:
151: (defmacro news-/ (a1 a2)
152: ;; a form of / that guarantees that (/ -1 2) = 0
153: (if (zerop (/ -1 2))
154: (` (/ (, a1) (, a2)))
155: (` (if (< (, a1) 0)
156: (- (/ (- (, a1)) (, a2)))
157: (/ (, a1) (, a2))))))
158:
159: (defun news-find-first-or-last (pfx base dirn)
160: ;; first use powers of two to find a plausible ceiling
161: (let ((original-dir dirn))
162: (while (news-wins pfx (+ base dirn))
163: (setq dirn (* dirn 2)))
164: (setq dirn (news-/ dirn 2))
165: ;; Then use a binary search to find the high water mark
166: (let ((offset (news-/ dirn 2)))
167: (while (/= offset 0)
168: (if (news-wins pfx (+ base dirn offset))
169: (setq dirn (+ dirn offset)))
170: (setq offset (news-/ offset 2))))
171: ;; If this high-water mark is bogus, recurse.
172: (let ((offset (* news-max-plausible-gap original-dir)))
173: (while (and (/= offset 0) (not (news-wins pfx (+ base dirn offset))))
174: (setq offset (- offset original-dir)))
175: (if (= offset 0)
176: (+ base dirn)
177: (news-find-first-or-last pfx (+ base dirn offset) original-dir)))))
178:
179: (defun rnews ()
180: "Read USENET news for groups for which you are a member and add or
181: delete groups.
182: You can reply to articles posted and send articles to any group.
183:
184: Type \\[describe-mode] once reading news to get a list of rnews commands."
185: (interactive)
186: (let ((last-buffer (buffer-name)))
187: (make-local-variable 'rmail-last-file)
188: (switch-to-buffer (setq news-buffer (get-buffer-create "*news*")))
189: (news-mode)
190: (setq news-buffer-save last-buffer)
191: (setq buffer-read-only nil)
192: (erase-buffer)
193: (setq buffer-read-only t)
194: (set-buffer-modified-p t)
195: (sit-for 0)
196: (message "Getting new USENET news...")
197: (news-set-mode-line)
198: (news-get-certifications)
199: (news-get-new-news)))
200:
201: (defun news-group-certification (group)
202: (cdr-safe (assoc group news-current-certifications)))
203:
204:
205: (defun news-set-current-certifiable ()
206: ;; Record the date that corresponds to the directory you are about to check
207: (let ((file (concat news-path
208: (string-subst-char ?/ ?. news-current-news-group))))
209: (setq news-current-certifiable
210: (nth 5 (file-attributes
211: (or (file-symlink-p file) file))))))
212:
213: (defun news-get-certifications ()
214: ;; Read the certified-read file from last session
215: (save-excursion
216: (save-window-excursion
217: (setq news-current-certifications
218: (car-safe
219: (condition-case var
220: (let*
221: ((file (substitute-in-file-name news-certification-file))
222: (buf (find-file-noselect file)))
223: (and (file-exists-p file)
224: (progn
225: (switch-to-buffer buf 'norecord)
226: (unwind-protect
227: (read-from-string (buffer-string))
228: (kill-buffer buf)))))
229: (error nil)))))))
230:
231: (defun news-write-certifications ()
232: ;; Write a certification file.
233: ;; This is an assoc list of group names with doubletons that represent
234: ;; mod times of the directory when group is read completely.
235: (save-excursion
236: (save-window-excursion
237: (with-output-to-temp-buffer
238: "*CeRtIfIcAtIoNs*"
239: (print news-current-certifications))
240: (let ((buf (get-buffer "*CeRtIfIcAtIoNs*")))
241: (switch-to-buffer buf)
242: (write-file (substitute-in-file-name news-certification-file))
243: (kill-buffer buf)))))
244:
245: (defun news-set-current-group-certification ()
246: (let ((cgc (assoc news-current-news-group news-current-certifications)))
247: (if cgc (setcdr cgc news-current-certifiable)
248: (news-push (cons news-current-news-group news-current-certifiable)
249: news-current-certifications))))
250:
251: (defun news-set-minor-modes ()
252: "Creates a minor mode list that has group name, total articles,
253: and attribute for current article."
254: (setq news-minor-modes (list (cons 'foo
255: (concat news-current-message-number
256: "/"
257: news-total-current-group
258: (news-get-attribute-string)))))
259: ;; Detect Emacs versions 18.16 and up, which display
260: ;; directly from news-minor-modes by using a list for mode-name.
261: (or (boundp 'minor-mode-alist)
262: (setq minor-modes news-minor-modes)))
263:
264: (defun news-set-message-counters ()
265: "Scan through current news-groups filelist to figure out how many messages
266: are there. Set counters for use with minor mode display."
267: (if (null news-list-of-files)
268: (setq news-current-message-number 0)))
269:
270: (if news-mode-map
271: nil
272: (setq news-mode-map (make-keymap))
273: (suppress-keymap news-mode-map)
274: (define-key news-mode-map "." 'beginning-of-buffer)
275: (define-key news-mode-map " " 'scroll-up)
276: (define-key news-mode-map "\177" 'scroll-down)
277: (define-key news-mode-map "n" 'news-next-message)
278: (define-key news-mode-map "c" 'news-make-link-to-message)
279: (define-key news-mode-map "p" 'news-previous-message)
280: (define-key news-mode-map "j" 'news-goto-message)
281: (define-key news-mode-map "q" 'news-exit)
282: (define-key news-mode-map "e" 'news-exit)
283: (define-key news-mode-map "\ej" 'news-goto-news-group)
284: (define-key news-mode-map "\en" 'news-next-group)
285: (define-key news-mode-map "\ep" 'news-previous-group)
286: (define-key news-mode-map "l" 'news-list-news-groups)
287: (define-key news-mode-map "?" 'describe-mode)
288: (define-key news-mode-map "g" 'news-get-new-news)
289: (define-key news-mode-map "f" 'news-reply)
290: (define-key news-mode-map "m" 'news-mail-other-window)
291: (define-key news-mode-map "a" 'news-post-news)
292: (define-key news-mode-map "r" 'news-mail-reply)
293: (define-key news-mode-map "o" 'news-save-item-in-file)
294: (define-key news-mode-map "\C-o" 'rmail-output)
295: (define-key news-mode-map "t" 'news-show-all-headers)
296: (define-key news-mode-map "x" 'news-force-update)
297: (define-key news-mode-map "A" 'news-add-news-group)
298: (define-key news-mode-map "u" 'news-unsubscribe-current-group)
299: (define-key news-mode-map "U" 'news-unsubscribe-group)
300: (define-key news-mode-map "\C-c\C-r" 'news-caesar-buffer-body))
301:
302: (defun news-mode ()
303: "News Mode is used by M-x rnews for reading USENET Newsgroups articles.
304: New readers can find additional help in newsgroup: news.announce.newusers .
305: All normal editing commands are turned off.
306: Instead, these commands are available:
307:
308: . move point to front of this news article (same as Meta-<).
309: Space scroll to next screen of this news article.
310: Delete scroll down previous page of this news article.
311: n move to next news article, possibly next group.
312: p move to previous news article, possibly previous group.
313: j jump to news article specified by numeric position.
314: M-j jump to news group.
315: M-n goto next news group.
316: M-p goto previous news group.
317: l list all the news groups with current status.
318: ? print this help message.
319: C-c C-r caesar rotate all letters by 13 places in the article's body (rot13).
320: g get new USENET news.
321: f post a reply article to USENET.
322: a post an original news article.
323: A add a newsgroup.
324: o save the current article in the named file (append if file exists).
325: C-o output this message to a Unix-format mail file (append it).
326: c \"copy\" (actually link) current or prefix-arg msg to file.
327: warning: target directory and message file must be on same device
328: (UNIX magic)
329: t show all the headers this news article originally had.
330: q quit reading news after updating .newsrc file.
331: e exit updating .newsrc file.
332: m mail a news article. Same as C-x 4 m.
333: x update last message seen to be the current message.
334: r mail a reply to this news article. Like m but initializes some fields.
335: u unsubscribe from current newsgroup.
336: U unsubscribe from specified newsgroup."
337: (interactive)
338: (kill-all-local-variables)
339: (make-local-variable 'news-read-first-time-p)
340: (setq news-read-first-time-p t)
341: (make-local-variable 'news-current-news-group)
342: ; (setq news-current-news-group "??")
343: (make-local-variable 'news-current-group-begin)
344: (setq news-current-group-begin 0)
345: (make-local-variable 'news-current-message-number)
346: (setq news-current-message-number 0)
347: (make-local-variable 'news-total-current-group)
348: (make-local-variable 'news-buffer-save)
349: (make-local-variable 'version-control)
350: (setq version-control 'never)
351: (make-local-variable 'news-point-pdl)
352: ; This breaks it. I don't have time to figure out why. -- RMS
353: ; (make-local-variable 'news-group-article-assoc)
354: (setq major-mode 'news-mode)
355: (if (boundp 'minor-mode-alist)
356: ;; Emacs versions 18.16 and up.
357: (setq mode-name '("NEWS" news-minor-modes))
358: ;; Earlier versions display minor-modes via a special mechanism.
359: (setq mode-name "NEWS"))
360: (news-set-mode-line)
361: (set-syntax-table text-mode-syntax-table)
362: (use-local-map news-mode-map)
363: (setq local-abbrev-table text-mode-abbrev-table)
364: (run-hooks 'news-mode-hook))
365:
366: (defun string-subst-char (new old string)
367: (let (index)
368: (setq old (regexp-quote (char-to-string old))
369: string (substring string 0))
370: (while (setq index (string-match old string))
371: (aset string index new)))
372: string)
373:
374: ;; update read message number
375: (defmacro news-update-message-read (ngroup nno)
376: (list 'setcar
377: (list 'news-cdadr
378: (list 'assoc ngroup 'news-group-article-assoc))
379: nno))
380:
381: (defun news-parse-range (number-string)
382: "Parse string representing range of numbers of he form <a>-<b>
383: to a list (a . b)"
384: (let ((n (string-match "-" number-string)))
385: (if n
386: (cons (string-to-int (substring number-string 0 n))
387: (string-to-int (substring number-string (1+ n))))
388: (setq n (string-to-int number-string))
389: (cons n n))))
390:
391: ;(defun is-in (elt lis)
392: ; (catch 'foo
393: ; (while lis
394: ; (if (equal (car lis) elt)
395: ; (throw 'foo t)
396: ; (setq lis (cdr lis))))))
397:
398: (defun news-get-new-news ()
399: "Get new USENET news, if there is any for the current user."
400: (interactive)
401: (if (not (null news-user-group-list))
402: (news-update-newsrc-file))
403: (setq news-group-article-assoc ())
404: (setq news-user-group-list ())
405: (message "Looking up %s file..." news-startup-file)
406: (let ((file (substitute-in-file-name news-startup-file))
407: (temp-user-groups ()))
408: (save-excursion
409: (let ((newsrcbuf (find-file-noselect file))
410: start end endofline tem)
411: (set-buffer newsrcbuf)
412: (goto-char 0)
413: (while (search-forward ": " nil t)
414: (setq end (point))
415: (beginning-of-line)
416: (setq start (point))
417: (end-of-line)
418: (setq endofline (point))
419: (setq tem (buffer-substring start (- end 2)))
420: (let ((range (news-parse-range
421: (buffer-substring end endofline))))
422: (if (assoc tem news-group-article-assoc)
423: (message "You are subscribed twice to %s; I ignore second"
424: tem)
425: (setq temp-user-groups (cons tem temp-user-groups)
426: news-group-article-assoc
427: (cons (list tem (list (car range)
428: (cdr range)
429: (cdr range)))
430: news-group-article-assoc)))))
431: (kill-buffer newsrcbuf)))
432: (setq temp-user-groups (nreverse temp-user-groups))
433: (message "Prefrobnicating...")
434: (switch-to-buffer news-buffer)
435: (setq news-user-group-list temp-user-groups)
436: (while (and temp-user-groups
437: (not (news-read-files-into-buffer
438: (car temp-user-groups) nil)))
439: (setq temp-user-groups (cdr temp-user-groups)))
440: (if (null temp-user-groups)
441: (message "No news is good news.")
442: (message ""))))
443:
444: (defun news-list-news-groups ()
445: "Display all the news groups to which you belong."
446: (interactive)
447: (with-output-to-temp-buffer "*Newsgroups*"
448: (save-excursion
449: (set-buffer standard-output)
450: (insert
451: "News Group Msg No. News Group Msg No.\n")
452: (insert
453: "------------------------- -------------------------\n")
454: (let ((temp news-user-group-list)
455: (flag nil))
456: (while temp
457: (let ((item (assoc (car temp) news-group-article-assoc)))
458: (insert (car item))
459: (indent-to (if flag 52 20))
460: (insert (int-to-string (news-cadr (news-cadr item))))
461: (if flag
462: (insert "\n")
463: (indent-to 33))
464: (setq temp (cdr temp) flag (not flag))))))))
465:
466: ;; Mode line hack
467: (defun news-set-mode-line ()
468: "Set mode line string to something useful."
469: (setq mode-line-process
470: (concat " "
471: (if (integerp news-current-message-number)
472: (int-to-string news-current-message-number)
473: "??")
474: "/"
475: (if (integerp news-current-group-end)
476: (int-to-string news-current-group-end)
477: news-current-group-end)))
478: (setq mode-line-buffer-identification
479: (concat "NEWS: "
480: news-current-news-group
481: ;; Enough spaces to pad group name to 17 positions.
482: (substring " "
483: 0 (max 0 (- 17 (length news-current-news-group))))))
484: (set-buffer-modified-p t)
485: (sit-for 0))
486:
487: (defun news-goto-news-group (gp)
488: "Takes a string and goes to that news group."
489: (interactive (list (completing-read "NewsGroup: "
490: news-group-article-assoc)))
491: (message "Jumping to news group %s..." gp)
492: (news-select-news-group gp)
493: (message "Jumping to news group %s... done." gp))
494:
495: (defun news-select-news-group (gp)
496: (let ((grp (assoc gp news-group-article-assoc)))
497: (if (null grp)
498: (error "Group not subscribed to in file %s." news-startup-file)
499: (progn
500: (news-update-message-read news-current-news-group
501: (news-cdar news-point-pdl))
502: (news-read-files-into-buffer (car grp) nil)
503: (news-set-mode-line)))))
504:
505: (defun news-goto-message (arg)
506: "Goes to the article ARG in current newsgroup."
507: (interactive "p")
508: (if (null current-prefix-arg)
509: (setq arg (read-no-blanks-input "Go to article: " "")))
510: (news-select-message arg))
511:
512: (defun news-select-message (arg)
513: (if (stringp arg) (setq arg (string-to-int arg)))
514: (let ((file (concat news-path
515: (string-subst-char ?/ ?. news-current-news-group)
516: "/" arg)))
517: (if (= arg
518: (or (news-cadr (memq (news-cdar news-point-pdl) news-list-of-files))
519: 0))
520: (setcdr (car news-point-pdl) arg))
521: (setq news-current-message-number arg)
522: (if (file-exists-p file)
523: (let ((buffer-read-only nil))
524: (news-read-in-file file)
525: (news-set-mode-line))
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.