+Fri Jun 2 14:56:40 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * 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 <abraham@iesd.auc.dk>
+
+ * gnus-vis.el (gnus-summary-make-menu-bar): Added menu entry to
+ highlight article.
+
+Fri Jun 2 00:29:57 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * 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 <lars@eyesore.no>
+
+ * 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 <larsi@menja.ifi.uio.no>
+
+ * gnus.el (gnus-summary-expire-articles): Cancelled instead of
+ canceled.
+
+Wed May 31 03:45:35 1995 Lars Magne Ingebrigtsen <larsi@bera.ifi.uio.no>
+
+ * 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 <abraham@iesd.auc.dk>
* gnus-cite.el (gnus-cite-attribution-postfix): Accept VinVN
(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
(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)))
;;
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: news, help
-;; Version: 0.0
+;; Version: 0.1
;;; Commentary:
;;
;;; Code:
(require 'custom)
+(require 'gnus-score)
(autoload 'gnus-score-load "gnus-score")
(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
(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)
(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))
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
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
(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)))))
(setq gnus-article-reply sumart)
;; Handle `gnus-auto-mail-to-author'.
;; Suggested by Daniel Quinlan <quinlan@best.com>.
- (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")
(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...")
(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))
"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"
(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))
(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))))
;; 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))
(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)
;;; 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.")
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
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.
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."
(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))
(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)
(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)
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))
(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)))
(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
-
-
-
["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]
["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]
))
)
["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
["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]
(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
(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")
(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")
(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)
(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))
(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)
(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)
(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)
;; go, and insert it there (or at the end of the buffer).
;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
(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
(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))))
(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)
(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))
(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)
(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)))
(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)))
;; 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))
(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")))))
(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)
"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))
(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)
(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))))
(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)
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)
(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
;; 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 <vinson@unagi.cis.upenn.edu>.
(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
(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)
(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: "
" " (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)))))))))
;; 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'.
(< 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)))
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)))
;; 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.
(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'.
(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))
(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.
;; Beginning of the article.
(save-excursion
(save-restriction
+ (widen)
(narrow-to-region
(save-excursion
(re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
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.")
'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)
(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)
()
(save-excursion
(set-buffer nntp-server-buffer)
+ (goto-char (point-max))
(insert
(format
"%s %d %d y\n"
(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))
(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))))
-;;; nnsoup.el --- SOUP packet reading access for Gnus
+;;; nnsoup.el --- SOUP access for Gnus
;; Copyright (C) 1995 Free Software Foundation, Inc.
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;;; 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'.")
\f
(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
+\f
+
+;; 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)))
+
+\f
+
+;;; 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))
\f
-;;; 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
(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
(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)
"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."
(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
\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
@end ifinfo
@titlepage
-@title Gnus Manual
+@title (ding) Gnus Manual
@author by Lars Magne Ingebrigtsen
@page
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
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
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
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
@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}).
projects / gnus / commitdiff