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