cgit.sxemacs.org Git - gnus/blob - lisp/gnus-soup.el

   1 ;;; gnus-soup.el --- SOUP packet writing support for Gnus
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006 Free Software Foundation, Inc.
   5
   6 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
   7 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   8 ;; Keywords: news, mail
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))
  32
  33 (require 'gnus)
  34 (require 'gnus-art)
  35 (require 'message)
  36 (require 'gnus-start)
  37 (require 'gnus-range)
  38
  39 (defgroup gnus-soup nil
  40   "SOUP packet writing support for Gnus."
  41   :group 'gnus)
  42
  43 ;;; User Variables:
  44
  45 (defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
  46   "Directory containing an unpacked SOUP packet."
  47   :version "22.1" ;; Gnus 5.10.9
  48   :type 'directory
  49   :group 'gnus-soup)
  50
  51 (defcustom gnus-soup-replies-directory
  52   (nnheader-concat gnus-soup-directory "SoupReplies/")
  53   "Directory where Gnus will do processing of replies."
  54   :version "22.1" ;; Gnus 5.10.9
  55   :type 'directory
  56   :group 'gnus-soup)
  57
  58 (defcustom gnus-soup-prefix-file "gnus-prefix"
  59   "Name of the file where Gnus stores the last used prefix."
  60   :version "22.1" ;; Gnus 5.10.9
  61   :type 'file
  62   :group 'gnus-soup)
  63
  64 (defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
  65   "Format string command for packing a SOUP packet.
  66 The SOUP files will be inserted where the %s is in the string.
  67 This string MUST contain both %s and %d.  The file number will be
  68 inserted where %d appears."
  69   :version "22.1" ;; Gnus 5.10.9
  70   :type 'string
  71   :group 'gnus-soup)
  72
  73 (defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -"
  74   "Format string command for unpacking a SOUP packet.
  75 The SOUP packet file name will be inserted at the %s."
  76   :version "22.1" ;; Gnus 5.10.9
  77   :type 'string
  78   :group 'gnus-soup)
  79
  80 (defcustom gnus-soup-packet-directory gnus-home-directory
  81   "Where gnus-soup will look for REPLIES packets."
  82   :version "22.1" ;; Gnus 5.10.9
  83   :type 'directory
  84   :group 'gnus-soup)
  85
  86 (defcustom gnus-soup-packet-regexp "Soupin"
  87   "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'."
  88   :version "22.1" ;; Gnus 5.10.9
  89   :type 'regexp
  90   :group 'gnus-soup)
  91
  92 (defcustom gnus-soup-ignored-headers "^Xref:"
  93   "Regexp to match headers to be removed when brewing SOUP packets."
  94   :version "22.1" ;; Gnus 5.10.9
  95   :type 'regexp
  96   :group 'gnus-soup)
  97
  98 ;;; Internal Variables:
  99
 100 (defvar gnus-soup-encoding-type ?u
 101   "*Soup encoding type.
 102 `u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox
 103 format.")
 104
 105 (defvar gnus-soup-index-type ?c
 106   "*Soup index type.
 107 `n' means no index file and `c' means standard Cnews overview
 108 format.")
 109
 110 (defvar gnus-soup-areas nil)
 111 (defvar gnus-soup-last-prefix nil)
 112 (defvar gnus-soup-prev-prefix nil)
 113 (defvar gnus-soup-buffers nil)
 114
 115 ;;; Access macros:
 116
 117 (defmacro gnus-soup-area-prefix (area)
 118   `(aref ,area 0))
 119 (defmacro gnus-soup-set-area-prefix (area prefix)
 120   `(aset ,area 0 ,prefix))
 121 (defmacro gnus-soup-area-name (area)
 122   `(aref ,area 1))
 123 (defmacro gnus-soup-area-encoding (area)
 124   `(aref ,area 2))
 125 (defmacro gnus-soup-area-description (area)
 126   `(aref ,area 3))
 127 (defmacro gnus-soup-area-number (area)
 128   `(aref ,area 4))
 129 (defmacro gnus-soup-area-set-number (area value)
 130   `(aset ,area 4 ,value))
 131
 132 (defmacro gnus-soup-encoding-format (encoding)
 133   `(aref ,encoding 0))
 134 (defmacro gnus-soup-encoding-index (encoding)
 135   `(aref ,encoding 1))
 136 (defmacro gnus-soup-encoding-kind (encoding)
 137   `(aref ,encoding 2))
 138
 139 (defmacro gnus-soup-reply-prefix (reply)
 140   `(aref ,reply 0))
 141 (defmacro gnus-soup-reply-kind (reply)
 142   `(aref ,reply 1))
 143 (defmacro gnus-soup-reply-encoding (reply)
 144   `(aref ,reply 2))
 145
 146 ;;; Commands:
 147
 148 (defun gnus-soup-send-replies ()
 149   "Unpack and send all replies in the reply packet."
 150   (interactive)
 151   (let ((packets (directory-files
 152                   gnus-soup-packet-directory t gnus-soup-packet-regexp)))
 153     (while packets
 154       (when (gnus-soup-send-packet (car packets))
 155         (delete-file (car packets)))
 156       (setq packets (cdr packets)))))
 157
 158 (defun gnus-soup-add-article (n)
 159   "Add the current article to SOUP packet.
 160 If N is a positive number, add the N next articles.
 161 If N is a negative number, add the N previous articles.
 162 If N is nil and any articles have been marked with the process mark,
 163 move those articles instead."
 164   (interactive "P")
 165   (let* ((articles (gnus-summary-work-articles n))
 166          (tmp-buf (gnus-get-buffer-create "*soup work*"))
 167          (area (gnus-soup-area gnus-newsgroup-name))
 168          (prefix (gnus-soup-area-prefix area))
 169          headers)
 170     (buffer-disable-undo tmp-buf)
 171     (save-excursion
 172       (while articles
 173         ;; Put the article in a buffer.
 174         (set-buffer tmp-buf)
 175         (when (gnus-request-article-this-buffer
 176                (car articles) gnus-newsgroup-name)
 177           (setq headers (nnheader-parse-head t))
 178           (save-restriction
 179             (message-narrow-to-head)
 180             (message-remove-header gnus-soup-ignored-headers t))
 181           (gnus-soup-store gnus-soup-directory prefix headers
 182                            gnus-soup-encoding-type
 183                            gnus-soup-index-type)
 184           (gnus-soup-area-set-number
 185            area (1+ (or (gnus-soup-area-number area) 0)))
 186           ;; Mark article as read.
 187           (set-buffer gnus-summary-buffer)
 188           (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
 189         (gnus-summary-remove-process-mark (car articles))
 190         (setq articles (cdr articles)))
 191       (kill-buffer tmp-buf))
 192     (gnus-soup-save-areas)
 193     (gnus-set-mode-line 'summary)))
 194
 195 (defun gnus-soup-pack-packet ()
 196   "Make a SOUP packet from the SOUP areas."
 197   (interactive)
 198   (gnus-soup-read-areas)
 199   (if (file-exists-p gnus-soup-directory)
 200       (if (directory-files gnus-soup-directory nil "\\.MSG$")
 201           (gnus-soup-pack gnus-soup-directory gnus-soup-packer)
 202         (message "No files to pack."))
 203     (message "No such directory: %s" gnus-soup-directory)))
 204
 205 (defun gnus-group-brew-soup (n)
 206   "Make a soup packet from the current group.
 207 Uses the process/prefix convention."
 208   (interactive "P")
 209   (let ((groups (gnus-group-process-prefix n)))
 210     (while groups
 211       (gnus-group-remove-mark (car groups))
 212       (gnus-soup-group-brew (car groups) t)
 213       (setq groups (cdr groups)))
 214     (gnus-soup-save-areas)))
 215
 216 (defun gnus-brew-soup (&optional level)
 217   "Go through all groups on LEVEL or less and make a soup packet."
 218   (interactive "P")
 219   (let ((level (or level gnus-level-subscribed))
 220         (newsrc (cdr gnus-newsrc-alist)))
 221     (while newsrc
 222       (when (<= (nth 1 (car newsrc)) level)
 223         (gnus-soup-group-brew (caar newsrc) t))
 224       (setq newsrc (cdr newsrc)))
 225     (gnus-soup-save-areas)))
 226
 227 ;;;###autoload
 228 (defun gnus-batch-brew-soup ()
 229   "Brew a SOUP packet from groups mention on the command line.
 230 Will use the remaining command line arguments as regular expressions
 231 for matching on group names.
 232
 233 For instance, if you want to brew on all the nnml groups, as well as
 234 groups with \"emacs\" in the name, you could say something like:
 235
 236 $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
 237
 238 Note -- this function hasn't been implemented yet."
 239   (interactive)
 240   nil)
 241
 242 ;;; Internal Functions:
 243
 244 ;; Store the current buffer.
 245 (defun gnus-soup-store (directory prefix headers format index)
 246   ;; Create the directory, if needed.
 247   (gnus-make-directory directory)
 248   (let* ((msg-buf (nnheader-find-file-noselect
 249                    (concat directory prefix ".MSG")))
 250          (idx-buf (if (= index ?n)
 251                       nil
 252                     (nnheader-find-file-noselect
 253                      (concat directory prefix ".IDX"))))
 254          (article-buf (current-buffer))
 255          from head-line beg type)
 256     (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
 257     (buffer-disable-undo msg-buf)
 258     (when idx-buf
 259       (push idx-buf gnus-soup-buffers)
 260       (buffer-disable-undo idx-buf))
 261     (save-excursion
 262       ;; Make sure the last char in the buffer is a newline.
 263       (goto-char (point-max))
 264       (unless (= (current-column) 0)
 265         (insert "\n"))
 266       ;; Find the "from".
 267       (goto-char (point-min))
 268       (setq from
 269             (gnus-mail-strip-quoted-names
 270              (or (mail-fetch-field "from")
 271                  (mail-fetch-field "really-from")
 272                  (mail-fetch-field "sender"))))
 273       (goto-char (point-min))
 274       ;; Depending on what encoding is supposed to be used, we make
 275       ;; a soup header.
 276       (setq head-line
 277             (cond
 278              ((or (= gnus-soup-encoding-type ?u)
 279                   (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.
 280               (format "#! rnews %d\n" (buffer-size)))
 281              ((= gnus-soup-encoding-type ?m)
 282               (while (search-forward "\nFrom " nil t)
 283                 (replace-match "\n>From " t t))
 284               (concat "From " (or from "unknown")
 285                       " " (current-time-string) "\n"))
 286              ((= gnus-soup-encoding-type ?M)
 287               "\^a\^a\^a\^a\n")
 288              (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
 289       ;; Insert the soup header and the article in the MSG buf.
 290       (set-buffer msg-buf)
 291       (goto-char (point-max))
 292       (insert head-line)
 293       (setq beg (point))
 294       (insert-buffer-substring article-buf)
 295       ;; Insert the index in the IDX buf.
 296       (cond ((= index ?c)
 297              (set-buffer idx-buf)
 298              (gnus-soup-insert-idx beg headers))
 299             ((/= index ?n)
 300              (error "Unknown index type: %c" type)))
 301       ;; Return the MSG buf.
 302       msg-buf)))
 303
 304 (defun gnus-soup-group-brew (group &optional not-all)
 305   "Enter GROUP and add all articles to a SOUP package.
 306 If NOT-ALL, don't pack ticked articles."
 307   (let ((gnus-expert-user t)
 308         (gnus-large-newsgroup nil)
 309         (entry (gnus-group-entry group)))
 310     (when (or (null entry)
 311               (eq (car entry) t)
 312               (and (car entry)
 313                    (> (car entry) 0))
 314               (and (not not-all)
 315                    (gnus-range-length (cdr (assq 'tick (gnus-info-marks
 316                                                         (nth 2 entry)))))))
 317       (when (gnus-summary-read-group group nil t)
 318         (setq gnus-newsgroup-processable
 319               (reverse
 320                (if (not not-all)
 321                    (append gnus-newsgroup-marked gnus-newsgroup-unreads)
 322                  gnus-newsgroup-unreads)))
 323         (gnus-soup-add-article nil)
 324         (gnus-summary-exit)))))
 325
 326 (defun gnus-soup-insert-idx (offset header)
 327   ;; [number subject from date id references chars lines xref]
 328   (goto-char (point-max))
 329   (insert
 330    (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
 331            offset
 332            (or (mail-header-subject header) "(none)")
 333            (or (mail-header-from header) "(nobody)")
 334            (or (mail-header-date header) "")
 335            (or (mail-header-id header)
 336                (concat "soup-dummy-id-"
 337                        (mapconcat
 338                         (lambda (time) (int-to-string time))
 339                         (current-time) "-")))
 340            (or (mail-header-references header) "")
 341            (or (mail-header-chars header) 0)
 342            (or (mail-header-lines header) "0"))))
 343
 344 (defun gnus-soup-save-areas ()
 345   "Write all SOUP buffers."
 346   (interactive)
 347   (gnus-soup-write-areas)
 348   (save-excursion
 349     (let (buf)
 350       (while gnus-soup-buffers
 351         (setq buf (car gnus-soup-buffers)
 352               gnus-soup-buffers (cdr gnus-soup-buffers))
 353         (if (not (buffer-name buf))
 354             ()
 355           (set-buffer buf)
 356           (when (buffer-modified-p)
 357             (save-buffer))
 358           (kill-buffer (current-buffer)))))
 359     (gnus-soup-write-prefixes)))
 360
 361 (defun gnus-soup-write-prefixes ()
 362   (let ((prefixes gnus-soup-last-prefix)
 363         prefix)
 364     (save-excursion
 365       (gnus-set-work-buffer)
 366       (while (setq prefix (pop prefixes))
 367         (erase-buffer)
 368         (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
 369         (let ((coding-system-for-write mm-text-coding-system))
 370           (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))
 371
 372 (defun gnus-soup-pack (dir packer)
 373   (let* ((files (mapconcat 'identity
 374                            '("AREAS" "*.MSG" "*.IDX" "INFO"
 375                              "LIST" "REPLIES" "COMMANDS" "ERRORS")
 376                            " "))
 377          (packer (if (< (string-match "%s" packer)
 378                         (string-match "%d" packer))
 379                      (format packer files
 380                              (string-to-number (gnus-soup-unique-prefix dir)))
 381                    (format packer
 382                            (string-to-number (gnus-soup-unique-prefix dir))
 383                            files)))
 384          (dir (expand-file-name dir)))
 385     (gnus-make-directory dir)
 386     (setq gnus-soup-areas nil)
 387     (gnus-message 4 "Packing %s..." packer)
 388     (if (eq 0 (call-process shell-file-name
 389                             nil nil nil shell-command-switch
 390                             (concat "cd " dir " ; " packer)))
 391         (progn
 392           (call-process shell-file-name nil nil nil shell-command-switch
 393                         (concat "cd " dir " ; rm " files))
 394           (gnus-message 4 "Packing...done" packer))
 395       (error "Couldn't pack packet"))))
 396
 397 (defun gnus-soup-parse-areas (file)
 398   "Parse soup area file FILE.
 399 The result is a of vectors, each containing one entry from the AREA file.
 400 The vector contain five strings,
 401   [prefix name encoding description number]
 402 though the two last may be nil if they are missing."
 403   (let (areas)
 404     (when (file-exists-p file)
 405       (save-excursion
 406         (set-buffer (nnheader-find-file-noselect file 'force))
 407         (buffer-disable-undo)
 408         (goto-char (point-min))
 409         (while (not (eobp))
 410           (push (vector (gnus-soup-field)
 411                         (gnus-soup-field)
 412                         (gnus-soup-field)
 413                         (and (eq (preceding-char) ?\t)
 414                              (gnus-soup-field))
 415                         (and (eq (preceding-char) ?\t)
 416                              (string-to-number (gnus-soup-field))))
 417                 areas)
 418           (when (eq (preceding-char) ?\t)
 419             (beginning-of-line 2)))
 420         (kill-buffer (current-buffer))))
 421     areas))
 422
 423 (defun gnus-soup-parse-replies (file)
 424   "Parse soup REPLIES file FILE.
 425 The result is a of vectors, each containing one entry from the REPLIES
 426 file.  The vector contain three strings, [prefix name encoding]."
 427   (let (replies)
 428     (save-excursion
 429       (set-buffer (nnheader-find-file-noselect file))
 430       (buffer-disable-undo)
 431       (goto-char (point-min))
 432       (while (not (eobp))
 433         (push (vector (gnus-soup-field) (gnus-soup-field)
 434                       (gnus-soup-field))
 435               replies)
 436         (when (eq (preceding-char) ?\t)
 437           (beginning-of-line 2)))
 438       (kill-buffer (current-buffer)))
 439     replies))
 440
 441 (defun gnus-soup-field ()
 442   (prog1
 443       (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
 444     (forward-char 1)))
 445
 446 (defun gnus-soup-read-areas ()
 447   (or gnus-soup-areas
 448       (setq gnus-soup-areas
 449             (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
 450
 451 (defun gnus-soup-write-areas ()
 452   "Write the AREAS file."
 453   (interactive)
 454   (when gnus-soup-areas
 455     (with-temp-file (concat gnus-soup-directory "AREAS")
 456       (let ((areas gnus-soup-areas)
 457             area)
 458         (while (setq area (pop areas))
 459           (insert
 460            (format
 461             "%s\t%s\t%s%s\n"
 462             (gnus-soup-area-prefix area)
 463             (gnus-soup-area-name area)
 464             (gnus-soup-area-encoding area)
 465             (if (or (gnus-soup-area-description area)
 466                     (gnus-soup-area-number area))
 467                 (concat "\t" (or (gnus-soup-area-description
 468                                   area) "")
 469                         (if (gnus-soup-area-number area)
 470                             (concat "\t" (int-to-string
 471                                           (gnus-soup-area-number area)))
 472                           "")) ""))))))))
 473
 474 (defun gnus-soup-write-replies (dir areas)
 475   "Write a REPLIES file in DIR containing AREAS."
 476   (with-temp-file (concat dir "REPLIES")
 477     (let (area)
 478       (while (setq area (pop areas))
 479         (insert (format "%s\t%s\t%s\n"
 480                         (gnus-soup-reply-prefix area)
 481                         (gnus-soup-reply-kind area)
 482                         (gnus-soup-reply-encoding area)))))))
 483
 484 (defun gnus-soup-area (group)
 485   (gnus-soup-read-areas)
 486   (let ((areas gnus-soup-areas)
 487         (real-group (gnus-group-real-name group))
 488         area result)
 489     (while areas
 490       (setq area (car areas)
 491             areas (cdr areas))
 492       (when (equal (gnus-soup-area-name area) real-group)
 493         (setq result area)))
 494     (unless result
 495       (setq result
 496             (vector (gnus-soup-unique-prefix)
 497                     real-group
 498                     (format "%c%c%c"
 499                             gnus-soup-encoding-type
 500                             gnus-soup-index-type
 501                             (if (gnus-member-of-valid 'mail group) ?m ?n))
 502                     nil nil)
 503             gnus-soup-areas (cons result gnus-soup-areas)))
 504     result))
 505
 506 (defun gnus-soup-unique-prefix (&optional dir)
 507   (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
 508          (entry (assoc dir gnus-soup-last-prefix))
 509          gnus-soup-prev-prefix)
 510     (if entry
 511         ()
 512       (when (file-exists-p (concat dir gnus-soup-prefix-file))
 513         (ignore-errors
 514           (load (concat dir gnus-soup-prefix-file) nil t t)))
 515       (push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
 516             gnus-soup-last-prefix))
 517     (setcdr entry (1+ (cdr entry)))
 518     (gnus-soup-write-prefixes)
 519     (int-to-string (cdr entry))))
 520
 521 (defun gnus-soup-unpack-packet (dir unpacker packet)
 522   "Unpack PACKET into DIR using UNPACKER.
 523 Return whether the unpacking was successful."
 524   (gnus-make-directory dir)
 525   (gnus-message 4 "Unpacking: %s" (format unpacker packet))
 526   (prog1
 527       (eq 0 (call-process
 528              shell-file-name nil nil nil shell-command-switch
 529              (format "cd %s ; %s" (expand-file-name dir)
 530                      (format unpacker packet))))
 531     (gnus-message 4 "Unpacking...done")))
 532
 533 (defun gnus-soup-send-packet (packet)
 534   (gnus-soup-unpack-packet
 535    gnus-soup-replies-directory gnus-soup-unpacker packet)
 536   (let ((replies (gnus-soup-parse-replies
 537                   (concat gnus-soup-replies-directory "REPLIES"))))
 538     (save-excursion
 539       (while replies
 540         (let* ((msg-file (concat gnus-soup-replies-directory
 541                                  (gnus-soup-reply-prefix (car replies))
 542                                  ".MSG"))
 543                (msg-buf (and (file-exists-p msg-file)
 544                              (nnheader-find-file-noselect msg-file)))
 545                (tmp-buf (gnus-get-buffer-create " *soup send*"))
 546                beg end)
 547           (cond
 548            ((and (/= (gnus-soup-encoding-format
 549                       (gnus-soup-reply-encoding (car replies)))
 550                      ?u)
 551                  (/= (gnus-soup-encoding-format
 552                       (gnus-soup-reply-encoding (car replies)))
 553                      ?n)) ;; Gnus back compatibility.
 554             (error "Unsupported encoding"))
 555            ((null msg-buf)
 556             t)
 557            (t
 558             (buffer-disable-undo msg-buf)
 559             (set-buffer msg-buf)
 560             (goto-char (point-min))
 561             (while (not (eobp))
 562               (unless (looking-at "#! *rnews +\\([0-9]+\\)")
 563                 (error "Bad header"))
 564               (forward-line 1)
 565               (setq beg (point)
 566                     end (+ (point) (string-to-number
 567                                     (buffer-substring
 568                                      (match-beginning 1) (match-end 1)))))
 569               (switch-to-buffer tmp-buf)
 570               (erase-buffer)
 571               (mm-disable-multibyte)
 572               (insert-buffer-substring msg-buf beg end)
 573               (cond
 574                ((string= (gnus-soup-reply-kind (car replies)) "news")
 575                 (gnus-message 5 "Sending news message to %s..."
 576                               (mail-fetch-field "newsgroups"))
 577                 (sit-for 1)
 578                 (let ((message-syntax-checks
 579                        'dont-check-for-anything-just-trust-me)
 580                       (method (if (functionp message-post-method)
 581                                   (funcall message-post-method)
 582                                 message-post-method))
 583                       result)
 584                   (run-hooks 'message-send-news-hook)
 585                   (gnus-open-server method)
 586                   (message "Sending news via %s..."
 587                            (gnus-server-string method))
 588                   (unless (let ((mail-header-separator ""))
 589                             (gnus-request-post method))
 590                     (message "Couldn't send message via news: %s"
 591                              (nnheader-get-report (car method))))))
 592                ((string= (gnus-soup-reply-kind (car replies)) "mail")
 593                 (gnus-message 5 "Sending mail to %s..."
 594                               (mail-fetch-field "to"))
 595                 (sit-for 1)
 596                 (let ((mail-header-separator ""))
 597                   (mm-with-unibyte-current-buffer
 598                     (funcall (or message-send-mail-real-function
 599                                  message-send-mail-function)))))
 600                (t
 601                 (error "Unknown reply kind")))
 602               (set-buffer msg-buf)
 603               (goto-char end))
 604             (delete-file (buffer-file-name))
 605             (kill-buffer msg-buf)
 606             (kill-buffer tmp-buf)
 607             (gnus-message 4 "Sent packet"))))
 608         (setq replies (cdr replies)))
 609       t)))
 610
 611 (provide 'gnus-soup)
 612
 613 ;;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c
 614 ;;; gnus-soup.el ends here