![[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.