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