;;; gnus-soup.el --- SOUP packet writing support for Gnus
-;; Copyright (C) 1995,96,97 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:
+(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"
;;; 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
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
- (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)
+ ;; 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)
- (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))
+ (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.
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)
;; a soup header.
(setq head-line
(cond
- ((= gnus-soup-encoding-type ?n)
+ ((or (= gnus-soup-encoding-type ?u)
+ (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.
(format "#! rnews %d\n" (buffer-size)))
((= gnus-soup-encoding-type ?m)
(while (search-forward "\nFrom " nil t)
(or (mail-header-lines header) "0"))))
(defun gnus-soup-save-areas ()
+ "Write all SOUP buffers."
+ (interactive)
(gnus-soup-write-areas)
(save-excursion
(let (buf)
(while (setq prefix (pop prefixes))
(erase-buffer)
(insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
- (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))
+ (let ((coding-system-for-write mm-text-coding-system))
+ (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))
(defun gnus-soup-pack (dir packer)
(let* ((files (mapconcat 'identity
(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.
[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)
+ (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)
(let (replies)
(save-excursion
(set-buffer (nnheader-find-file-noselect file))
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(goto-char (point-min))
(while (not (eobp))
(push (vector (gnus-soup-field) (gnus-soup-field)
"Write the AREAS file."
(interactive)
(when gnus-soup-areas
- (nnheader-temp-write (concat gnus-soup-directory "AREAS")
+ (with-temp-file (concat gnus-soup-directory "AREAS")
(let ((areas gnus-soup-areas)
area)
(while (setq area (pop areas))
(defun gnus-soup-write-replies (dir areas)
"Write a REPLIES file in DIR containing AREAS."
- (nnheader-temp-write (concat dir "REPLIES")
+ (with-temp-file (concat dir "REPLIES")
(let (area)
(while (setq area (pop areas))
(insert (format "%s\t%s\t%s\n"
".MSG"))
(msg-buf (and (file-exists-p msg-file)
(nnheader-find-file-noselect msg-file)))
- (tmp-buf (get-buffer-create " *soup send*"))
+ (tmp-buf (gnus-get-buffer-create " *soup send*"))
beg end)
(cond
- ((/= (gnus-soup-encoding-format
- (gnus-soup-reply-encoding (car replies)))
- ?n)
+ ((and (/= (gnus-soup-encoding-format
+ (gnus-soup-reply-encoding (car replies)))
+ ?u)
+ (/= (gnus-soup-encoding-format
+ (gnus-soup-reply-encoding (car replies)))
+ ?n)) ;; Gnus back compatibility.
(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))
(unless (looking-at "#! *rnews +\\([0-9]+\\)")
- (error "Bad header."))
+ (error "Bad header"))
(forward-line 1)
(setq beg (point)
end (+ (point) (string-to-int
(match-beginning 1) (match-end 1)))))
(switch-to-buffer tmp-buf)
(erase-buffer)
+ (mm-disable-multibyte)
(insert-buffer-substring msg-buf beg end)
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-char -1)
- (insert mail-header-separator)
- (setq message-newsreader (setq message-mailer
- (gnus-extended-version)))
(cond
((string= (gnus-soup-reply-kind (car replies)) "news")
(gnus-message 5 "Sending news message to %s..."
(mail-fetch-field "newsgroups"))
(sit-for 1)
(let ((message-syntax-checks
- 'dont-check-for-anything-just-trust-me))
- (funcall message-send-news-function)))
+ 'dont-check-for-anything-just-trust-me)
+ (method (if (message-functionp message-post-method)
+ (funcall message-post-method)
+ message-post-method))
+ result)
+ (run-hooks 'message-send-news-hook)
+ (gnus-open-server method)
+ (message "Sending news via %s..."
+ (gnus-server-string method))
+ (unless (let ((mail-header-separator ""))
+ (gnus-request-post method))
+ (message "Couldn't send message via news: %s"
+ (nnheader-get-report (car method))))))
((string= (gnus-soup-reply-kind (car replies)) "mail")
(gnus-message 5 "Sending mail to %s..."
(mail-fetch-field "to"))
(sit-for 1)
- (message-send-mail))
+ (let ((mail-header-separator ""))
+ (mm-with-unibyte-current-buffer
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function)))))
(t
(error "Unknown reply kind")))
(set-buffer msg-buf)
projects / gnus / blobdiff