Mercurial > emacs

comparison lisp/gnus/gnus-soup.el @ 82951:0fde48feb604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author Andreas Schwab <schwab@suse.de>
date Thu, 22 Jul 2004 16:45:51 +0000
parents 695cf19ef79e
children 88db2adda4b7 cce1c0ee76ee
comparison
equal deleted inserted replaced
56503:8bbd2323fbf2 82951:0fde48feb604
1 ;;; gnus-soup.el --- SOUP packet writing support for Gnus 1 ;;; gnus-soup.el --- SOUP packet writing support for Gnus
2 2
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
4 ;; Free Software Foundation, Inc. 4 ;; Free Software Foundation, Inc.
5 5
6 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk> 6 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org> 7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; Keywords: news, mail 8 ;; Keywords: news, mail
152 (message-remove-header gnus-soup-ignored-headers t)) 152 (message-remove-header gnus-soup-ignored-headers t))
153 (gnus-soup-store gnus-soup-directory prefix headers 153 (gnus-soup-store gnus-soup-directory prefix headers
154 gnus-soup-encoding-type 154 gnus-soup-encoding-type
155 gnus-soup-index-type) 155 gnus-soup-index-type)
156 (gnus-soup-area-set-number 156 (gnus-soup-area-set-number
157 area (1+ (or (gnus-soup-area-number area) 0)))) 157 area (1+ (or (gnus-soup-area-number area) 0)))
158 ;; Mark article as read. 158 ;; Mark article as read.
159 (set-buffer gnus-summary-buffer) 159 (set-buffer gnus-summary-buffer)
160 (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
160 (gnus-summary-remove-process-mark (car articles)) 161 (gnus-summary-remove-process-mark (car articles))
161 (gnus-summary-mark-as-read (car articles) gnus-souped-mark)
162 (setq articles (cdr articles))) 162 (setq articles (cdr articles)))
163 (kill-buffer tmp-buf)) 163 (kill-buffer tmp-buf))
164 (gnus-soup-save-areas) 164 (gnus-soup-save-areas)
165 (gnus-set-mode-line 'summary))) 165 (gnus-set-mode-line 'summary)))
166 166
355 files))) 355 files)))
356 (dir (expand-file-name dir))) 356 (dir (expand-file-name dir)))
357 (gnus-make-directory dir) 357 (gnus-make-directory dir)
358 (setq gnus-soup-areas nil) 358 (setq gnus-soup-areas nil)
359 (gnus-message 4 "Packing %s..." packer) 359 (gnus-message 4 "Packing %s..." packer)
360 (if (zerop (call-process shell-file-name 360 (if (eq 0 (call-process shell-file-name
361 nil nil nil shell-command-switch 361 nil nil nil shell-command-switch
362 (concat "cd " dir " ; " packer))) 362 (concat "cd " dir " ; " packer)))
363 (progn 363 (progn
364 (call-process shell-file-name nil nil nil shell-command-switch 364 (call-process shell-file-name nil nil nil shell-command-switch
365 (concat "cd " dir " ; rm " files)) 365 (concat "cd " dir " ; rm " files))
366 (gnus-message 4 "Packing...done" packer)) 366 (gnus-message 4 "Packing...done" packer))
367 (error "Couldn't pack packet")))) 367 (error "Couldn't pack packet"))))
494 "Unpack PACKET into DIR using UNPACKER. 494 "Unpack PACKET into DIR using UNPACKER.
495 Return whether the unpacking was successful." 495 Return whether the unpacking was successful."
496 (gnus-make-directory dir) 496 (gnus-make-directory dir)
497 (gnus-message 4 "Unpacking: %s" (format unpacker packet)) 497 (gnus-message 4 "Unpacking: %s" (format unpacker packet))
498 (prog1 498 (prog1
499 (zerop (call-process 499 (eq 0 (call-process
500 shell-file-name nil nil nil shell-command-switch 500 shell-file-name nil nil nil shell-command-switch
501 (format "cd %s ; %s" (expand-file-name dir) 501 (format "cd %s ; %s" (expand-file-name dir)
502 (format unpacker packet)))) 502 (format unpacker packet))))
503 (gnus-message 4 "Unpacking...done"))) 503 (gnus-message 4 "Unpacking...done")))
504 504
505 (defun gnus-soup-send-packet (packet) 505 (defun gnus-soup-send-packet (packet)
506 (gnus-soup-unpack-packet 506 (gnus-soup-unpack-packet
507 gnus-soup-replies-directory gnus-soup-unpacker packet) 507 gnus-soup-replies-directory gnus-soup-unpacker packet)
538 end (+ (point) (string-to-int 538 end (+ (point) (string-to-int
539 (buffer-substring 539 (buffer-substring
540 (match-beginning 1) (match-end 1))))) 540 (match-beginning 1) (match-end 1)))))
541 (switch-to-buffer tmp-buf) 541 (switch-to-buffer tmp-buf)
542 (erase-buffer) 542 (erase-buffer)
543 (mm-disable-multibyte)
543 (insert-buffer-substring msg-buf beg end) 544 (insert-buffer-substring msg-buf beg end)
544 (goto-char (point-min))
545 (search-forward "\n\n")
546 (forward-char -1)
547 (insert mail-header-separator)
548 (setq message-newsreader (setq message-mailer
549 (gnus-extended-version)))
550 (cond 545 (cond
551 ((string= (gnus-soup-reply-kind (car replies)) "news") 546 ((string= (gnus-soup-reply-kind (car replies)) "news")
552 (gnus-message 5 "Sending news message to %s..." 547 (gnus-message 5 "Sending news message to %s..."
553 (mail-fetch-field "newsgroups")) 548 (mail-fetch-field "newsgroups"))
554 (sit-for 1) 549 (sit-for 1)
555 (let ((message-syntax-checks 550 (let ((message-syntax-checks
556 'dont-check-for-anything-just-trust-me)) 551 'dont-check-for-anything-just-trust-me)
557 (funcall message-send-news-function))) 552 (method (if (functionp message-post-method)
553 (funcall message-post-method)
554 message-post-method))
555 result)
556 (run-hooks 'message-send-news-hook)
557 (gnus-open-server method)
558 (message "Sending news via %s..."
559 (gnus-server-string method))
560 (unless (let ((mail-header-separator ""))
561 (gnus-request-post method))
562 (message "Couldn't send message via news: %s"
563 (nnheader-get-report (car method))))))
558 ((string= (gnus-soup-reply-kind (car replies)) "mail") 564 ((string= (gnus-soup-reply-kind (car replies)) "mail")
559 (gnus-message 5 "Sending mail to %s..." 565 (gnus-message 5 "Sending mail to %s..."
560 (mail-fetch-field "to")) 566 (mail-fetch-field "to"))
561 (sit-for 1) 567 (sit-for 1)
562 (message-send-mail)) 568 (let ((mail-header-separator ""))
569 (mm-with-unibyte-current-buffer
570 (funcall (or message-send-mail-real-function
571 message-send-mail-function)))))
563 (t 572 (t
564 (error "Unknown reply kind"))) 573 (error "Unknown reply kind")))
565 (set-buffer msg-buf) 574 (set-buffer msg-buf)
566 (goto-char end)) 575 (goto-char end))
567 (delete-file (buffer-file-name)) 576 (delete-file (buffer-file-name))