From b5efda347eed473db4c7158a28be0078bbfff01a Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 02:25:50 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 80 +++++ lisp/custom.el | 4 +- lisp/gnus-edit.el | 5 +- lisp/gnus-ems.el | 6 +- lisp/gnus-msg.el | 102 ++++--- lisp/gnus-score.el | 1 + lisp/gnus-soup.el | 460 ++++++++++++++++++++-------- lisp/gnus-vis.el | 7 +- lisp/gnus.el | 286 +++++++++++------- lisp/nnbabyl.el | 1 + lisp/nndoc.el | 15 +- lisp/nnmh.el | 25 +- lisp/nnml.el | 3 +- lisp/nnsoup.el | 735 +++++++++++++++++++++++++++++---------------- lisp/nnvirtual.el | 20 +- texi/gnus.texi | 42 ++- 16 files changed, 1228 insertions(+), 564 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4b87680e5..8ae53ffcd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,83 @@ +Fri Jun 2 14:56:40 1995 Lars Ingebrigtsen + + * gnus.el (gnus-group-exit): Would offer to save summaries after + it was too late. + + * nnvirtual.el (nnvirtual-request-close): Function for cleaning up + nnvirtual. + +Wed May 31 16:37:02 1995 Per Abrahamsen + + * gnus-vis.el (gnus-summary-make-menu-bar): Added menu entry to + highlight article. + +Fri Jun 2 00:29:57 1995 Lars Ingebrigtsen + + * gnus.el (gnus-read-descriptions-file): Allow reading from + different servers. + (gnus-group-describe-group): Wouldn't describe foreign groups. + (gnus-read-all-descriptions-files): New function. + (gnus-group-get-new-news-this-group): Would step to the bottom of + the list. + (gnus-group-update-group): Would often insert groups one below + where they were supposed to go. + + * gnus-msg.el (gnus-copy-article-buffer): Didn't widen before + copying. + + * gnus.el (gnus-article-get-xrefs): Would bug out in obscure + circumstances. + + * gnus-ems.el: Would define make-face, which would confuse Info. + + * gnus.el (gnus-summary-next-article): Execute keystroke after `n' + in the right buffer. + + * gnus-edit.el (gnus-score-customize): Added keystroke and + autoload. + + * gnus.el (gnus-ask-server-for-new-groups): Did not open servers + before requesting. + (gnus-group-check-bogus-groups): Prefix now means "don't ask". + (gnus-check-bogus-newsgroups): Would bug out on several bogus + groups with the same name. + +Thu Jun 1 01:17:01 1995 Lars Ingebrigtsen + + * gnus-msg.el (gnus-post-news): Would 'ask even when posting. + (gnus-inews-insert-headers): Only remove message-id previously + generated by Gnus. + (gnus-inews-news): Insert the same message-id in mail copies of + news articles. + (gnus-deletable-headers): New variable. + + * nnmh.el (nnmh-request-list): Would mess up the list. + + * gnus.el (gnus-group-make-empty-virtual): Create a group that + matches nothing, not everything. + (gnus-group-catchup-current): Catch up component nnvirtual + groups. + + * gnus-soup.el: New file. + + * nnsoup.el: New file. + + * gnus-msg.el (gnus-inews-article-function): New variable. + (gnus-inews-article): Check headers after they have been + generated. + +Wed May 31 11:37:22 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-expire-articles): Cancelled instead of + canceled. + +Wed May 31 03:45:35 1995 Lars Magne Ingebrigtsen + + * nnmh.el (nnmh-request-expire-articles): If a file can't be + deleted, don't remove it from the list of expirables. + + * gnus.el: 0.80 is released. + Tue May 30 10:59:22 1995 Per Abrahamsen * gnus-cite.el (gnus-cite-attribution-postfix): Accept VinVN diff --git a/lisp/custom.el b/lisp/custom.el index b71f4b393..3acaf6d39 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -77,6 +77,8 @@ other hooks, such as major mode hooks, can do the job." (setq intangible 'intangible) (setq intangible 'intangible-if-it-had-been-working)) +(defvar custom-modified-list nil) + ;;; Faces: ;; ;; The following variables define the faces used in the customization @@ -713,7 +715,7 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value." (setq alist (cons (cons (custom-tag-or-type current) current) alist))) (let ((answer (if (listp last-input-event) (x-popup-menu last-input-event - (list tag (cons "" (reverse alist)))) + (list tag (cons "" (reverse alist)))) (let ((choice (completing-read (concat tag " (default " default "): ") alist nil t))) diff --git a/lisp/gnus-edit.el b/lisp/gnus-edit.el index 486cd95ea..673e2b84f 100644 --- a/lisp/gnus-edit.el +++ b/lisp/gnus-edit.el @@ -3,7 +3,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: news, help -;; Version: 0.0 +;; Version: 0.1 ;;; Commentary: ;; @@ -12,6 +12,7 @@ ;;; Code: (require 'custom) +(require 'gnus-score) (autoload 'gnus-score-load "gnus-score") @@ -456,7 +457,7 @@ field.")) (t (setcdr (assoc name gnus-score-alist) (list value))))) ((null value)) - ((litsp value) + ((listp value) (setq gnus-score-alist (cons (cons name value) gnus-score-alist))) (t (setq gnus-score-alist diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 9c682d16d..0cfdaa3a0 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -39,7 +39,7 @@ (setq gnus-easymenu 'auc-menu) (or (memq 'underline (list-faces)) - (make-face 'underline)) + (funcall (intern "make-face") 'underline)) (or (face-differs-from-default-p 'underline) (set-face-underline-p 'underline t)) (or (fboundp 'set-text-properties) @@ -99,8 +99,8 @@ (cond ((not window-system) (defun gnus-dummy-func (&rest args)) - (let ((funcs '(mouse-set-point make-face set-face-foreground - set-face-background))) + (let ((funcs '(mouse-set-point set-face-foreground + set-face-background x-popup-menu))) (while funcs (or (fboundp (car funcs)) (fset (car funcs) 'gnus-dummy-func)) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 957f89300..7771a60f0 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -148,6 +148,9 @@ RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines and X-Newsreader are optional. If you want Gnus not to insert some header, remove it from this list.") +(defvar gnus-deletable-headers '(Message-ID) + "*Headers to be deleted if they already exists.") + (defvar gnus-check-before-posting '(subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text @@ -192,6 +195,9 @@ Three pre-made functions are `gnus-mail-other-window-using-mail' The message must have To or Cc header. The default is copied from the variable `send-mail-function'.") +(defvar gnus-inews-article-function 'gnus-inews-article + "*Function to post an article.") + (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc) "*A hook called before finally posting an article. The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves @@ -374,6 +380,7 @@ header line with the old Message-ID." (buffer-name (get-buffer article-buffer))) (save-excursion (set-buffer article-buffer) + (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-text-properties (point-min) (point-max) nil gnus-article-copy))))) @@ -442,9 +449,10 @@ Type \\[describe-mode] in the buffer to get a list of commands." (setq gnus-article-reply sumart) ;; Handle `gnus-auto-mail-to-author'. ;; Suggested by Daniel Quinlan . - (let ((to (if (eq gnus-auto-mail-to-author 'ask) - (and (y-or-n-p "Also send mail to author? ") from) - (and gnus-auto-mail-to-author from)))) + (let ((to (and (not post) + (if (eq gnus-auto-mail-to-author 'ask) + (and (y-or-n-p "Also send mail to author? ") from) + (and gnus-auto-mail-to-author from))))) (if to (progn (if (mail-fetch-field "To") @@ -614,6 +622,13 @@ will attempt to use the foreign server to post the article." (forward-line -1) (gnus-delete-line))) + ;; We generate a Message-ID so that the mail and the + ;; news copy of the message both get the same ID. + (or (mail-fetch-field "message-id") + (progn + (goto-char (point-max)) + (insert "Message-ID: " (gnus-inews-message-id) "\n"))) + (save-restriction (widen) (gnus-message 5 "Sending via mail...") @@ -653,9 +668,9 @@ will attempt to use the foreign server to post the article." (goto-char (point-max)) (insert fcc-line)))))))) - ;; Send to NNTP server. + ;; Send to server. (gnus-message 5 "Posting to USENET...") - (if (gnus-inews-article use-group-method) + (if (funcall gnus-inews-article-function use-group-method) (progn (gnus-message 5 "Posting to USENET...done") (if (gnus-buffer-exists-p (car-safe reply)) @@ -853,7 +868,7 @@ will attempt to use the foreign server to post the article." "This is a cancel message from " from ".\n") ;; Send the control article to NNTP server. (gnus-message 5 "Canceling your article...") - (if (gnus-inews-article) + (if (funcall gnus-inews-article-function) (gnus-message 5 "Canceling your article...done") (ding) (gnus-message 1 "Cancel failed; %s" @@ -866,32 +881,33 @@ will attempt to use the foreign server to post the article." (defun gnus-inews-article (&optional use-group-method) "Post an article in current buffer using NNTP protocol." - ;; Check whether the article is a good Net Citizen. - (if (and gnus-article-check-size (not (gnus-inews-check-post))) - ;; Aber nein! - () - ;; Looks ok, so we do the nasty. - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-posting*"))) - (widen) - (goto-char (point-max)) - ;; require a newline at the end for inews to append .signature to - (or (= (preceding-char) ?\n) - (insert ?\n)) - ;; Prepare article headers. All message body such as signature - ;; must be inserted before Lines: field is prepared. - (save-restriction - (goto-char (point-min)) - (narrow-to-region - (point-min) - (save-excursion - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (match-beginning 0))) - (gnus-inews-remove-headers) - (gnus-inews-insert-headers) - (run-hooks gnus-inews-article-header-hook) - (widen)) + (let ((artbuf (current-buffer)) + (tmpbuf (get-buffer-create " *Gnus-posting*"))) + (widen) + (goto-char (point-max)) + ;; require a newline at the end for inews to append .signature to + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Prepare article headers. All message body such as signature + ;; must be inserted before Lines: field is prepared. + (save-restriction + (goto-char (point-min)) + (narrow-to-region + (point-min) + (save-excursion + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (match-beginning 0))) + (gnus-inews-remove-headers) + (gnus-inews-insert-headers) + (run-hooks gnus-inews-article-header-hook) + (widen)) + ;; Check whether the article is a good Net Citizen. + (if (and gnus-article-check-size + (not (gnus-inews-check-post))) + ;; Aber nein! + () + ;; Looks ok, so we do the nasty. (save-excursion (set-buffer tmpbuf) (buffer-disable-undo (current-buffer)) @@ -947,14 +963,15 @@ Headers in `gnus-required-headers' will be generated." (headers gnus-required-headers) (case-fold-search t) header value elem) - ;; First we remove any old Message-IDs. This might be slightly - ;; fascist, but if the user really wants to generate Message-IDs - ;; by herself, she should remove it from the `gnus-required-list'. - (goto-char (point-min)) - (and (memq 'Message-ID headers) - (re-search-forward "^Message-ID:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + ;; First we remove any old generated headers. + (let ((headers gnus-deletable-headers)) + (while headers + (goto-char (point-min)) + (and (re-search-forward + (concat "^" (symbol-name (car headers)) ": *") nil t) + (get-text-property 'gnus-delete (match-end 0)) + (gnus-delete-line)) + (setq headers (cdr headers)))) ;; Insert new Sender if the From is strange. (let ((from (mail-fetch-field "from"))) (if (and from (not (string= (downcase from) (downcase From)))) @@ -1010,6 +1027,11 @@ Headers in `gnus-required-headers' will be generated." ;; so we just ask the user. (read-from-minibuffer (format "Empty header for %s; enter value: " header)))) + ;; Add the deletable property to the headers that require it. + (and (memq header gnus-deletable-headers) + (add-text-properties + 0 (length value) '(gnus-deletable t) value)) + ;; Finally insert the header. (if (bolp) (save-excursion (goto-char (point-max)) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 8598009c0..802da63d9 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -105,6 +105,7 @@ of the last succesful match.") (define-key gnus-summary-score-map "e" 'gnus-score-edit-alist) (define-key gnus-summary-score-map "f" 'gnus-score-edit-file) (define-key gnus-summary-score-map "t" 'gnus-score-find-trace) +(define-key gnus-summary-score-map "C" 'gnus-score-customize) diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 57acd5cce..903c1b322 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -61,14 +61,16 @@ ;;; Code: -;;; Hack `gnus.el': - +(require 'gnus-msg) (require 'gnus) ;;; User Variables: -(defvar gnus-soup-directory "~/SOUP/" - "*Directory containing unpacked SOUP packet.") +(defvar gnus-soup-directory "~/SoupBrew/" + "*Directory containing an unpacked SOUP packet.") + +(defvar gnus-soup-replies-directory (concat gnus-soup-directory "SoupReplies/") + "*Directory where Gnus will do processing of replies.") (defvar gnus-soup-prefix-file "gnus-prefix" "*Name of the file where Gnus stores the last used prefix.") @@ -79,6 +81,16 @@ The SOUP files will be inserted where the %s is in the string. This string MUST contain both %s and %d. The file number will be inserted where %d appears.") +(defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -" + "*Format string command for unpacking a SOUP packet. +The SOUP packet file name will be inserted at the %s.") + +(defvar gnus-soup-packet-directory "~/" + "*Where gnus-soup will look for REPLIES packets.") + +(defvar gnus-soup-packet-regexp "Soupin" + "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.") + ;;; Internal Variables: (defvar gnus-soup-encoding-type ?n @@ -97,12 +109,52 @@ format.") Gnus will determine by itself what type to use in what group, so setting this variable won't do much.") -(defconst gnus-soup-areas nil) +(defvar gnus-soup-areas nil) (defvar gnus-soup-last-prefix nil) +(defvar gnus-soup-prev-prefix nil) (defvar gnus-soup-buffers nil) +;;; Access macros: + +(defmacro gnus-soup-area-prefix (area) + (` (aref (, area) 0))) +(defmacro gnus-soup-area-name (area) + (` (aref (, area) 1))) +(defmacro gnus-soup-area-encoding (area) + (` (aref (, area) 2))) +(defmacro gnus-soup-area-description (area) + (` (aref (, area) 3))) +(defmacro gnus-soup-area-number (area) + (` (aref (, area) 4))) +(defmacro gnus-soup-area-set-number (area value) + (` (aset (, area) 4 (, value)))) + +(defmacro gnus-soup-encoding-format (encoding) + (` (aref (, encoding) 0))) +(defmacro gnus-soup-encoding-index (encoding) + (` (aref (, encoding) 1))) +(defmacro gnus-soup-encoding-kind (encoding) + (` (aref (, encoding) 2))) + +(defmacro gnus-soup-reply-prefix (reply) + (` (aref (, reply) 0))) +(defmacro gnus-soup-reply-kind (reply) + (` (aref (, reply) 1))) +(defmacro gnus-soup-reply-encoding (reply) + (` (aref (, reply) 2))) + ;;; Commands: +(defun gnus-soup-send-replies () + "Unpack and send all replies in the reply packet." + (interactive) + (let ((packets (directory-files + gnus-soup-packet-directory t gnus-soup-packet-regexp))) + (while packets + (and (gnus-soup-send-packet (car packets)) + (delete-file (car packets))) + (setq packets (cdr packets))))) + (defun gnus-soup-add-article (n) "Add the current article to SOUP packet. If N is a positive number, add the N next articles. @@ -111,94 +163,49 @@ If N is nil and any articles have been marked with the process mark, move those articles instead." (interactive "P") (gnus-set-global-variables) - (add-hook 'gnus-exit-gnus-hook 'gnus-soup-save) - (or (file-directory-p gnus-soup-directory) - (gnus-make-directory gnus-soup-directory)) (let* ((articles (gnus-summary-work-articles n)) (tmp-buf (get-buffer-create "*soup work*")) - (prefix (aref (gnus-soup-area gnus-newsgroup-name) 0)) - (msg-buf (find-file-noselect - (concat gnus-soup-directory prefix ".MSG"))) - (idx-buf (find-file-noselect - (concat gnus-soup-directory prefix ".IDX"))) - from head-line beg type headers) - (setq gnus-soup-buffers (cons msg-buf (cons idx-buf gnus-soup-buffers))) + (area (gnus-soup-area gnus-newsgroup-name)) + (prefix (gnus-soup-area-prefix area)) + headers) (buffer-disable-undo tmp-buf) - (buffer-disable-undo msg-buf) - (buffer-disable-undo idx-buf) (save-excursion (while articles + ;; Find the header of the article. + (set-buffer gnus-summary-buffer) + (setq headers (gnus-get-header-by-number (car articles))) ;; Put the article in a buffer. (set-buffer tmp-buf) (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) - ;; Make sure the last char in the buffer is a newline. - (goto-char (point-max)) - (or (= (current-column) 0) - (insert "\n")) - ;; Find the "from". - (goto-char (point-min)) - (setq from - (mail-strip-quoted-names - (or (mail-fetch-field "from") - (mail-fetch-field "really-from") - (mail-fetch-field "sender")))) - (goto-char (point-min)) - ;; Depending on what encoding is supposed to be used, we make - ;; a soup header. - (setq head-line - (cond - ((= gnus-soup-encoding-type ?n) - (format "#! rnews %d\n" (buffer-size))) - ((= gnus-soup-encoding-type ?m) - (while (search-forward "\nFrom " nil t) - (replace-match "\n>From " t t)) - (concat "From " (or from "unknown") - " " (current-time-string) "\n")) - ((= gnus-soup-encoding-type ?M) - "\^a\^a\^a\^a\n") - (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) - ;; Find the header of the article. - (set-buffer gnus-summary-buffer) - (setq headers (gnus-get-header-by-number (car articles))) - ;; Insert the soup header and the article in the MSG buf. - (set-buffer msg-buf) - (goto-char (point-max)) - (insert head-line) - (setq beg (point)) - (insert-buffer tmp-buf) - ;; Insert the index in the IDX buf. - (cond ((= gnus-soup-index-type ?c) - (set-buffer idx-buf) - (gnus-soup-insert-idx beg headers)) - ((/= gnus-soup-index-type ?n) - (error "Unknown index type: %c" type))) + (gnus-soup-store gnus-soup-directory prefix headers + gnus-soup-encoding-type + gnus-soup-index-type) + (gnus-soup-area-set-number area + (1+ (or (gnus-soup-area-number area) 0))) + ;; Mark article as read. (set-buffer gnus-summary-buffer) (gnus-summary-remove-process-mark (car articles)) (gnus-summary-mark-as-read (car articles) "F") (setq articles (cdr articles))) (kill-buffer tmp-buf)))) -(defun gnus-soup-group-brew (group) - (let ((gnus-expert-user t) - (gnus-large-newsgroup nil)) - (and (gnus-summary-read-group group) - (let ((gnus-newsgroup-processable - (gnus-sorted-complement - gnus-newsgroup-unreads - (append gnus-newsgroup-dormant gnus-newsgroup-marked)))) - (gnus-soup-add-article nil))) - (gnus-summary-exit))) +(defun gnus-soup-pack-packet () + "Make a SOUP packet from the SOUP areas." + (interactive) + (gnus-soup-read-areas) + (gnus-soup-pack gnus-soup-directory gnus-soup-packer)) (defun gnus-group-brew-soup (n) - "Make a soup packet from the current group." + "Make a soup packet from the current group. +Uses the process/prefix convention." (interactive "P") (let ((groups (gnus-group-process-prefix n))) (while groups (gnus-group-remove-mark (car groups)) (gnus-soup-group-brew (car groups)) (setq groups (cdr groups))) - (gnus-soup-save))) + (gnus-soup-save-areas))) (defun gnus-brew-soup (&optional level) "Go through all groups on LEVEL or less and make a soup packet." @@ -209,10 +216,94 @@ move those articles instead." (and (<= (nth 1 (car newsrc)) level) (gnus-soup-group-brew (car (car newsrc)))) (setq newsrc (cdr newsrc))) - (gnus-soup-save))) + (gnus-soup-save-areas))) + +;;;###autoload +(defun gnus-batch-brew-soup () + "Brew a SOUP packet from groups mention on the command line. +Will use the remaining command line arguments as regular expressions +for matching on group names. + +For instance, if you want to brew on all the nnml groups, as well as +groups with \"emacs\" in the name, you could say something like: + +$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" + (interactive) + ) ;;; Internal Functions: +;; Store the article in the current buffer. +(defun gnus-soup-store (directory prefix headers format index) + (add-hook 'gnus-exit-gnus-hook 'gnus-soup-save-areas) + ;; Create the directory, if needed. + (or (file-directory-p directory) + (gnus-make-directory directory)) + (let* ((msg-buf (gnus-find-file-noselect + (concat directory prefix ".MSG"))) + (idx-buf (if (= index ?n) + nil + (gnus-find-file-noselect + (concat directory prefix ".IDX")))) + (article-buf (current-buffer)) + from head-line beg type) + (setq gnus-soup-buffers (cons msg-buf gnus-soup-buffers)) + (buffer-disable-undo msg-buf) + (and idx-buf + (progn + (setq gnus-soup-buffers (cons idx-buf gnus-soup-buffers)) + (buffer-disable-undo idx-buf))) + (save-excursion + ;; Make sure the last char in the buffer is a newline. + (goto-char (point-max)) + (or (= (current-column) 0) + (insert "\n")) + ;; Find the "from". + (goto-char (point-min)) + (setq from + (mail-strip-quoted-names + (or (mail-fetch-field "from") + (mail-fetch-field "really-from") + (mail-fetch-field "sender")))) + (goto-char (point-min)) + ;; Depending on what encoding is supposed to be used, we make + ;; a soup header. + (setq head-line + (cond + ((= gnus-soup-encoding-type ?n) + (format "#! rnews %d\n" (buffer-size))) + ((= gnus-soup-encoding-type ?m) + (while (search-forward "\nFrom " nil t) + (replace-match "\n>From " t t)) + (concat "From " (or from "unknown") + " " (current-time-string) "\n")) + ((= gnus-soup-encoding-type ?M) + "\^a\^a\^a\^a\n") + (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) + ;; Insert the soup header and the article in the MSG buf. + (set-buffer msg-buf) + (goto-char (point-max)) + (insert head-line) + (setq beg (point)) + (insert-buffer-substring article-buf) + ;; Insert the index in the IDX buf. + (cond ((= index ?c) + (set-buffer idx-buf) + (gnus-soup-insert-idx beg headers)) + ((/= index ?n) + (error "Unknown index type: %c" type)))))) + +(defun gnus-soup-group-brew (group) + (let ((gnus-expert-user t) + (gnus-large-newsgroup nil)) + (and (gnus-summary-read-group group) + (let ((gnus-newsgroup-processable + (gnus-sorted-complement + gnus-newsgroup-unreads + (append gnus-newsgroup-dormant gnus-newsgroup-marked)))) + (gnus-soup-add-article nil))) + (gnus-summary-exit))) + (defun gnus-soup-insert-idx (offset header) ;; [number subject from date id references chars lines xref] (goto-char (point-max)) @@ -232,7 +323,7 @@ move those articles instead." (or (header-lines header) "0") (or (header-xref header) "")))) -(defun gnus-soup-save () +(defun gnus-soup-save-areas () (gnus-soup-write-areas) (save-excursion (let (buf) @@ -244,32 +335,36 @@ move those articles instead." (set-buffer buf) (and (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer))))) - (gnus-set-work-buffer) - (insert (format "(setq gnus-soup-last-prefix %d)\n" - gnus-soup-last-prefix)) - (write-region (point-min) (point-max) gnus-soup-prefix-file nil 'nomesg))) - -(defun gnus-soup-pack () - (let* ((dir (file-name-nondirectory - (directory-file-name - (file-name-as-directory gnus-soup-directory)))) - (top (file-name-directory - (directory-file-name - (file-name-as-directory gnus-soup-directory)))) - (files (mapconcat (lambda (f) (concat dir "/" f)) + (let ((prefix gnus-soup-last-prefix)) + (while prefix + (gnus-set-work-buffer) + (insert (format "(setq gnus-soup-prev-prefix %d)\n" + (cdr (car prefix)))) + (write-region (point-min) (point-max) + (concat (car (car prefix)) + gnus-soup-prefix-file) + nil 'nomesg) + (setq prefix (cdr prefix)))))) + +(defun gnus-soup-pack (dir packer) + (let* ((files (mapconcat 'identity '("AREAS" "*.MSG" "*.IDX" "INFO" "LIST" "REPLIES" "COMMANDS" "ERRORS") " ")) - (packer (if (< (string-match "%s" gnus-soup-packer) - (string-match "%d" gnus-soup-packer)) - (format gnus-soup-packer files + (packer (if (< (string-match "%s" packer) + (string-match "%d" packer)) + (format packer files (string-to-int (gnus-soup-unique-prefix))) - (format gnus-soup-packer - (string-to-int (gnus-soup-unique-prefix)) files)))) + (format packer + (string-to-int (gnus-soup-unique-prefix)) files))) + (dir (expand-file-name dir))) + (message "Packing %s..." packer) (if (zerop (call-process "sh" nil nil nil "-c" - (concat "cd " top " ; " packer))) - (call-process "sh" nil nil nil "-c" - (concat "cd " top " ; rm " files)) + (concat "cd " dir " ; " packer))) + (progn + (call-process "sh" nil nil nil "-c" + (concat "cd " dir " ; rm " files)) + (message "Packing...done" packer)) (error "Couldn't pack packet.")))) (defun gnus-soup-parse-areas (file) @@ -280,7 +375,7 @@ The vector contain five strings, though the two last may be nil if they are missing." (let (areas) (save-excursion - (set-buffer (find-file-noselect file)) + (set-buffer (gnus-find-file-noselect file 'force)) (buffer-disable-undo) (goto-char (point-min)) (while (not (eobp)) @@ -288,13 +383,33 @@ though the two last may be nil if they are missing." (cons (vector (gnus-soup-field) (gnus-soup-field) (gnus-soup-field) - (and (eq (preceding-char) ?\t) (gnus-soup-field)) - (and (eq (preceding-char) ?\t) (gnus-soup-field))) + (and (eq (preceding-char) ?\t) + (gnus-soup-field)) + (and (eq (preceding-char) ?\t) + (string-to-int (gnus-soup-field)))) areas)) (if (eq (preceding-char) ?\t) (beginning-of-line 2)))) areas)) +(defun gnus-soup-parse-replies (file) + "Parse soup REPLIES file FILE. +The result is a of vectors, each containing one entry from the REPLIES +file. The vector contain three strings, [prefix name encoding]." + (let (replies) + (save-excursion + (set-buffer (gnus-find-file-noselect file)) + (buffer-disable-undo (current-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (setq replies + (cons (vector (gnus-soup-field) (gnus-soup-field) + (gnus-soup-field)) + replies)) + (if (eq (preceding-char) ?\t) + (beginning-of-line 2)))) + replies)) + (defun gnus-soup-field () (prog1 (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) @@ -306,54 +421,161 @@ though the two last may be nil if they are missing." (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) (defun gnus-soup-write-areas () + (if (not gnus-soup-areas) + () + (save-excursion + (set-buffer (gnus-find-file-noselect + (concat gnus-soup-directory "AREAS"))) + (erase-buffer) + (let ((areas gnus-soup-areas) + area) + (while areas + (setq area (car areas) + areas (cdr areas)) + (insert (format "%s\t%s\t%s%s\n" + (gnus-soup-area-prefix area) + (gnus-soup-area-name area) + (gnus-soup-area-encoding area) + (if (or (gnus-soup-area-description area) + (gnus-soup-area-number area)) + (concat "\t" (or (gnus-soup-area-description + area) + "") + (if (gnus-soup-area-number area) + (concat "\t" + (int-to-string + (gnus-soup-area-number + area))) + "")) ""))))) + (write-region (point-min) (point-max) + (concat gnus-soup-directory "AREAS")) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))))) + +(defun gnus-soup-write-replies (dir areas) (save-excursion - (set-buffer (find-file-noselect (concat gnus-soup-directory "AREAS"))) + (set-buffer (gnus-find-file-noselect (concat dir "REPLIES"))) (erase-buffer) - (let ((areas gnus-soup-areas) - area) + (let (area) (while areas (setq area (car areas) areas (cdr areas)) - (insert (aref area 0) ?\t (aref area 1) ?\t (aref area 2) ?\n))) - (write-region (point-min) (point-max) - (concat gnus-soup-directory "AREAS")) + (insert (format "%s\t%s\t%s\n" + (gnus-soup-reply-prefix area) + (gnus-soup-reply-kind area) + (gnus-soup-reply-encoding area))))) + (write-region (point-min) (point-max) (concat dir "REPLIES")) (set-buffer-modified-p nil) (kill-buffer (current-buffer)))) (defun gnus-soup-area (group) (gnus-soup-read-areas) (let ((areas gnus-soup-areas) + (real-group (gnus-group-real-name group)) area result) (while areas (setq area (car areas) areas (cdr areas)) - (if (equal (aref area 1) group) + (if (equal (gnus-soup-area-name area) real-group) (setq result area))) (or result (setq result (vector (gnus-soup-unique-prefix) - group + real-group (format "%c%c%c" gnus-soup-encoding-type gnus-soup-index-type - (if (gnus-member-of-valid 'mail group) ?m ?n) - nil nil)) + (if (gnus-member-of-valid 'mail group) ?m ?n)) + nil nil) gnus-soup-areas (cons result gnus-soup-areas))) result)) -(defun gnus-soup-unique-prefix () - (if gnus-soup-last-prefix - () - (if (file-exists-p gnus-soup-prefix-file) - (condition-case nil - (load-file gnus-soup-prefix-file) - (error 0)) - (setq gnus-soup-last-prefix 0))) - (int-to-string (setq gnus-soup-last-prefix (1+ gnus-soup-last-prefix)))) - +(defun gnus-soup-unique-prefix (&optional dir) + (let* ((dir (file-name-as-directory (or dir gnus-soup-directory))) + (entry (assoc dir gnus-soup-last-prefix)) + gnus-soup-prev-prefix) + (if entry + () + (and (file-exists-p (concat dir gnus-soup-prefix-file)) + (condition-case nil + (load-file (concat dir gnus-soup-prefix-file)) + (setq error nil))) + (setq gnus-soup-last-prefix + (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0))) + gnus-soup-last-prefix))) + (setcdr entry (1+ (cdr entry))) + (int-to-string (cdr entry)))) + +(defun gnus-soup-unpack-packet (dir unpacker packet) + (gnus-make-directory dir) + (message "Unpacking: %s" (format unpacker packet)) + (call-process + "sh" nil nil nil "-c" + (format "cd %s ; %s" (expand-file-name dir) (format unpacker packet))) + (message "Unpacking...done")) + +(defun gnus-soup-send-packet (packet) + (gnus-soup-unpack-packet + gnus-soup-replies-directory gnus-soup-unpacker packet) + (let ((replies (gnus-soup-parse-replies + (concat gnus-soup-replies-directory "REPLIES")))) + (save-excursion + (while replies + (let* ((msg-file (concat gnus-soup-replies-directory + (gnus-soup-reply-prefix (car replies)) + ".MSG")) + (msg-buf (and (file-exists-p msg-file) + (gnus-find-file-noselect msg-file))) + (tmp-buf (get-buffer-create " *soup send*")) + beg end) + (cond + ((/= (gnus-soup-encoding-format + (gnus-soup-reply-encoding (car replies))) ?n) + (error "Unsupported encoding")) + ((null msg-buf) + t) + (t + (buffer-disable-undo msg-buf) + (buffer-disable-undo tmp-buf) + (set-buffer msg-buf) + (goto-char (point-min)) + (while (not (eobp)) + (or (looking-at "#! *rnews +\\([0-9]+\\)") + (error "Bad header.")) + (forward-line 1) + (setq beg (point) + end (+ (point) (string-to-int + (buffer-substring + (match-beginning 1) (match-end 1))))) + (switch-to-buffer tmp-buf) + (erase-buffer) + (insert-buffer-substring msg-buf beg end) + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (insert mail-header-separator) + (cond + ((string= (gnus-soup-reply-kind (car replies)) "news") + (message "Sending news message to %s..." + (mail-fetch-field "newsgroups")) + (sit-for 1) + (gnus-inews-article)) + ((string= (gnus-soup-reply-kind (car replies)) "mail") + (message "Sending mail to %s..." + (mail-fetch-field "to")) + (sit-for 1) + (gnus-mail-send-and-exit)) + (t + (error "Unknown reply kind"))) + (set-buffer msg-buf) + (goto-char end)) + (delete-file (buffer-file-name)) + (kill-buffer msg-buf) + (kill-buffer tmp-buf) + (message "Sent packet")))) + (setq replies (cdr replies))) + t))) + (provide 'gnus-soup) ;;; gnus-soup.el ends here - - - diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el index afe7671db..5b3720241 100644 --- a/lisp/gnus-vis.el +++ b/lisp/gnus-vis.el @@ -208,8 +208,7 @@ highlight-headers-follow-url-netscape: ["Read init file" gnus-group-read-init-file t] ["Browse foreign server" gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] - ["Edit the global kill file" gnus-group-edit-global-kill t] - ["Expire all expirable articles" gnus-group-expire-all-groups t] + ["Expire expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] ["Save .newsrc files" gnus-group-save-newsrc t] @@ -217,8 +216,8 @@ highlight-headers-follow-url-netscape: ["Clear dribble buffer" gnus-group-clear-dribble t] ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] + ["Edit global kill file" gnus-group-edit-global-kill t] ["Sort group buffer" gnus-group-sort-groups t] - ["Edit global KILL file" gnus-group-edit-global-kill t] )) ) @@ -402,7 +401,6 @@ highlight-headers-follow-url-netscape: ["Expire expirable articles" gnus-summary-expire-articles t] ["Describe group" gnus-summary-describe-group t] ["Edit local kill file" gnus-summary-edit-local-kill t] - ["Edit global kill file" gnus-summary-edit-global-kill t] )) (easy-menu-define @@ -438,6 +436,7 @@ highlight-headers-follow-url-netscape: ["Current score" gnus-summary-current-score t] ["Set score" gnus-summary-set-score t] ("Score file" + ["Customize score file" gnus-score-customize t] ["Switch current score file" gnus-score-change-score-file t] ["Set mark below" gnus-score-set-mark-below t] ["Set expunge below" gnus-score-set-expunge-below t] diff --git a/lisp/gnus.el b/lisp/gnus.el index 42c3cb06d..b940dd478 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1275,7 +1275,7 @@ variable (string, integer, character, etc).") (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)" "The mail address of the Gnus maintainer.") -(defconst gnus-version "(ding) Gnus v0.80" +(defconst gnus-version "(ding) Gnus v0.81" "Version number for this version of Gnus.") (defvar gnus-info-nodes @@ -1500,6 +1500,7 @@ Thank you for your help in stamping out bugs. (autoload 'mail-extract-address-components "mail-extr") (autoload 'nnmail-split-fancy "nnmail") + (autoload 'nnvirtual-catchup-group "nnvirtual") ;; timezone (autoload 'timezone-make-date-arpa-standard "timezone") @@ -1522,6 +1523,10 @@ Thank you for your help in stamping out bugs. (autoload 'gnus-group-brew-soup "gnus-soup" nil t) (autoload 'gnus-brew-soup "gnus-soup" nil t) (autoload 'gnus-soup-add-article "gnus-soup" nil t) + (autoload 'gnus-soup-send-replies "gnus-soup" nil t) + (autoload 'gnus-soup-save-areas "gnus-soup" nil t) + (autoload 'gnus-soup-pack-packet "gnus-soup" nil t) + (autoload 'nnsoup-pack-replies "nnsoup" nil t) ;; gnus-mh (autoload 'gnus-mail-reply-using-mhe "gnus-mh") @@ -1588,6 +1593,9 @@ Thank you for your help in stamping out bugs. (autoload 'gnus-possibly-score-headers "gnus-score") (autoload 'gnus-score-find-trace "gnus-score") + ;; gnus-edit + (autoload 'gnus-score-customize "gnus-edit" nil t) + ;; gnus-uu (autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap) (autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap) @@ -1790,7 +1798,7 @@ Thank you for your help in stamping out bugs. (if (and (string-match "%D" gnus-group-line-format) (not gnus-description-hashtb) gnus-read-active-file) - (gnus-read-descriptions-file)) + (gnus-read-all-descriptions-files)) (setq gnus-summary-mode-line-format-spec (gnus-parse-format gnus-summary-mode-line-format gnus-summary-mode-line-format-alist)) @@ -2662,6 +2670,24 @@ If nothing is specified, use the variable gnus-overload-functions." (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) name)) +(defun gnus-find-file-noselect (file &optional force) + "Does vaguely the same as find-file-noselect. No hooks are run." + (let (buf insert) + (if (setq buf (get-file-buffer file)) + (setq insert force) + (setq buf (create-file-buffer file)) + (setq insert t)) + (if (not insert) + buf + (save-excursion + (set-buffer buf) + (erase-buffer) + (and (file-readable-p file) + (insert-file-contents file)) + (set-visited-file-name file) + (set-buffer-modified-p nil) + (current-buffer))))) + ;;; List and range functions (defun gnus-last-element (list) @@ -2985,6 +3011,11 @@ Note: LIST has to be sorted over `<'." (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual) (define-key gnus-group-group-map "D" 'gnus-group-enter-directory) (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group) + (define-key gnus-group-group-map "sb" 'gnus-group-brew-soup) + (define-key gnus-group-group-map "sw" 'gnus-soup-save-areas) + (define-key gnus-group-group-map "ss" 'gnus-soup-send-replies) + (define-key gnus-group-group-map "sp" 'gnus-soup-pack-packet) + (define-key gnus-group-group-map "sr" 'nnsoup-pack-replies) (define-prefix-command 'gnus-group-list-map) (define-key gnus-group-mode-map "A" 'gnus-group-list-map) @@ -3234,7 +3265,7 @@ If REGEXP, only list groups matching REGEXP." (string-match regexp group)) (progn (setq beg (point)) - (insert (format " %c *: %s\n" mark group)) + (insert (format " %c *: %s\n" mark group)) (add-text-properties beg (1+ beg) (list 'gnus-group (intern group) @@ -3470,7 +3501,8 @@ If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." ;; go, and insert it there (or at the end of the buffer). ;; Fix by Per Abrahamsen . (or visible-only - (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb)))) + (let ((entry + (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb))))) (while (and entry (car entry) (not @@ -3479,8 +3511,7 @@ If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." (point-min) (point-max) 'gnus-group (intern (car (car entry))))))) (setq entry (cdr entry))) - (if entry (forward-line 1) - (goto-char (point-max))))))) + (or entry (goto-char (point-max))))))) (if (or visible (not visible-only)) (gnus-group-insert-group-line-info group)) (gnus-group-set-mode-line)))) @@ -3687,14 +3718,15 @@ If argument ALL is non-nil, already read articles become readable." (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." - (interactive (list (completing-read "Group: " gnus-active-hashtb nil - (not (not gnus-read-active-file))))) + (interactive + (list (completing-read + "Group: " gnus-active-hashtb nil (not (not gnus-read-active-file))))) (if (equal group "") - (error "empty group name")) + (error "Empty group name")) - (let ((b (text-property-any (point-min) (point-max) - 'gnus-group (intern group)))) + (let ((b (text-property-any + (point-min) (point-max) 'gnus-group (intern group)))) (if b ;; Either go to the line in the group buffer... (goto-char b) @@ -3705,8 +3737,8 @@ If argument ALL is non-nil, already read articles become readable." (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) - (goto-char (text-property-any (point-min) (point-max) - 'gnus-group (intern group))))) + (goto-char (text-property-any + (point-min) (point-max) 'gnus-group (intern group))))) ;; Adjust cursor point. (gnus-group-position-cursor)) @@ -4047,7 +4079,7 @@ score file entries for articles to include in the group." (defun gnus-group-make-empty-virtual (group) "Create a new, fresh, empty virtual group." (interactive "sCreate new, empty virtual group: ") - (let* ((method (list 'nnvirtual "")) + (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. (and (gnus-gethash pgroup gnus-newsrc-hashtb) @@ -4083,7 +4115,7 @@ score file entries for articles to include in the group." (setq gnus-newsrc-alist (sort (cdr gnus-newsrc-alist) gnus-group-sort-function)) (gnus-make-hashtable-from-newsrc-alist) - (gnus-group-list-groups nil)) + (gnus-group-list-groups nil gnus-have-all-newsgroups)) (defun gnus-group-sort-by-alphabet (info1 info2) (string< (car info1) (car info2))) @@ -4117,11 +4149,17 @@ caught up is returned." (let ((groups (gnus-group-process-prefix n)) (ret 0)) (while groups + ;; Virtual groups have to be given special treatment. + (let ((method (gnus-find-method-for-group (car groups)))) + (if (eq 'nnvirtual (car method)) + (nnvirtual-catchup-group + (gnus-group-real-name (car groups)) (nth 1 method) all))) (gnus-group-remove-mark (car groups)) - (if (not (gnus-group-goto-group (car groups))) - (setq ret (1+ ret)) - (gnus-group-catchup (car groups) all) - (gnus-group-update-group-line)) + (if (prog1 + (gnus-group-goto-group (car groups)) + (gnus-group-catchup (car groups) all)) + (gnus-group-update-group-line) + (setq ret (1+ ret))) (setq groups (cdr groups))) (gnus-group-next-unread-group 1) ret))) @@ -4411,7 +4449,7 @@ If N is negative, this group and the N-1 previous groups will be checked." ;; the first line in the group buffer, but it does. So we set the ;; window start forcibly. ; (set-window-start (get-buffer-window (current-buffer)) w-p) - (forward-line 1) + (gnus-group-next-unread-group 1 t) (gnus-summary-position-cursor) ret)) @@ -4436,14 +4474,19 @@ If N is negative, this group and the N-1 previous groups will be checked." (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." - (interactive "P") + (interactive (list current-prefix-arg (gnus-group-group-name))) (and force (setq gnus-description-hashtb nil)) - (let ((group (or group (gnus-group-group-name))) + (let ((method (gnus-find-method-for-group group)) desc) (or group (error "No group name given")) - (and (or gnus-description-hashtb + (and (or (and gnus-description-hashtb + ;; We check whether this group's method has been + ;; queried for a description file. + (gnus-gethash + (gnus-group-prefixed-name "" method) + gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) - (gnus-read-descriptions-file)) + (gnus-read-descriptions-file method)) (message (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) @@ -4454,7 +4497,7 @@ If N is negative, this group and the N-1 previous groups will be checked." (interactive "P") (and force (setq gnus-description-hashtb nil)) (if (not (or gnus-description-hashtb - (gnus-read-descriptions-file))) + (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) (let ((buffer-read-only nil) b) @@ -4518,7 +4561,7 @@ If N is negative, this group and the N-1 previous groups will be checked." "List all newsgroups that have names or desccriptions that match a regexp." (interactive "sGnus description apropos (regexp): ") (if (not (or gnus-description-hashtb - (gnus-read-descriptions-file))) + (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) (gnus-group-apropos regexp t)) @@ -4561,10 +4604,12 @@ If LOWEST, don't list groups with level lower than LOWEST." (interactive) (gnus-read-init-file)) -(defun gnus-group-check-bogus-groups () - "Check bogus newsgroups." - (interactive) - (gnus-check-bogus-newsgroups (not gnus-expert-user)) ;Require confirmation. +(defun gnus-group-check-bogus-groups (silent) + "Check bogus newsgroups. +If given a prefix, don't ask for confirmation before removing a bogus +group." + (interactive "P") + (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) (gnus-group-list-groups nil gnus-have-all-newsgroups)) (defun gnus-group-edit-global-kill (article &optional group) @@ -4625,8 +4670,8 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) (progn (run-hooks 'gnus-exit-gnus-hook) - (gnus-save-newsrc-file) (gnus-offer-save-summaries) + (gnus-save-newsrc-file) (gnus-close-backends) (gnus-clear-system)))) @@ -6764,6 +6809,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (let ((headers (save-excursion (set-buffer gnus-summary-buffer) gnus-current-headers))) (or (not gnus-use-cross-reference) + (not headers) (and (header-xref headers) (not (string= (header-xref headers) ""))) (let ((case-fold-search t) @@ -7491,6 +7537,7 @@ If UNREAD, only unread articles are selected. If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next." (interactive "P") + (gnus-set-global-variables) (let ((opoint (point)) (method (car (gnus-find-method-for-group gnus-newsgroup-name))) header) @@ -7561,9 +7608,9 @@ If BACKWARD, the previous article is selected instead of the next." (let ((obuf (current-buffer))) (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group group) - (execute-kbd-macro (char-to-string key)) (setq group (gnus-group-group-name)) - (switch-to-buffer obuf))))) + (switch-to-buffer obuf) + (execute-kbd-macro (char-to-string key)))))) (if (eq key cmd) (if (or (not group) (assoc 'quit-config (gnus-find-method-for-group @@ -8303,7 +8350,7 @@ functions. (Ie. mail newsgroups at present.)" ;; really expired articles as non-existant. (while expirable (or (memq (car expirable) gnus-newsgroup-expirable) - (gnus-summary-mark-as-read (car expirable) "%")) + (gnus-summary-mark-as-read (car expirable) gnus-canceled-mark)) (setq expirable (cdr expirable)))))) ;; Suggested by Jack Vinson . @@ -10216,6 +10263,14 @@ or not." (delete-char 2)) ((gnus-message 3 "Malformed MIME quoted-printable message")))))) +(defvar gnus-article-time-units + (list (cons 'year (* 365.25 24 60 60)) + (cons 'week (* 7 24 60 60)) + (cons 'day (* 24 60 60)) + (cons 'hour (* 60 60)) + (cons 'minute 60) + (cons 'second 1))) + (defun gnus-article-date-ut (&optional type) "Convert DATE date to universal time in the current article. If TYPE is `local', convert to local time; if it is `lapsed', output @@ -10225,7 +10280,8 @@ how much time has lapsed since DATE." (gnus-get-header-by-number (gnus-summary-article-number))""))) (date-regexp "^Date: \\|^X-Sent: ")) - (if (not date) + (if (or (not date) + (string= date "")) () (save-excursion (set-buffer gnus-article-buffer) @@ -10247,17 +10303,14 @@ how much time has lapsed since DATE." (concat "Date: " (timezone-make-date-arpa-standard date nil "UT") "\n")) ((eq type 'lapsed) - (let* ((sec (- (gnus-seconds-since-epoch - (timezone-make-date-arpa-standard - (current-time-string) (current-time-zone) "UT")) - (gnus-seconds-since-epoch - (timezone-make-date-arpa-standard date nil "UT")))) - (units (list (cons 'year (* 365.25 24 60 60)) - (cons 'week (* 7 24 60 60)) - (cons 'day (* 24 60 60)) - (cons 'hour (* 60 60)) - (cons 'minute 60) - (cons 'second 1))) + (let* ((sec (max (- (gnus-seconds-since-epoch + (timezone-make-date-arpa-standard + (current-time-string) + (current-time-zone) "UT")) + (gnus-seconds-since-epoch + (timezone-make-date-arpa-standard + date nil "UT"))) + 0)) num prev) (concat "X-Sent: " @@ -10271,7 +10324,7 @@ how much time has lapsed since DATE." " " (symbol-name (car unit)) (if (> num 1) "s" "")) (setq prev t)))) - units "") + gnus-article-time-units "") " ago\n"))) (t (error "Unknown conversion type: %s" type))))))))) @@ -11299,14 +11352,16 @@ The `-n' option line from .newsrc is respected." ;; Go thorugh both primary and secondary select methods and ;; request new newsgroups. (while methods - (if (gnus-request-newgroups date (car methods)) - (save-excursion - (setq got-new t) - (or hashtb (setq hashtb (gnus-make-hashtable - (count-lines (point-min) (point-max))))) - (set-buffer nntp-server-buffer) - ;; Enter all the new groups in a hashtable. - (gnus-active-to-gnus-format (car methods) hashtb))) + (and (or (gnus-server-opened (car methods)) + (gnus-open-server (car methods))) + (gnus-request-newgroups date (car methods)) + (save-excursion + (setq got-new t) + (set-buffer nntp-server-buffer) + (or hashtb (setq hashtb (gnus-make-hashtable + (count-lines (point-min) (point-max))))) + ;; Enter all the new groups in a hashtable. + (gnus-active-to-gnus-format (car methods) hashtb))) (setq methods (cdr methods))) (and got-new (setq gnus-newsrc-last-checked-date new-date)) ;; Now all new groups from all select methods are in `hashtb'. @@ -11415,7 +11470,7 @@ The `-n' option line from .newsrc is respected." (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) - (listp entry)) + (consp entry)) (setq oldlevel (car (cdr (nth 2 entry))))) (if (stringp previous) (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) @@ -11508,18 +11563,18 @@ The `-n' option line from .newsrc is respected." If CONFIRM is non-nil, the user has to confirm the deletion of every newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) - bogus group) + bogus group entry) (gnus-message 5 "Checking bogus newsgroups...") (or gnus-have-read-active-file (gnus-read-active-file)) ;; Find all bogus newsgroup that are subscribed. (while newsrc (setq group (car (car newsrc))) - (if (or (gnus-gethash group gnus-active-hashtb) - (nth 4 (car newsrc)) + (if (or (gnus-gethash group gnus-active-hashtb) ; Active + (nth 4 (car newsrc)) ; Foreign (and confirm (not (gnus-y-or-n-p (format "Remove bogus newsgroup: %s " group))))) - ;; Active newsgroup. + ;; Don't remove. () ;; Found a bogus newsgroup. (setq bogus (cons group bogus))) @@ -11527,9 +11582,10 @@ newsgroup." ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. (while bogus - (gnus-group-change-level - (gnus-gethash (car bogus) gnus-newsrc-hashtb) gnus-level-killed) - (setq gnus-killed-list (delete (car bogus) gnus-killed-list)) + (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb)) + (progn + (gnus-group-change-level entry gnus-level-killed) + (setq gnus-killed-list (delete (car bogus) gnus-killed-list)))) (setq bogus (cdr bogus))) ;; Then we remove all bogus groups from the list of killed and ;; zombie groups. They are are removed without confirmation. @@ -11889,7 +11945,7 @@ Returns whether the updating was successful." (gnus-active-to-gnus-format (and gnus-have-read-active-file (car methods))) (setq gnus-have-read-active-file t) - (gnus-message 5 "%s...done" mesg))))) + (gnus-message 5 "%sdone" mesg))))) (setq methods (cdr methods)))))) ;; Read an active file and place the results in `gnus-active-hashtb'. @@ -11909,12 +11965,14 @@ Returns whether the updating was successful." (progn (goto-char (point-min)) (delete-matching-lines gnus-ignored-newsgroups))) + ;; If these are groups from a foreign select method, we insert the + ;; group prefix in front of the group names. (and method (not (eq method gnus-select-method)) (let ((prefix (gnus-group-prefixed-name "" method))) (goto-char (point-min)) (while (and (not (eobp)) - (null (insert prefix)) - (zerop (forward-line 1)))))) + (progn (insert prefix) + (zerop (forward-line 1))))))) (goto-char (point-min)) ;; Store active file in hashtable. (goto-char (point-min)) @@ -12483,48 +12541,60 @@ If FORCE is non-nil, the .newsrc file is read." (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg) (kill-buffer (current-buffer))))) -(defun gnus-read-descriptions-file () - (gnus-message 5 "Reading descriptions file...") - (cond - ((not (or (gnus-server-opened gnus-select-method) - (gnus-open-server gnus-select-method))) - (gnus-message 1 "Couldn't open server") - nil) - ((not (gnus-request-list-newsgroups gnus-select-method)) - (gnus-message 1 "Couldn't read newsgroups descriptions") - nil) - (t - (let (group) - (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb))) - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (if (or (search-forward "\n.\n" nil t) - (goto-char (point-max))) - (progn - (beginning-of-line) - (narrow-to-region (point-min) (point)))) - (goto-char (point-min)) - (while (not (eobp)) - ;; If we get an error, we set group to 0, which is not a - ;; symbol... - (setq group - (condition-case () - (let ((obarray gnus-description-hashtb)) - ;; Group is set to a symbol interned in this - ;; hash table. - (read nntp-server-buffer)) - (error 0))) - (skip-chars-forward " \t") - ;; ... which leads to this line being effectively ignored. - (and (symbolp group) - (set group (buffer-substring - (point) (progn (end-of-line) (point))))) - (forward-line 1)))) - (gnus-message 5 "Reading descriptions file...done") - t)))) +(defun gnus-read-all-descriptions-files () + (let ((methods (nconc (list gnus-select-method) + gnus-secondary-select-methods))) + (while methods + (gnus-read-descriptions-file (car methods)) + (setq methods (cdr methods))))) + +(defun gnus-read-descriptions-file (&optional method) + (let ((method (or method gnus-select-method))) + (gnus-message 5 "Reading descriptions file via %s..." (car method)) + (cond + ((not (or (gnus-server-opened method) + (gnus-open-server method))) + (gnus-message 1 "Couldn't open server") + nil) + ((not (gnus-request-list-newsgroups method)) + (gnus-message 1 "Couldn't read newsgroups descriptions") + nil) + (t + (let (group) + (or gnus-description-hashtb + (setq gnus-description-hashtb + (gnus-make-hashtable (length gnus-active-hashtb)))) + ;; Mark this method's desc file as read. + (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" + gnus-description-hashtb) + (save-excursion + (save-restriction + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (if (or (search-forward "\n.\n" nil t) + (goto-char (point-max))) + (progn + (beginning-of-line) + (narrow-to-region (point-min) (point)))) + (goto-char (point-min)) + (while (not (eobp)) + ;; If we get an error, we set group to 0, which is not a + ;; symbol... + (setq group + (condition-case () + (let ((obarray gnus-description-hashtb)) + ;; Group is set to a symbol interned in this + ;; hash table. + (read nntp-server-buffer)) + (error 0))) + (skip-chars-forward " \t") + ;; ... which leads to this line being effectively ignored. + (and (symbolp group) + (set group (buffer-substring + (point) (progn (end-of-line) (point))))) + (forward-line 1)))) + (gnus-message 5 "Reading descriptions file...done") + t))))) (defun gnus-group-get-description (group) ;; Get the description of a group by sending XGTITLE to the server. diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 24eb53bb2..183f26629 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -340,6 +340,7 @@ ;; Beginning of the article. (save-excursion (save-restriction + (widen) (narrow-to-region (save-excursion (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index a26718ea1..4d969d1c1 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -39,10 +39,10 @@ nil "^$" nil nil) (list 'babyl "\^_\^L *\n" "\^_" nil "^$" nil nil) (list 'digest + "^------------------------------*[\n \t]+" "^------------------------------[\n \t]+" - "^------------------------------[\n \t]+" - nil "^$" - "^------------------------------*[\n \t]*\n[^ ]+: " + nil "^ ?$" + "^------------------------------*[\n \t]+" "End of")) "Regular expressions for articles of the various types.") @@ -97,7 +97,7 @@ 'headers (set-buffer nndoc-current-buffer) (goto-char (point-min)) - (re-search-forward nndoc-article-begin nil t) + (re-search-forward nndoc-first-article nil t) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t) @@ -274,13 +274,16 @@ (widen) (goto-char (point-min)) (let ((num 0)) - (while (and (re-search-forward nndoc-article-begin nil t) + (if (re-search-forward nndoc-first-article nil t) + (progn + (setq num 1) + (while (and (re-search-forward nndoc-article-begin nil t) (or (not nndoc-end-of-file) (not (looking-at nndoc-end-of-file))) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t)) - (setq num (1+ num))) + (setq num (1+ num))))) num))) (defun nndoc-narrow-to-article (article) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 5fa77cb5b..42b49a923 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -217,6 +217,7 @@ () (save-excursion (set-buffer nntp-server-buffer) + (goto-char (point-max)) (insert (format "%s %d %d y\n" @@ -253,17 +254,19 @@ (setq article (concat nnmh-current-directory (int-to-string (car articles)))) (if (setq mod-time (nth 5 (file-attributes article))) - (if (or force - (> (nnmail-days-between - (current-time-string) - (current-time-string mod-time)) - days)) - (progn - (message "Deleting %s..." article) - (condition-case () - (delete-file article) - (file-error nil))) - (setq rest (cons (car articles) rest)))) + (and (or force + (> (nnmail-days-between + (current-time-string) + (current-time-string mod-time)) + days)) + (progn + (message "Deleting %s..." article) + (condition-case () + (progn + (delete-file article) + t) + (file-error nil))) + (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) rest)) diff --git a/lisp/nnml.el b/lisp/nnml.el index 83051ca3d..4404edd23 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -286,7 +286,8 @@ all. This may very well take some time.") (and gnus-verbose-backends (message "Deleting %s..." article)) (condition-case () (delete-file article) - (file-error nil)) + (file-error + (setq rest (cons (car articles) rest)))) (setq active-articles (delq (car articles) active-articles)) (nnml-nov-delete-article newsgroup (car articles))) (setq rest (cons (car articles) rest)))) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index fdd356bcf..84f575188 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -1,8 +1,7 @@ -;;; nnsoup.el --- SOUP packet reading access for Gnus +;;; nnsoup.el --- SOUP access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail @@ -24,316 +23,536 @@ ;;; Commentary: -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;; For more information on SOUP, see the comments in the file -;; `gnus-soup.el'. - ;;; Code: -(require 'gnus-soup) (require 'nnheader) -(require 'rmail) (require 'nnmail) +(require 'gnus-soup) +(require 'gnus-msg) + +(defvar nnsoup-directory "~/SOUP/" + "*SOUP packet directory directory.") + +(defvar nnsoup-replies-directory (concat nnsoup-directory "replies/") + "*Directory where outgoing packets will be composed.") + +(defvar nnsoup-replies-format-type ?n + "*Format of the replies packages.") + +(defvar nnsoup-replies-index-type ?n + "*Index type of the replies packages.") -(defvar nnsoup-directory (expand-file-name "~/SOUP/") - "The name of the directory containing the unpacket SOUP packet.") +(defvar nnsoup-active-file (concat nnsoup-directory "active") + "Active file.") + +(defvar nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz" + "Format string command for packing a SOUP packet. +The SOUP files will be inserted where the %s is in the string. +This string MUST contain both %s and %d. The file number will be +inserted where %d appears.") + +(defvar nnsoup-unpacker "gunzip -c %s | tar xvf -" + "*Format string command for unpacking a SOUP packet. +The SOUP packet file name will be inserted at the %s.") + +(defvar nnsoup-packet-directory "~/" + "*Where nnsoup will look for incoming packets.") + +(defvar nnsoup-packet-regexp "Soupout" + "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") (defconst nnsoup-version "nnsoup 0.0" "nnsoup version.") -(defconst nnsoup-areas-file (concat nnsoup-directory "AREAS")) -(defconst nnsoup-list-file (concat nnsoup-directory "LIST")) -(defconst nnsoup-gnus-file (concat nnsoup-directory "gnus.touched")) - -(defvar nnsoup-current-group nil) -(defvar nnsoup-current-buffer nil) (defvar nnsoup-status-string "") (defvar nnsoup-group-alist nil) -(defvar nnsoup-buffer-alist nil) -(defconst nnsoup-areas-list nil) +(defvar nnsoup-replies-list nil) +(defvar nnsoup-buffers nil) +(defvar nnsoup-current-group nil) -;;; Interface functions + + +;; Server variables. + +(defvar nnsoup-current-server nil) +(defvar nnsoup-server-alist nil) +(defvar nnsoup-server-variables + (list + (list 'nnsoup-directory nnsoup-directory) + (list 'nnsoup-active-file nnsoup-active-file) + '(nnsoup-status-string "") + '(nnsoup-group-alist nil))) + + + +;;; Interface functions. -(defun nnsoup-retrieve-headers (sequence &optional newsgroup server) +(defun nnsoup-retrieve-headers (sequence &optional group server) + (nnsoup-possibly-change-group group) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (let ((file nil) - (number (length sequence)) - beg article art-string start stop) - (nnsoup-possibly-change-group newsgroup) - (while sequence - (setq article (car sequence)) - (setq art-string (nnsoup-article-string article)) - (set-buffer nnsoup-current-buffer) - (if (or (search-forward art-string nil t) - (progn (goto-char 1) - (search-forward art-string nil t))) - (progn - (setq start - (save-excursion - (re-search-backward - (concat "^" rmail-unix-mail-delimiter) nil t) - (point))) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (insert-buffer-substring nnsoup-current-buffer start stop) + (let ((count 0) + (areas (cdr (assoc nnsoup-current-group nnsoup-group-alist))) + (articles sequence) + (use-nov t) + beg article useful-areas this-area-seq) + (if (stringp (car sequence)) + 'headers + ;; We go through all the areas and find which files the + ;; articles in SEQUENCE come from. + (while (and areas sequence) + ;; Peel off areas that are below sequence. + (while (and areas (< (cdr (car (car areas))) (car sequence))) + (setq areas (cdr areas))) + (if (not areas) + () + ;; This is a useful area. + (setq useful-areas (cons (car areas) useful-areas) + this-area-seq nil) + ;; We take note whether this MSG has a corresponding IDX + ;; for later use. + (if (or (= (gnus-soup-encoding-index + (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) + (not (file-exists-p + (nnsoup-file + (gnus-soup-area-prefix (nth 1 (car areas))))))) + (setq use-nov nil)) + ;; We assing the portion of `sequence' that is relevant to + ;; this MSG packet to this packet. + (while (and sequence (<= (car sequence) (cdr (car (car areas))))) + (setq this-area-seq (cons (car sequence) this-area-seq) + sequence (cdr sequence))) + (setcar useful-areas (cons (nreverse this-area-seq) + (car useful-areas))))) + + ;; We now have a list of article numbers and corresponding + ;; areas. + (setq useful-areas (nreverse useful-areas)) + + ;; Two different approaches depending on whether all the MSG + ;; files have corresponding IDX files. If they all do, we + ;; simply return the relevant IDX files and let Gnus sort out + ;; what lines are relevant. If some of the IDX files are + ;; missing, we must return HEADs for all the articles. + (if use-nov + (while useful-areas (goto-char (point-max)) - (insert ".\n"))) - (setq sequence (cdr sequence))) - - ;; Fold continuation lines. - (goto-char 1) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) - 'headers))) - -(defun nnsoup-open-server (host &optional service) - (setq nnsoup-status-string "") - (setq nnsoup-group-alist nil) - (nnheader-init-server-buffer)) + (let ((b (point)) + (number (car (nth 1 (car useful-areas))))) + (insert-buffer-substring + (nnsoup-index-buffer + (gnus-soup-area-prefix + (nth 2 (car useful-areas))))) + (goto-char b) + ;; We have to remove the index number entires and + ;; insert article numbers instead. + (while (looking-at "[0-9]+") + (replace-match (int-to-string number) t t) + (setq number (1+ number)) + (forward-line 1))) + (setq useful-areas (cdr useful-areas))) + ;; We insert HEADs. + (while useful-areas + (setq articles (car (car useful-areas)) + useful-areas (cdr useful-areas)) + (while articles + (goto-char (point-max)) + (insert (format "221 %d Article retrieved.\n" (car articles))) + (insert-buffer-substring + (nnsoup-narrow-to-article + (car articles) (cdr (car useful-areas)) 'head)) + (goto-char (point-max)) + (insert ".\n") + (setq articles (cdr articles)))) + + ;; Fold continuation lines. + (goto-char (point-min)) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t))) + (if use-nov 'nov 'headers))))) + +(defun nnsoup-open-server (server &optional defs) + (nnsoup-set-variables) + (nnheader-init-server-buffer) + (if (equal server nnsoup-current-server) + t + (if nnsoup-current-server + (setq nnsoup-server-alist + (cons (list nnsoup-current-server + (nnheader-save-variables nnsoup-server-variables)) + nnsoup-server-alist))) + (let ((state (assoc server nnsoup-server-alist))) + (if state + (progn + (nnheader-restore-variables (nth 1 state)) + (setq nnsoup-server-alist (delq state nnsoup-server-alist))) + (nnheader-set-init-variables nnsoup-server-variables defs))) + (setq nnsoup-current-server server))) + +(defun nnsoup-request-close () + (nnsoup-write-replies) + (while nnsoup-buffers + (and (car nnsoup-buffers) + (buffer-name (car nnsoup-buffers)) + (kill-buffer (car nnsoup-buffers))) + (setq nnsoup-buffers (cdr nnsoup-buffers))) + (setq nnsoup-group-alist nil + nnsoup-current-group nil + nnsoup-current-server nil + nnsoup-server-alist nil) + t) (defun nnsoup-close-server (&optional server) t) (defun nnsoup-server-opened (&optional server) - (and nntp-server-buffer + (and (equal server nnsoup-current-server) + nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnsoup-status-message (&optional server) nnsoup-status-string) -(defun nnsoup-request-article (article &optional newsgroup server buffer) +(defun nnsoup-request-article (id &optional newsgroup server buffer) (nnsoup-possibly-change-group newsgroup) - (if (stringp article) - nil + (let ((buffer (or buffer nntp-server-buffer))) (save-excursion - (set-buffer nnsoup-current-buffer) - (goto-char 1) - (if (search-forward (nnsoup-article-string article) nil t) - (let (start stop) - (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (or (and (re-search-forward - (concat "^" rmail-unix-mail-delimiter) nil t) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnsoup-current-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - t)))))) + (set-buffer buffer) + (erase-buffer) + (if (stringp id) + () + (insert-buffer-substring + (nnsoup-narrow-to-article id)) + t)))) (defun nnsoup-request-group (group &optional server dont-check) - (save-excursion - (nnsoup-possibly-change-group group) - (and (assoc group nnsoup-group-alist) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if dont-check - t - (nnsoup-request-list) - (setq nnsoup-group-alist (nnmail-get-active)) - (let ((active (assoc group nnsoup-group-alist))) - (insert (format "211 %d %d %d %s\n" - (1+ (- (cdr (car (cdr active))) - (car (car (cdr active))))) - (car (car (cdr active))) - (cdr (car (cdr active))) - (car active)))) - t))))) + (nnsoup-possibly-change-group group) + (if dont-check + () + (let ((area (cdr (assoc group nnsoup-group-alist))) + min max) + (setq min (car (car (car area)))) + (while (cdr area) + (setq area (cdr area))) + (setq max (cdr (car (car area)))) + (insert (format "211 %d %d %d %s\n" + (max (1+ (- max min)) 0) min max group)))) + t) (defun nnsoup-close-group (group &optional server) t) (defun nnsoup-request-list (&optional server) - (if server - (if (or (file-exists-p nnsoup-gnus-file) - (not (file-directory-p nnsoup-directory))) - () - (write-region 1 1 nnsoup-gnus-file) - (setq nnsoup-areas-list nil - nnsoup-current-group nil - nnsoup-current-buffer nil - nnsoup-group-alist nil) - (let ((buffer (get-file-buffer nnsoup-areas-file)) - (groups gnus-newsrc-assoc) - group) - (while groups - (setq group (car groups) - groups (cdr groups)) - (if (eq (car (gnus-group-method-name (car group))) 'nnsoup) - (progn - (setcar (nthcdr 2 group) nil) - (setcar (nthcdr 3 group) nil)))) - (gnus-make-hashtable-from-newsrc-alist) - (if buffer - (kill-buffer buffer)) - (while nnsoup-buffer-alist - (setq buffer (nth 1 (car nnsoup-buffer-alist)) - nnsoup-buffer-alist (cdr nnsoup-buffer-alist)) - (if (buffer-name buffer) - (kill-buffer buffer)))))) - (nnsoup-find-active)) + (or nnsoup-group-alist (nnsoup-read-areas)) + (nnsoup-unpack-packets) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let ((alist nnsoup-group-alist) + min) + (while alist + (setq min (car (car (nth 1 (car alist))))) + (insert (format "%s %d %d y\n" (car (car alist)) + (let ((areas (car alist))) + (while (cdr areas) + (setq areas (cdr areas))) + (cdr (car (car areas)))) min)) + (setq alist (cdr alist))) + t))) (defun nnsoup-request-newgroups (date &optional server) - (nnsoup-request-list server)) + (nnsoup-request-list)) (defun nnsoup-request-list-newsgroups (&optional server) - (nnmail-find-file nnsoup-newsgroups-file)) + nil) (defun nnsoup-request-post (&optional server) - (mail-send-and-exit nil)) - -(fset 'nnsoup-request-post-buffer 'nnmail-request-post-buffer) - -(defun nnsoup-request-expire-articles (articles newsgroup &optional server force) - (setq nnsoup-status-string "nnsoup: expire not possible") - nil) + (nnsoup-store-reply "news") + t) -(defun nnsoup-request-move-article (article group server accept-form) - (setq nnsoup-status-string "nnsoup: move not possible") - nil) +(defun nnsoup-request-mail () + (nnsoup-store-reply "mail") + t) -(defun nnsoup-request-accept-article (group) - (setq nnsoup-status-string "nnsoup: accept not possible") - nil) +(defun nnsoup-request-post-buffer (post group &rest args) + (nnsoup-possibly-change-group group) + (apply + ;; Find out whether the source for this group is a mail or a news + ;; group and call the right function for getting a buffer. + (let ((enc (nth 1 (car (cdr (assoc nnsoup-current-group + nnsoup-group-alist)))))) + (if (and enc + (= (gnus-soup-encoding-kind (gnus-soup-area-encoding enc)) ?m)) + 'nnmail-request-post-buffer + 'nntp-request-post-buffer)) + post group args)) -;;; Internal functions. - -(defun nnsoup-possibly-change-group (group) - (or (file-exists-p nnsoup-directory) - (make-directory (directory-file-name nnsoup-directory))) - (if (not nnsoup-group-alist) - (progn - (nnsoup-request-list) - (setq nnsoup-group-alist (nnmail-get-active)))) - (let (inf file) - (if (and (equal group nnsoup-current-group) - (buffer-name nnsoup-current-buffer)) - () - (if (setq inf (member group nnsoup-buffer-alist)) - (setq nnsoup-current-buffer (nth 1 inf))) +;;; Internal functions + +(defun nnsoup-possibly-change-group (group &optional force) + (if group (setq nnsoup-current-group group) - (if (not (buffer-name nnsoup-current-buffer)) - (progn - (setq nnsoup-buffer-alist (delq inf nnsoup-buffer-alist)) - (setq inf nil))) - (if inf - () - (save-excursion - (setq file (nnsoup-group-file group)) -;;;; (if (not (file-exists-p file)) -;;;; (write-region 1 1 file t 'nomesg)) - (set-buffer (nnsoup-read-folder file)) - (setq nnsoup-buffer-alist (cons (list group (current-buffer)) - nnsoup-buffer-alist)))))) - (setq nnsoup-current-group group)) - -(defun nnsoup-article-string (article) - (concat "\nX-Gnus-Article-Number: " (int-to-string article) " ")) - -(defun nnsoup-read-folder (file) - (nnsoup-request-list) - (setq nnsoup-group-alist (nnmail-get-active)) + t)) + +(defun nnsoup-read-active-file () + (if (file-exists-p nnsoup-active-file) + (condition-case () + (load nnsoup-active-file) + (error nil)))) + +(defun nnsoup-write-active-file () (save-excursion - (set-buffer - (setq nnsoup-current-buffer - (find-file-noselect file))) + (set-buffer (get-buffer-create " *nnsoup work*")) (buffer-disable-undo (current-buffer)) - (let ((delim (concat "^" rmail-unix-mail-delimiter)) - start end - (number 1)) - (goto-char (point-min)) - (while (re-search-forward delim nil t) - (setq start (match-beginning 0)) - (save-excursion - (setq end (or (and (re-search-forward delim nil t) - (match-beginning 0)) - (point-max)))) - (save-excursion - (save-restriction - (narrow-to-region start end) - (nnmail-insert-lines) - (save-excursion - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (insert (format "X-Gnus-Article-Number: %d %s\n" - number (current-time-string)))))) - (setq number (1+ number)))) - (goto-char end))) - (set-buffer-modified-p nil) - (current-buffer))) - -(defun nnsoup-find-active () - (set-buffer nntp-server-buffer) - (erase-buffer) - (or nnsoup-areas-list (nnsoup-read-areas)) - (condition-case () - (progn - (let ((areas nnsoup-areas-list) - area) - (while areas - (setq area (car areas) - areas (cdr areas)) - (insert (format "%s %s 1 y\n" (aref area 1) (aref area 4))))) - t) - (file-error nil))) + (erase-buffer) + (insert (format "(setq nnsoup-group-alist '%S)\n" nnsoup-group-alist)) + (write-region (point-min) (point-max) nnsoup-active-file + nil 'silent) + (kill-buffer (current-buffer)))) (defun nnsoup-read-areas () - (setq nnsoup-areas-list (gnus-soup-parse-areas nnsoup-areas-file)) - (let ((areas nnsoup-areas-list) - area) - (while areas - (setq area (car areas) - areas (cdr areas)) - (aset area 4 (nnsoup-count-area area))))) - -(defun nnsoup-count-area (area) - (or (aref area 4) - (number-to-string - (nnsoup-count-mbox (concat nnsoup-directory (aref area 0) ".MSG"))))) - -(defun nnsoup-count-mbox (file) - (let ((delete (find-buffer-visiting file)) - (num 0) - (delim (concat "^" rmail-unix-mail-delimiter))) + (save-excursion + (set-buffer nntp-server-buffer) + (let ((areas (gnus-soup-parse-areas (concat nnsoup-directory "AREAS"))) + entry number area lnum) + ;; Go through all areas in the new AREAS file. + (while areas + (setq area (car areas) + areas (cdr areas)) + ;; Find the number of new articles in this area. + (setq number (nnsoup-number-of-articles area)) + (if (not (setq entry (assoc (gnus-soup-area-name area) + nnsoup-group-alist))) + ;; If this is a new area (group), we just add this info to + ;; the group alist. + (setq nnsoup-group-alist + (cons (list (gnus-soup-area-name area) + (list (cons 1 number) area)) + nnsoup-group-alist)) + ;; There are already articles in this group, so we add this + ;; info to the end of the entry. + (let ((e (cdr entry))) + (while (cdr e) + (setq e (cdr e))) + (setcdr e (list (list (cons (setq lnum (1+ (cdr (nth 1 (car e))))) + (+ lnum number)) + area))))))))) + +(defun nnsoup-number-of-articles (area) + (save-excursion + (cond + ;; If the number is in the area info, we just return it. + ((gnus-soup-area-number area) + (gnus-soup-area-number area)) + ;; If there is an index file, we just count the lines. + ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n) + (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area))) + (count-lines (point-min) (point-max))) + ;; We do it the hard way - re-searching through the message + ;; buffer. + (t + (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) + (goto-char (point-min)) + (let ((regexp (nnsoup-header (gnus-soup-encoding-format + (gnus-soup-area-encoding area)))) + (num 0)) + (while (re-search-forward regexp nil t) + (setq num (1+ num))) + num))))) + +(defun nnsoup-index-buffer (prefix &optional message) + (let* ((file (concat prefix (if message ".MSG" ".IDX"))) + (buffer-name (concat " *nnsoup " file "*"))) + (or (get-buffer buffer-name) ; File aready loaded. + (save-excursion ; Load the file. + (set-buffer (get-buffer-create buffer-name)) + (setq nnsoup-buffers (cons (current-buffer) nnsoup-buffers)) + (insert-file-contents (concat nnsoup-directory file)) + (current-buffer))))) + +(defun nnsoup-file (prefix &optional message) + (concat nnsoup-directory prefix (if message ".MSG" ".IDX"))) + +(defun nnsoup-message-buffer (prefix) + (nnsoup-index-buffer prefix 'msg)) + +(defun nnsoup-unpack-packets () + (let ((packets (directory-files + nnsoup-packet-directory t nnsoup-packet-regexp)) + msg) + (while packets + (message (setq msg (format "nnsoup: unpacking %s..." (car packets)))) + (gnus-soup-unpack-packet nnsoup-directory nnsoup-unpacker (car packets)) + (delete-file (car packets)) + (nnsoup-read-areas) + (message "%sdone" msg) + (setq packets (cdr packets))))) + +(defun nnsoup-narrow-to-article (article &optional area head) + (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) + (prefix (gnus-soup-area-prefix (nth 1 area))) + beg end msg-buf) + (setq msg-buf (nnsoup-index-buffer prefix 'msg)) (save-excursion - (set-buffer (find-file-noselect file)) + (cond + ;; We use the index file to find out where the article begins and ends. + ((and (= (gnus-soup-encoding-index + (gnus-soup-area-encoding (nth 1 area))) + ?c) + (file-exists-p (nnsoup-file prefix))) + (set-buffer (nnsoup-index-buffer prefix)) + (goto-char (point-min)) + (forward-line (- article (car (car area)))) + (setq beg (read (current-buffer))) + (forward-line 1) + (if (looking-at "[0-9]+") + (progn + (setq end (read (current-buffer))) + (set-buffer msg-buf) + (widen) + (let ((format (gnus-soup-encoding-format + (gnus-soup-area-encoding (nth 1 area))))) + (goto-char end) + (if (or (= format ?n) (= format ?m)) + (setq end (progn (forward-line -2) (point)))))) + (set-buffer msg-buf)) + (widen) + (narrow-to-region beg (or end (point-max)))) + (t + (set-buffer msg-buf) + (widen) + (goto-char (point-min)) + (let ((header (nnsoup-header + (gnus-soup-encoding-format + (gnus-soup-area-encoding (nth 1 area)))))) + (re-search-forward header nil t (- article (car (car area)))) + (narrow-to-region + (match-beginning 0) + (if (re-search-forward header nil t) + (match-beginning 0) + (point-max)))))) (goto-char (point-min)) - (while (re-search-forward delim nil t) - (setq num (1+ num))) - (if delete (kill-buffer delete)) - num))) - -(defun nnsoup-group-file (group) - (let ((areas nnsoup-areas-list) - area result) - (while areas - (setq area (car areas) - areas (cdr areas)) - (if (equal (aref area 1) group) - (setq result (concat nnsoup-directory (aref area 0) ".MSG")))) - result)) - + (if (not head) + () + (narrow-to-region + (point-min) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max)))) + msg-buf))) + +(defun nnsoup-header (format) + (cond + ((= format ?n) + "^#! *rnews +[0-9]+ *$") + ((= format ?m) + (concat "^" rmail-unix-mail-delimiter)) + ((= format ?M) + "^\^A\^A\^A\^A\n") + (t + (error "Unknown format: %c" format)))) + +(defun nnsoup-pack-replies () + "Make an outbound package of SOUP replies." + (interactive) + (nnsoup-write-replies) + (gnus-soup-pack nnsoup-replies-directory nnsoup-packer)) + +(defun nnsoup-write-replies () + (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)) + +(defun nnsoup-article-to-area (article group) + (let ((areas (cdr (assoc group nnsoup-group-alist)))) + (while (and areas (< (cdr (car (car areas))) article)) + (setq areas (cdr areas))) + (and areas (car areas)))) + +(defun nnsoup-set-variables () + (setq gnus-inews-article-function 'nnsoup-request-post) + (setq gnus-mail-send-method 'nnsoup-request-mail) + (setq send-mail-function 'nnsoup-request-mail)) + +(defun nnsoup-store-reply (kind) + ;; Mostly stolen from `sendmail.el'. + (let ((tembuf (generate-new-buffer " sendmail temp")) + (case-fold-search nil) + (mailbuf (current-buffer)) + delimline + prefix) + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer-substring mailbuf) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + (if mail-aliases + (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (let ((case-fold-search t)) + (goto-char (point-min)) + ;; Find and handle any FCC fields. + (goto-char (point-min)) + (if (re-search-forward "^FCC:" delimline t) + (mail-do-fcc delimline)) + (goto-char (point-min)) + ;; "S:" is an abbreviation for "Subject:". + (goto-char (point-min)) + (if (re-search-forward "^S:" delimline t) + (replace-match "Subject:")) + ;; Don't send out a blank subject line + (goto-char (point-min)) + (if (re-search-forward "^Subject:[ \t]*\n" delimline t) + (replace-match "")) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (if (eval mail-mailer-swallows-blank-line) + (newline))) + (gnus-soup-store + nnsoup-replies-directory + (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type + nnsoup-replies-index-type) + (kill-buffer tembuf)))) + +(defun nnsoup-kind-to-prefix (kind) + (or nnsoup-replies-list + (setq nnsoup-replies-list + (gnus-soup-parse-replies + (concat nnsoup-replies-directory "REPLIES")))) + (let ((replies nnsoup-replies-list)) + (while (and replies + (not (string= kind (gnus-soup-reply-kind (car replies))))) + (setq replies (cdr replies))) + (if replies + (gnus-soup-reply-prefix (car replies)) + (setq nnsoup-replies-list + (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory) + kind + (format "%c%c%c" + nnsoup-replies-format-type + nnsoup-replies-index-type + (if (string= kind "news") + ?n ?m))) + nnsoup-replies-list)) + (gnus-soup-reply-prefix (car nnsoup-replies-list))))) + (provide 'nnsoup) ;;; nnsoup.el ends here diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index fc06d07b0..f26770abe 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -73,7 +73,8 @@ (setq active (nth 2 (car map))) (setq articles nil) (while (and sequence (<= (car sequence) top)) - (setq articles (cons (- (+ active (car sequence)) offset) articles)) + (setq articles (cons (- (+ active (car sequence)) offset) + articles)) (setq sequence (cdr sequence))) (setq articles (nreverse articles)) (if (and articles @@ -93,7 +94,8 @@ (delete-region beg (point)) (insert (int-to-string (+ (- article active) offset))) (beginning-of-line) - (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") + (looking-at + "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") (goto-char (match-end 0)) (or (search-forward "\t" (save-excursion (end-of-line) (point)) t) @@ -140,6 +142,13 @@ "Close news server." t) +(defun nnvirtual-request-close () + (setq nnvirtual-current-group nil + nnvirtual-current-groups nil + nnvirtual-current-mapping nil + nnvirtual-group-alist nil) + t) + (defun nnvirtual-server-opened (&optional server) "Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL." @@ -418,6 +427,13 @@ If the stream is opened, return T, otherwise return NIL." (cons (- (+ (car article) (nth 2 (car map))) offset) (cdr article)))))) +(defun nnvirtual-catchup-group (group &optional server all) + (nnvirtual-possibly-change-newsgroups group server) + (let ((gnus-group-marked nnvirtual-current-groups) + (gnus-expert-user t)) + (set-buffer gnus-group-buffer) + (gnus-group-catchup-current nil all))) + (provide 'nnvirtual) ;;; nnvirtual.el ends here diff --git a/texi/gnus.texi b/texi/gnus.texi index d22d29b1b..432199edc 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @comment %**start of header (This is for running Texinfo on a region.) @setfilename gnus -@settitle Gnus 0.70 Manual +@settitle (ding) Gnus 0.80 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -43,7 +43,7 @@ into another language, under the above conditions for modified versions. @end ifinfo @titlepage -@title Gnus Manual +@title (ding) Gnus Manual @author by Lars Magne Ingebrigtsen @page @@ -3316,6 +3316,18 @@ like this: This function will be called narrowed to header of the article that is being followed up. +@item gnus-deletable-headers +@vindex gnus-deletable-headers +Headers in this list that were previously generated by Gnus will be +deleted before posting. Let's say you post an article. Then you decide +to post it again to some other group, you naughty boy, so you jump back +to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and +ship it off again. By default, this variable makes sure that the old +generated @code{Message-ID} is deleted, and a new one generated. If +this isn't done, the entire empire would probably crumble, anarchy would +prevail, and cats would start walking on two legs and rule the world. +Allegedly. + @item gnus-signature-function @vindex gnus-signature-function If non-@code{nil}, this variable should be a function that returns a @@ -3368,6 +3380,11 @@ would suggest this hook instead: This hook is called before the headers have been prepared. By default it inserts the signature specified by @code{gnus-signature-file}. +@item gnus-inews-article-function +@vindex gnus-inews-article-function +This function is used to do the actual article processing and header +checking/generation. + @item gnus-inews-article-hook @vindex gnus-inews-article-hook This hook is called right before the article is posted. By default it @@ -5418,12 +5435,12 @@ The adaptive score entries will be put into a file where the name is the group name with @code{gnus-adaptive-file-suffix} appended. @vindex gnus-score-exact-adapt-limit -When doing adaptive scoring, one normally uses substring matching. -However, if the header one matches is short, the possibility for false -positives is great, so if the length of the match is less than -@code{gnus-score-exact-adapt-limit}, exact matching will be used. -If this variable is @code{nil}, which it is by default, exact matching -will always be used. +When doing adaptive scoring, substring matching would probably give you +the best results in most cases. However, if the header one matches is +short, the possibility for false positives is great, so if the length of +the match is less than @code{gnus-score-exact-adapt-limit}, exact +matching will be used. If this variable is @code{nil}, which it is by +default, exact matching will always be used to avoid this problem. @node Scoring Tips @subsection Scoring Tips @@ -5578,13 +5595,18 @@ Normal kill files look like this: This will mark every article written by me as read, and remove them from the summary buffer. Very useful, you'll agree. -Two functions for entering kill file editing: +Other programs use a totally different kill file syntax. If Gnus +encounters what looks like a @code{rn} kill file, it will take a stab at +interpreting it. + +Two functions for editing a GNUS kill file: @table @kbd @item V k @kindex V k (Summary) @findex gnus-summary-edit-local-kill Edit this group's kill file (@code{gnus-summary-edit-local-kill}). + @item V K @kindex V K (Summary) @findex gnus-summary-edit-global-kill @@ -5625,12 +5647,14 @@ disk forever and ever, never to return again." Use with caution. @item B m @kindex B m (Summary) +@cindex move mail @findex gnus-summary-move-article Move the article from one mail group to another (@code{gnus-summary-move-article}). @item B c @kindex B c (Summary) +@kindex copy mail @findex gnus-summary-copy-article Copy the article from one group (mail group or not) to a mail group (@code{gnus-summary-copy-article}). -- 2.34.1