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