;;; gnus-soup.el --- SOUP packet writing support for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
+;; 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-msg)
-(require 'gnus)
(eval-when-compile (require 'cl))
+(require 'gnus)
+(require 'gnus-art)
+(require 'message)
+(require 'gnus-start)
+(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"
(defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%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
+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 "~/"
+(defvar gnus-soup-packet-directory gnus-home-directory
"*Where gnus-soup will look for REPLIES packets.")
(defvar gnus-soup-packet-regexp "Soupin"
;;; Internal Variables:
-(defvar gnus-soup-encoding-type ?n
+(defvar gnus-soup-encoding-type ?u
"*Soup encoding type.
-`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox
+`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox
format.")
(defvar gnus-soup-index-type ?c
"*Soup index type.
`n' means no index file and `c' means standard Cnews overview
-format.")
+format.")
(defvar gnus-soup-areas nil)
(defvar gnus-soup-last-prefix nil)
(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)))
+ (when (gnus-soup-send-packet (car packets))
+ (delete-file (car packets)))
(setq packets (cdr packets)))))
(defun gnus-soup-add-article (n)
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*"))
+ (tmp-buf (gnus-get-buffer-create "*soup work*"))
(area (gnus-soup-area gnus-newsgroup-name))
(prefix (gnus-soup-area-prefix area))
headers)
(buffer-disable-undo tmp-buf)
(save-excursion
(while articles
- ;; Find the header of the article.
- (set-buffer gnus-summary-buffer)
- (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
- (car articles) gnus-newsgroup-name)
- (save-restriction
- (nnheader-narrow-to-headers)
- (nnheader-remove-header gnus-soup-ignored-headers t))
- (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)
+ ;; Put the article in a buffer.
+ (set-buffer tmp-buf)
+ (when (gnus-request-article-this-buffer
+ (car articles) gnus-newsgroup-name)
+ (setq headers (nnheader-parse-head t))
+ (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-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-mark-as-read (car articles) gnus-souped-mark))
(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)
- (gnus-soup-pack gnus-soup-directory gnus-soup-packer))
+ (if (file-exists-p gnus-soup-directory)
+ (if (directory-files gnus-soup-directory nil "\\.MSG$")
+ (gnus-soup-pack gnus-soup-directory gnus-soup-packer)
+ (message "No files to pack."))
+ (message "No such directory: %s" gnus-soup-directory)))
(defun gnus-group-brew-soup (n)
"Make a soup packet from the current group.
(let ((level (or level gnus-level-subscribed))
(newsrc (cdr gnus-newsrc-alist)))
(while newsrc
- (and (<= (nth 1 (car newsrc)) level)
- (gnus-soup-group-brew (caar newsrc) t))
+ (when (<= (nth 1 (car newsrc)) level)
+ (gnus-soup-group-brew (caar newsrc) t))
(setq newsrc (cdr newsrc)))
(gnus-soup-save-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)