;;; gnus-soup.el --- SOUP packet writing support for Gnus
-;; Copyright (C) 1995,96 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:
-(require 'gnus-load)
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
(require 'gnus-art)
(require 'message)
(require 'gnus-start)
-(require 'gnus)
(require 'gnus-range)
;;; 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."
(interactive)
(gnus-soup-read-areas)
+ (unless (file-exists-p gnus-soup-directory)
+ (message "No such directory: %s" gnus-soup-directory))
+ (when (null (directory-files gnus-soup-directory nil "\\.MSG$"))
+ (message "No files to pack."))
(gnus-soup-pack gnus-soup-directory gnus-soup-packer))
(defun gnus-group-brew-soup (n)
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 (find-file-noselect
+ (let* ((msg-buf (nnheader-find-file-noselect
(concat directory prefix ".MSG")))
(idx-buf (if (= index ?n)
nil
- (find-file-noselect
+ (nnheader-find-file-noselect
(concat directory prefix ".IDX"))))
(article-buf (current-buffer))
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 (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)
file. The vector contain three strings, [prefix name encoding]."
(let (replies)
(save-excursion
- (set-buffer (find-file-noselect file))
+ (set-buffer (nnheader-find-file-noselect file))
(buffer-disable-undo (current-buffer))
(goto-char (point-min))
(while (not (eobp))
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
(if entry
()
(when (file-exists-p (concat dir gnus-soup-prefix-file))
- (condition-case nil
- (load (concat dir gnus-soup-prefix-file) nil t t)
- (error nil)))
+ (ignore-errors
+ (load (concat dir gnus-soup-prefix-file) nil t t)))
(push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
gnus-soup-last-prefix))
(setcdr entry (1+ (cdr entry)))
(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
(gnus-soup-reply-prefix (car replies))
".MSG"))
(msg-buf (and (file-exists-p msg-file)
- (find-file-noselect msg-file)))
+ (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
projects / gnus / blobdiff