X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-soup.el;h=3d9782969a69229c772b9b52438076ccb14bd236;hb=a45dd507bf71d9e3fbfb6067896554323b02b643;hp=de67cc755029dc3a1305da084d1f6ccc92b243d9;hpb=3c19a9d1054e341f806d39714ddf1d70b03ef142;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index de67cc7..3d97829 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -1,5 +1,5 @@ ;;; gnus-soup.el --- SOUP packet writing support for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -67,9 +67,9 @@ The SOUP packet file name will be inserted at the %s.") ;;; Internal Variables: -(defvar gnus-soup-encoding-type ?u +(defvar gnus-soup-encoding-type ?n "*Soup encoding type. -`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox +`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox format.") (defvar gnus-soup-index-type ?c @@ -140,19 +140,21 @@ move those articles instead." (buffer-disable-undo tmp-buf) (save-excursion (while articles - ;; 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)))) + ;; 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) (gnus-summary-remove-process-mark (car articles)) @@ -166,11 +168,11 @@ move those articles instead." "Make a SOUP packet from the SOUP areas." (interactive) (gnus-soup-read-areas) - (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))) + (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) "Make a soup packet from the current group. @@ -245,8 +247,7 @@ Note -- this function hasn't been implemented yet." ;; a soup header. (setq head-line (cond - ((or (= gnus-soup-encoding-type ?u) - (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility. + ((= gnus-soup-encoding-type ?n) (format "#! rnews %d\n" (buffer-size))) ((= gnus-soup-encoding-type ?m) (while (search-forward "\nFrom " nil t) @@ -336,8 +337,7 @@ 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))) - (let ((coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))) + (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))) (defun gnus-soup-pack (dir packer) (let* ((files (mapconcat 'identity @@ -374,7 +374,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) + (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (not (eobp)) (push (vector (gnus-soup-field) @@ -397,7 +397,7 @@ file. The vector contain three strings, [prefix name encoding]." (let (replies) (save-excursion (set-buffer (nnheader-find-file-noselect file)) - (buffer-disable-undo) + (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (not (eobp)) (push (vector (gnus-soup-field) (gnus-soup-field) @@ -422,7 +422,7 @@ file. The vector contain three strings, [prefix name encoding]." "Write the AREAS file." (interactive) (when gnus-soup-areas - (with-temp-file (concat gnus-soup-directory "AREAS") + (nnheader-temp-write (concat gnus-soup-directory "AREAS") (let ((areas gnus-soup-areas) area) (while (setq area (pop areas)) @@ -443,7 +443,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." - (with-temp-file (concat dir "REPLIES") + (nnheader-temp-write (concat dir "REPLIES") (let (area) (while (setq area (pop areas)) (insert (format "%s\t%s\t%s\n" @@ -515,12 +515,9 @@ Return whether the unpacking was successful." (tmp-buf (gnus-get-buffer-create " *soup send*")) beg end) (cond - ((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. + ((/= (gnus-soup-encoding-format + (gnus-soup-reply-encoding (car replies))) + ?n) (error "Unsupported encoding")) ((null msg-buf) t) @@ -543,8 +540,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..."