1 |
;;; gnus-soup.el --- SOUP packet writing support for Gnus |
;;; gnus-soup.el --- SOUP packet writing support for Gnus |
2 |
|
|
3 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Per Abrahamsen <abraham@iesd.auc.dk> |
;; Author: Per Abrahamsen <abraham@iesd.auc.dk> |
154 |
gnus-soup-encoding-type |
gnus-soup-encoding-type |
155 |
gnus-soup-index-type) |
gnus-soup-index-type) |
156 |
(gnus-soup-area-set-number |
(gnus-soup-area-set-number |
157 |
area (1+ (or (gnus-soup-area-number area) 0)))) |
area (1+ (or (gnus-soup-area-number area) 0))) |
158 |
;; Mark article as read. |
;; Mark article as read. |
159 |
(set-buffer gnus-summary-buffer) |
(set-buffer gnus-summary-buffer) |
160 |
|
(gnus-summary-mark-as-read (car articles) gnus-souped-mark)) |
161 |
(gnus-summary-remove-process-mark (car articles)) |
(gnus-summary-remove-process-mark (car articles)) |
|
(gnus-summary-mark-as-read (car articles) gnus-souped-mark) |
|
162 |
(setq articles (cdr articles))) |
(setq articles (cdr articles))) |
163 |
(kill-buffer tmp-buf)) |
(kill-buffer tmp-buf)) |
164 |
(gnus-soup-save-areas) |
(gnus-soup-save-areas) |
357 |
(gnus-make-directory dir) |
(gnus-make-directory dir) |
358 |
(setq gnus-soup-areas nil) |
(setq gnus-soup-areas nil) |
359 |
(gnus-message 4 "Packing %s..." packer) |
(gnus-message 4 "Packing %s..." packer) |
360 |
(if (zerop (call-process shell-file-name |
(if (eq 0 (call-process shell-file-name |
361 |
nil nil nil shell-command-switch |
nil nil nil shell-command-switch |
362 |
(concat "cd " dir " ; " packer))) |
(concat "cd " dir " ; " packer))) |
363 |
(progn |
(progn |
364 |
(call-process shell-file-name nil nil nil shell-command-switch |
(call-process shell-file-name nil nil nil shell-command-switch |
365 |
(concat "cd " dir " ; rm " files)) |
(concat "cd " dir " ; rm " files)) |
496 |
(gnus-make-directory dir) |
(gnus-make-directory dir) |
497 |
(gnus-message 4 "Unpacking: %s" (format unpacker packet)) |
(gnus-message 4 "Unpacking: %s" (format unpacker packet)) |
498 |
(prog1 |
(prog1 |
499 |
(zerop (call-process |
(eq 0 (call-process |
500 |
shell-file-name nil nil nil shell-command-switch |
shell-file-name nil nil nil shell-command-switch |
501 |
(format "cd %s ; %s" (expand-file-name dir) |
(format "cd %s ; %s" (expand-file-name dir) |
502 |
(format unpacker packet)))) |
(format unpacker packet)))) |
503 |
(gnus-message 4 "Unpacking...done"))) |
(gnus-message 4 "Unpacking...done"))) |
504 |
|
|
505 |
(defun gnus-soup-send-packet (packet) |
(defun gnus-soup-send-packet (packet) |
540 |
(match-beginning 1) (match-end 1))))) |
(match-beginning 1) (match-end 1))))) |
541 |
(switch-to-buffer tmp-buf) |
(switch-to-buffer tmp-buf) |
542 |
(erase-buffer) |
(erase-buffer) |
543 |
|
(mm-disable-multibyte) |
544 |
(insert-buffer-substring msg-buf beg end) |
(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))) |
|
545 |
(cond |
(cond |
546 |
((string= (gnus-soup-reply-kind (car replies)) "news") |
((string= (gnus-soup-reply-kind (car replies)) "news") |
547 |
(gnus-message 5 "Sending news message to %s..." |
(gnus-message 5 "Sending news message to %s..." |
548 |
(mail-fetch-field "newsgroups")) |
(mail-fetch-field "newsgroups")) |
549 |
(sit-for 1) |
(sit-for 1) |
550 |
(let ((message-syntax-checks |
(let ((message-syntax-checks |
551 |
'dont-check-for-anything-just-trust-me)) |
'dont-check-for-anything-just-trust-me) |
552 |
(funcall message-send-news-function))) |
(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)))))) |
564 |
((string= (gnus-soup-reply-kind (car replies)) "mail") |
((string= (gnus-soup-reply-kind (car replies)) "mail") |
565 |
(gnus-message 5 "Sending mail to %s..." |
(gnus-message 5 "Sending mail to %s..." |
566 |
(mail-fetch-field "to")) |
(mail-fetch-field "to")) |
567 |
(sit-for 1) |
(sit-for 1) |
568 |
(message-send-mail)) |
(let ((mail-header-separator "")) |
569 |
|
(mm-with-unibyte-current-buffer |
570 |
|
(funcall (or message-send-mail-real-function |
571 |
|
message-send-mail-function))))) |
572 |
(t |
(t |
573 |
(error "Unknown reply kind"))) |
(error "Unknown reply kind"))) |
574 |
(set-buffer msg-buf) |
(set-buffer msg-buf) |