Mercurial > emacs
comparison lisp/gnus/gnus-soup.el @ 82951:0fde48feb604
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)) |