X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-soup.el;h=3d9782969a69229c772b9b52438076ccb14bd236;hb=a45dd507bf71d9e3fbfb6067896554323b02b643;hp=b444032e993821a3cfa0698c12cc1e76816a8f68;hpb=ebdecdf203f300217a9a7f533dcf43fec5d427b4;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index b444032..3d97829 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -1,7 +1,5 @@ ;;; gnus-soup.el --- SOUP packet writing support for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -69,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 @@ -142,23 +140,25 @@ 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))) - ;; Mark article as read. - (set-buffer gnus-summary-buffer) - (gnus-summary-mark-as-read (car articles) gnus-souped-mark)) + ;; 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)) + (gnus-summary-mark-as-read (car articles) gnus-souped-mark) (setq articles (cdr articles))) (kill-buffer tmp-buf)) (gnus-soup-save-areas) @@ -168,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. @@ -247,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) @@ -338,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 @@ -376,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) @@ -399,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) @@ -424,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)) @@ -445,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" @@ -517,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) @@ -540,35 +535,25 @@ Return whether the unpacking was successful." (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-user-agent (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) - (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)))))) + 'dont-check-for-anything-just-trust-me)) + (funcall message-send-news-function))) ((string= (gnus-soup-reply-kind (car replies)) "mail") (gnus-message 5 "Sending mail to %s..." (mail-fetch-field "to")) (sit-for 1) - (let ((mail-header-separator "")) - (mm-with-unibyte-current-buffer - (funcall (or message-send-mail-real-function - message-send-mail-function))))) + (message-send-mail)) (t (error "Unknown reply kind"))) (set-buffer msg-buf)