weemba@garnet.berkeley.edu (Matthew P Wiener) (10/26/88)
The following fixes a non-renamed old variable, a non-recased 'gnews,
and for some of you, the most important thing of all: working spool
code. If you use a site.el file, you can just put this right in. I
shall be putting this in the ftp version on ucbvax later this week.
Happy Gnewsing!
ucbvax!garnet!weemba Matthew P Wiener/Brahms Gang/Berkeley CA 94720
"Nil sounds like a lot of kopins! I never got paid nil before!" --Groo
----------------------------------------------------------------------
;;; fix for group.el
(defun group-next-same-subject (arg)
;;; rewrite some day, eh? This stinks.
"Search for next unread article matching subject. With prefix argument
ARG, search for next unread article matching ARG'th header field given in
index-headers (1-based). ARG=0 means turn off subject-search mode."
(interactive "p")
(if (= article-current 0) (group-trace-return))
(if (zerop arg) (group-next-unread))
(if (<= article-current article-final) (article-junk))
(setq group-default-command 'group-next-same-subject
group-prompt-default group-prompt-same-subject
article-field-same-no arg
article-field-same (nth (1- arg) index-headers)
article-same-subject (reply-re-1
(article-field article-field-same)))
(while
(eq t (setq article-status ; Matt Crawford
(catch 'article-nil
(article-current-set
(let ((i (amark-next-unread article-current amark)))
(catch 'set-art
(while (<= i article-final)
(if (string= article-same-subject
(nth article-field-same-no
(index-prepare
i index-headers)))
(throw 'set-art i))
(setq i (amark-next-unread i amark)))
(throw 'set-art (amark-next-unread
article-first amark)))))
(if (<= article-current article-final)
(let ((nntp-exec-force t))
(article-get article-current hook-kill-per))
(throw 'article-nil 'q))
'y))))
(cond ((eq article-status 'q)
(news-next-unread-maybe t))
((eq article-status 'i)
(group-next-but-index-done t))
((eq article-status 'c)
(group-next-but-no-wrap)))
(gnews-flush))
;;; fix for hook.el:
(defun hook-kill-abort ()
"Return to news reading, ignoring any changes."
(interactive)
(bury-buffer)
(delete-windows-on (current-buffer))
(Gnews))
;;; fix for Spool.el:
;;; This is straight from Hal R Peterson, who's been doing the lion's
;;; share of keeping Spool.el afloat for me. Thanks!
(defvar gnews-server-group nil
"Current group in pseudo-server.")
(defun gnews-spool-exec-group (gp)
"Fake an NNTP group command."
(let ((dir (gnews-spool-dir gp)) c f l)
(if (and (file-readable-p dir)
(car (file-attributes dir)))
(gnews-string-as-buffer "" nil
(setq gnews-server-article nil)
(setq gnews-server-group gp)
(call-process "ls" nil t nil dir)
(goto-char 1)
(insert "(setq gnews-spool-group-list (gnews-spool-preen '(")
(goto-char (point-max))
(insert ")))")
(eval-current-buffer)
(if (null gnews-spool-group-list)
(gnews-spool-info "211 0 0 0" gp) ; nothing there
(sort gnews-spool-group-list '<)
(setq gnews-spool-group-tsil (reverse gnews-spool-group-list))
(setq c (length gnews-spool-group-list))
(setq f (car gnews-spool-group-list))
(setq l (car gnews-spool-group-tsil))
(gnews-spool-info "211" c f l gp)
t))
(gnews-spool-info "411 Invalid group name.")
nil)))
(defun gnews-spool-exec-art (art-no part)
"Fake an NNTP article/head/body/stat command."
(let (file msg-id)
(if (and (cond ((string-match "^[0-9]+$" art-no)
(setq file (gnews-spool-art gnews-server-group art-no))
(if (let ((attributes (file-attributes file)))
(and attributes (< 0 (nth 7 attributes))))
(if (memq part '(body stat))
;; Set the Message-ID by hand
(setq msg-id (gnews-string-as-buffer "" nil
(call-process "sed" file t t
"/^Message-ID:/q")
(forward-line -1)
(forward-char 12)
(buffer-substring
(point) (gnews-eol))))
t)))
((string-match "^<.*>$" art-no)
(gnews-string-as-buffer "" nil
(apply 'call-process
gnews-spool-history-lookup-prog nil t nil
(gnews-spool-history-lookup-args art-no))
(beginning-of-buffer)
(if (re-search-forward (gnews-spool-regexp msg-id)
nil t)
(setq art-no (gnews-match 2)
file (gnews-spool-art (gnews-match 1) art-no))
(setq art-no "0"
file "/meese/sucks/raw/eggs/film/at/11")))
(set-buffer nntp-buffer)))
(file-readable-p file))
(progn
(setq gnews-server-article art-no)
(cond ((eq part 'art)
(insert-file file))
((eq part 'head)
(call-process "sed" file t t "/^$/q")
(goto-char (point-max))
(delete-char -1))
((eq part 'body)
(call-process "sed" file t t "1,/^$/d")))
(gnews-spool-info (cond ((eq part 'art) "220")
((eq part 'head) "221")
((eq part 'body) "222")
((eq part 'stat) "223"))
art-no
msg-id
"Article retrieved;"
(cond ((eq part 'art) "head and body follow.")
((eq part 'head) "head follows.")
((eq part 'stat) "request text separately.")
((eq part 'body) "body follows.")))
t)
(gnews-spool-info "423 Invalid article number:" art)
nil)))
(defun gnews-spool-index-fast (pfx &optional nosub in-group)
"Display an index of the proffered newsgroup."
(interactive "P")
(setq index-pop index-pop-up
nntp-index-done nil)
(or in-group (news-goto gnews-server-group nosub))
(set-buffer nntp-index-buffer)
(erase-buffer)
(gnews-buffer index-pop index-buffer)
(setq buffer-read-only)
(erase-buffer)
(setq buffer-read-only t)
(message "indexing...")
(nntp-exec t t "group" gnews-server-group)
(setq nntp-index-final (if (amark-member article-final amark)
(amark-previous-unread article-final amark)
article-final)
gnews-spool-index-files (list "-")
gnews-s-i-f gnews-spool-index-files)
(amark-loop art-no (list (cons article-current article-final))
(if (and (or index-show-kills (not (amark-member art-no amark)))
(memq art-no gnews-spool-group-list))
(progn
(setcdr gnews-s-i-f (list (concat (gnews-spool-dir gnews-server-group)
art-no)))
(setq gnews-s-i-f (cdr gnews-s-i-f)))))
(setq nntp-index
(start-process "gnews-spool-index"
nntp-index-buffer
"/bin/sh"
"-c"
(concat "for i in "
(mapconcat 'identity
gnews-spool-index-files
" ")
";do echo :${i}:"
";sed -n \"1,/^$/p\" $i"
";done")))
(set-process-filter nntp-index 'gnews-spool-index-filter)
(index-mode)
(setq index-x-menu nil)
(if index-sort-do (index-sort))
(setq buffer-read-only)
(goto-char 1)
(mapcar '(lambda (x) (insert (format "%5dm %s\n" (car x) (cdr x))))
(cdr index-perm-marks))
(setq buffer-read-only t)
(setq index-final article-current)
(article-current-set index-final))
(defun gnews-spool-index-filter (proc string)
"Filter for fast spool indexing."
(set-buffer nntp-index-buffer)
(setq article-field-list (list nil)
nntp-index-done nil)
(goto-char (point-max))
(insert string)
(goto-char 1)
(let* ((hook-kill-continue t)
(hook hook-kill-per)
(h (mapcar 'ignore index-headers))
(rgxp (concat "^:"
(gnews-spool-dir gnews-server-group)
"\\([0-9]+\\):"))
p q n i f g z junk)
(while (and (not nntp-index-done)
(re-search-forward rgxp nil t)
(setq p (gnews-bol)
n (read (buffer-substring
(match-beginning 1) (match-end 1))))
(re-search-forward "^$" nil t)
(not (eobp))
(setq q (gnews-eol)))
(setq i index-headers z h)
(while z ; h gets the headers
(goto-char p)
(setcar z (if (re-search-forward
(concat "^" (car i) ": *\\(.*\\)") q t)
(buffer-substring
(match-beginning 1) (match-end 1))
""))
(setq i (cdr i) z (cdr z)))
(setq z (cdr article-field-list))
(while z ; a-f-l gets alist cdr's ""'ed
(setcdr (car z) "")
(setq z (cdr z)))
(save-excursion
(save-restriction
(narrow-to-region p q)
(goto-char p)
(forward-line 1)
(while (not (eobp))
(if (looking-at "^\\([^:]*\\): *\\(.*\\)$")
(progn (setq f (buffer-substring
(match-beginning 1) (match-end 1))
g (buffer-substring
(match-beginning 2) (match-end 2)))
(if (setq z (assoc f article-field-list))
(setcdr z g)
(nconc article-field-list (list (cons f g))))))
(forward-line 1))))
(while (and hook hook-kill-continue (not junk))
(setq junk (hook-kill-do (car hook) t)
hook (cdr hook)))
(delete-region p q)
(if (and junk (not index-show-kills))
(if (setq nntp-index-done (= n nntp-index-final))
(save-excursion
(set-buffer index-buffer)
(setq buffer-read-only)
(goto-char (point-max))
(if (not (bobp)) (delete-char -1))
(setq buffer-read-only t)
(index-beginning-of-buffer)
(let (debug-on-error) (error "indexing...done"))))
(save-excursion
(set-buffer index-buffer)
(setq buffer-read-only)
(setq nntp-index-done (= n nntp-index-final))
(goto-char (point-max))
(if (string< "" (mapconcat 'identity h ""))
(insert (format "%5d" n) (if junk "k" " ") " "
(index-line n index-format h index-filter index-sizes)
(if nntp-index-done "" "\n")))
(setq buffer-read-only t)
(if nntp-index-done
(let (debug-on-error)
(index-beginning-of-buffer)
(error "indexing...done")))
(set-buffer nntp-index-buffer))))))