;;; gnus-soup.el --- SOUP packet writing support for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-art)
(require 'message)
;;; User Variables:
-(defvar gnus-soup-directory "~/SoupBrew/"
+(defvar gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
"*Directory containing an unpacked SOUP packet.")
-(defvar gnus-soup-replies-directory (concat gnus-soup-directory "SoupReplies/")
+(defvar gnus-soup-replies-directory
+ (nnheader-concat gnus-soup-directory "SoupReplies/")
"*Directory where Gnus will do processing of replies.")
(defvar gnus-soup-prefix-file "gnus-prefix"
"*Format string command for unpacking a SOUP packet.
The SOUP packet file name will be inserted at the %s.")
-(defvar gnus-soup-packet-directory "~/"
+(defvar gnus-soup-packet-directory gnus-home-directory
"*Where gnus-soup will look for REPLIES packets.")
(defvar gnus-soup-packet-regexp "Soupin"
If N is nil and any articles have been marked with the process mark,
move those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let* ((articles (gnus-summary-work-articles n))
(tmp-buf (get-buffer-create "*soup work*"))
(area (gnus-soup-area gnus-newsgroup-name))
(when (setq headers (gnus-summary-article-header (car articles)))
;; Put the article in a buffer.
(set-buffer tmp-buf)
- (when (gnus-request-article-this-buffer
+ (when (gnus-request-article-this-buffer
(car articles) gnus-newsgroup-name)
(save-restriction
(message-narrow-to-head)
(message-remove-header gnus-soup-ignored-headers t))
(gnus-soup-store gnus-soup-directory prefix headers
- gnus-soup-encoding-type
+ gnus-soup-encoding-type
gnus-soup-index-type)
- (gnus-soup-area-set-number
+ (gnus-soup-area-set-number
area (1+ (or (gnus-soup-area-number area) 0)))))
- ;; Mark article as read.
+ ;; Mark article as read.
(set-buffer gnus-summary-buffer)
(gnus-summary-remove-process-mark (car articles))
(gnus-summary-mark-as-read (car articles) gnus-souped-mark)
(setq articles (cdr articles)))
(kill-buffer tmp-buf))
- (gnus-soup-save-areas)))
+ (gnus-soup-save-areas)
+ (gnus-set-mode-line 'summary)))
(defun gnus-soup-pack-packet ()
"Make a SOUP packet from the SOUP areas."
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.*\""
+$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
+
+Note -- this function hasn't been implemented yet."
(interactive)
nil)
-
+
;;; Internal Functions:
-;; Store the current buffer.
+;; Store the current buffer.
(defun gnus-soup-store (directory prefix headers format index)
- ;; Create the directory, if needed.
+ ;; Create the directory, if needed.
(gnus-make-directory directory)
(let* ((msg-buf (nnheader-find-file-noselect
(concat directory prefix ".MSG")))
from head-line beg type)
(setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
(buffer-disable-undo msg-buf)
- (when idx-buf
+ (when idx-buf
(push idx-buf gnus-soup-buffers)
(buffer-disable-undo idx-buf))
(save-excursion
(mail-fetch-field "sender"))))
(goto-char (point-min))
;; Depending on what encoding is supposed to be used, we make
- ;; a soup header.
+ ;; a soup header.
(setq head-line
- (cond
+ (cond
((= gnus-soup-encoding-type ?n)
(format "#! rnews %d\n" (buffer-size)))
((= gnus-soup-encoding-type ?m)
(and (car entry)
(> (car entry) 0))
(and (not not-all)
- (gnus-range-length (cdr (assq 'tick (gnus-info-marks
+ (gnus-range-length (cdr (assq 'tick (gnus-info-marks
(nth 2 entry)))))))
(when (gnus-summary-read-group group nil t)
(setq gnus-newsgroup-processable
(or (mail-header-from header) "(nobody)")
(or (mail-header-date header) "")
(or (mail-header-id header)
- (concat "soup-dummy-id-"
- (mapconcat
+ (concat "soup-dummy-id-"
+ (mapconcat
(lambda (time) (int-to-string time))
(current-time) "-")))
(or (mail-header-references header) "")
(or (mail-header-lines header) "0"))))
(defun gnus-soup-save-areas ()
+ "Write all SOUP buffers."
+ (interactive)
(gnus-soup-write-areas)
(save-excursion
(let (buf)
(string-match "%d" packer))
(format packer files
(string-to-int (gnus-soup-unique-prefix dir)))
- (format packer
+ (format packer
(string-to-int (gnus-soup-unique-prefix dir))
files)))
(dir (expand-file-name dir)))
(setq gnus-soup-areas nil)
(gnus-message 4 "Packing %s..." packer)
(if (zerop (call-process shell-file-name
- nil nil nil shell-command-switch
+ nil nil nil shell-command-switch
(concat "cd " dir " ; " packer)))
(progn
- (call-process shell-file-name nil nil nil shell-command-switch
+ (call-process shell-file-name nil nil nil shell-command-switch
(concat "cd " dir " ; rm " files))
(gnus-message 4 "Packing...done" packer))
- (error "Couldn't pack packet."))))
+ (error "Couldn't pack packet"))))
(defun gnus-soup-parse-areas (file)
"Parse soup area file FILE.
The result is a of vectors, each containing one entry from the AREA file.
-The vector contain five strings,
+The vector contain five strings,
[prefix name encoding description number]
though the two last may be nil if they are missing."
(let (areas)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect file 'force))
- (buffer-disable-undo (current-buffer))
- (goto-char (point-min))
- (while (not (eobp))
- (push (vector (gnus-soup-field)
- (gnus-soup-field)
- (gnus-soup-field)
- (and (eq (preceding-char) ?\t)
- (gnus-soup-field))
- (and (eq (preceding-char) ?\t)
- (string-to-int (gnus-soup-field))))
- areas)
- (when (eq (preceding-char) ?\t)
- (beginning-of-line 2)))
- (kill-buffer (current-buffer)))
+ (when (file-exists-p file)
+ (save-excursion
+ (set-buffer (nnheader-find-file-noselect file 'force))
+ (buffer-disable-undo (current-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (vector (gnus-soup-field)
+ (gnus-soup-field)
+ (gnus-soup-field)
+ (and (eq (preceding-char) ?\t)
+ (gnus-soup-field))
+ (and (eq (preceding-char) ?\t)
+ (string-to-int (gnus-soup-field))))
+ areas)
+ (when (eq (preceding-char) ?\t)
+ (beginning-of-line 2)))
+ (kill-buffer (current-buffer))))
areas))
(defun gnus-soup-parse-replies (file)
area)
(while (setq area (pop areas))
(insert
- (format
+ (format
"%s\t%s\t%s%s\n"
(gnus-soup-area-prefix area)
(gnus-soup-area-name area)
(concat "\t" (or (gnus-soup-area-description
area) "")
(if (gnus-soup-area-number area)
- (concat "\t" (int-to-string
+ (concat "\t" (int-to-string
(gnus-soup-area-number area)))
"")) ""))))))))
(unless result
(setq result
(vector (gnus-soup-unique-prefix)
- real-group
+ real-group
(format "%c%c%c"
gnus-soup-encoding-type
gnus-soup-index-type
(gnus-message 4 "Unpacking...done")))
(defun gnus-soup-send-packet (packet)
- (gnus-soup-unpack-packet
+ (gnus-soup-unpack-packet
gnus-soup-replies-directory gnus-soup-unpacker packet)
- (let ((replies (gnus-soup-parse-replies
+ (let ((replies (gnus-soup-parse-replies
(concat gnus-soup-replies-directory "REPLIES"))))
(save-excursion
(while replies
(nnheader-find-file-noselect msg-file)))
(tmp-buf (get-buffer-create " *soup send*"))
beg end)
- (cond
- ((/= (gnus-soup-encoding-format
+ (cond
+ ((/= (gnus-soup-encoding-format
(gnus-soup-reply-encoding (car replies)))
?n)
(error "Unsupported encoding"))
t)
(t
(buffer-disable-undo msg-buf)
- (buffer-disable-undo tmp-buf)
(set-buffer msg-buf)
(goto-char (point-min))
(while (not (eobp))
(unless (looking-at "#! *rnews +\\([0-9]+\\)")
- (error "Bad header."))
+ (error "Bad header"))
(forward-line 1)
(setq beg (point)
- end (+ (point) (string-to-int
- (buffer-substring
+ end (+ (point) (string-to-int
+ (buffer-substring
(match-beginning 1) (match-end 1)))))
(switch-to-buffer tmp-buf)
(erase-buffer)
(insert mail-header-separator)
(setq message-newsreader (setq message-mailer
(gnus-extended-version)))
- (cond
+ (cond
((string= (gnus-soup-reply-kind (car replies)) "news")
(gnus-message 5 "Sending news message to %s..."
(mail-fetch-field "newsgroups"))
(gnus-message 4 "Sent packet"))))
(setq replies (cdr replies)))
t)))
-
+
(provide 'gnus-soup)
;;; gnus-soup.el ends here