X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=inline;f=lisp%2Fgnus-soup.el;h=9b974a842dda645cb81b75de84f3107401ac715e;hb=413d01cb1323e7aa46196ab5965dfbf237da59bd;hp=0d95f4cbd26e419882cb80366e9d556f50e87663;hpb=c1cef9e349426fba0db536f074e2677efdb0106b;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 0d95f4c..9b974a8 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -1,5 +1,7 @@ ;;; gnus-soup.el --- SOUP packet writing support for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -67,9 +69,9 @@ The SOUP packet file name will be inserted at the %s.") ;;; 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 @@ -133,28 +135,26 @@ If N is nil and any articles have been marked with the process mark, move those articles instead." (interactive "P") (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))))) + ;; 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-remove-process-mark (car articles)) @@ -168,11 +168,11 @@ move those articles instead." "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. @@ -247,7 +247,8 @@ Note -- this function hasn't been implemented yet." ;; 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) @@ -337,7 +338,9 @@ If NOT-ALL, don't pack ticked articles." (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)))))) + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system + (concat (car prefix) gnus-soup-prefix-file)))))) (defun gnus-soup-pack (dir packer) (let* ((files (mapconcat 'identity @@ -374,7 +377,7 @@ though the two last may be nil if they are missing." (when (file-exists-p file) (save-excursion (set-buffer (nnheader-find-file-noselect file 'force)) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (goto-char (point-min)) (while (not (eobp)) (push (vector (gnus-soup-field) @@ -397,7 +400,7 @@ file. The vector contain three strings, [prefix name encoding]." (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) @@ -422,7 +425,7 @@ file. The vector contain three strings, [prefix name encoding]." "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)) @@ -443,7 +446,7 @@ file. The vector contain three strings, [prefix name encoding]." (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" @@ -512,12 +515,15 @@ Return whether the unpacking was successful." ".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) @@ -540,8 +546,7 @@ Return whether the unpacking was successful." (search-forward "\n\n") (forward-char -1) (insert mail-header-separator) - (setq message-newsreader (setq message-mailer - (gnus-extended-version))) + (setq message-user-agent (gnus-extended-version)) (cond ((string= (gnus-soup-reply-kind (car replies)) "news") (gnus-message 5 "Sending news message to %s..."