X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-soup.el;h=b444032e993821a3cfa0698c12cc1e76816a8f68;hp=71345c9a7398245ee5d2d08b2bea9fe2ec5b345b;hb=7855c28b8ddeb14a6f637bcae5048f28d764271e;hpb=1626a196f4c06639aaf46dc4a6a0901b7b6e9b5c diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 71345c9a7..b444032e9 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, 2002 +;; 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 @@ -140,25 +142,23 @@ move those articles instead." (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) @@ -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,8 @@ 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)))))) + (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 @@ -374,7 +376,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 +399,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) @@ -515,9 +517,12 @@ Return whether the unpacking was successful." (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) @@ -535,26 +540,35 @@ 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-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)