[Mew-dist 16214] mew-gnus.el for Mew-1.95b102
SAKAI Kiyotaka
ksakai at example.com
2001年 2月 7日 (水) 11:45:00 JST
mew-gnus.el を Mew-1.95b102 用に修正しました。
ニュースでのリプライは Mew 本体の対応待ちですが、それ以外の、GNUS の
article を
・Mew の folder へ保存
・メールでの reply
・メールでの forward
の機能は使用可能です。
あと、mew-gnus.el をいじっているときに気が付いたのですが、添付ファイル
付きのメール送信、または C-cC-m で +queue に放り込んだ時に +attach の
中身が削除されずにそのまま残りますが、これは仕様でしょうか？
意図して行っているのでなければ、保存しておいても無駄だと思いますので、
削除した方がいいと思います。
--
酒井 清隆 (E-mail: ksakai at example.com)
-------------- next part --------------
;; mew-gnus.el
;;
;; Temporary solution to link Mew to Gnus.
;; This code will be obsolated because Mew supports USENET news soon.
;;
;; To use mew-gnus.el, put the following codes in your .emacs.
;;
;; (add-hook
;; 'gnus-group-mode-hook
;; (function
;; (lambda ()
;; (require 'mew-gnus)
;; (define-key gnus-group-mode-map "a" 'mew-gnus-post-news))))
;;
;; (add-hook
;; 'gnus-summary-mode-hook
;; (function
;; (lambda ()
;; (define-key gnus-summary-mode-map "a" 'mew-gnus-post-news)
;; (define-key gnus-summary-mode-map "r" 'mew-gnus-reply)
;; (define-key gnus-summary-mode-map "R" 'mew-gnus-reply-with-citation)
;; (define-key gnus-summary-mode-map "f" 'mew-gnus-mail-forward))))
;;
;; (setq gnus-default-article-saver 'gnus-summary-save-in-mew)
;;
(eval-when-compile
(require 'gnus)
(if (not (or (string-match "^GNUS [34]" gnus-version)
(string-match "^Gnus v5.0" gnus-version)
(string-match "^5.[0-3]" gnus-version-number)))
(require 'gnus-sum)))
(require 'mew)
(defvar mew-prog-store "/usr/local/lib/mh/rcvstore")
(defvar mew-prog-store-arg "%s")
;(defvar mew-prog-store "imstore")
;(defvar mew-prog-store-arg "--dst=%s")
(defvar mew-gnus-save-fixed-folder nil
"*If specified, always use it as a candidate to save article.")
(defvar mew-gnus-save-preserve-dot t
"*If nil, use hierarchical directory to save article.")
(defvar mew-gnus-save-news-folder nil
"*If non-nil, use news folder as a default candicate to save an article.")
(defun mew-gnus-newsgroup-name ()
(if mew-gnus-save-preserve-dot
gnus-newsgroup-name
(gnus-newsgroup-directory-form gnus-newsgroup-name)))
(defun gnus-summary-save-in-mew (&optional folder)
"Save this article to Mail or News folder using external storing program.
Optional argument FOLDER specifies folder name."
(interactive)
(mew-gnus-init)
(let ((gnus-show-mime nil)
(gnus-article-display-hook nil))
(gnus-summary-select-article t t)) ;; force to display all headers
(gnus-eval-in-buffer-window gnus-article-buffer
(save-restriction
(widen)
(or mew-folder-list
(let ((mail-dirs (mew-dir-list mew-mail-path))
(news-dirs (mew-dir-list mew-news-path)))
(setq mew-folder-list (mew-folder-make-list mail-dirs "+"))
(setq mew-folder-list (nconc mew-folder-list
(mew-folder-make-list news-dirs "=")))))
(or mew-folder-alist
(setq mew-folder-alist (mew-folder-make-alist mew-folder-list)))
(let ((folder
(or folder
(mew-input-folder
(or mew-gnus-save-fixed-folder
(car (mew-refile-guess-by-alist))
(concat (if mew-gnus-save-news-folder "=" "+")
(mew-gnus-newsgroup-name))))))
(errbuf (get-buffer-create " *GNUS store*")))
(if (not (memq (aref folder 0) '(?+ ?=)))
(message (format
"First letter of '%s' must be '+' or '='."
folder))
(if (mew-folder-check folder)
(unwind-protect
(mew-piolet
mew-cs-text-for-read
(cdr (assoc "iso-2022-jp" mew-cs-database-for-decoding))
(call-process-region (point-min) (point-max)
mew-prog-store nil errbuf nil
(format mew-prog-store-arg folder)))
(set-buffer errbuf)
(if (zerop (buffer-size))
(message "Article saved in folder: %s" folder)
(message "%s" (buffer-string)))
(kill-buffer errbuf))))))))
(defun mew-gnus-init ()
"Initialize mew if mew does not invoked yet."
(if mew-init-p
nil
(mew-init)
(if (get-buffer mew-buffer-hello)
(kill-buffer mew-buffer-hello))))
(defun mew-gnus-post-news ()
"Post a news using mew."
(interactive)
(mew-gnus-init)
(let ((draft (mew-folder-new-message mew-draft-folder)))
(mew-current-set-window-config)
(mew-window-configure 'draft)
(mew-summary-prepare-draft
(delete-other-windows)
(mew-draft-find-and-switch draft t)
(mew-delete-directory-recursively (mew-attachdir draft))
(mew-draft-header nil nil 'no nil "")
(goto-char (point-min))
(search-forward "Newsgroups: ")
(mew-draft-mode)
(run-hooks 'mew-draft-mode-newdraft-hook))))
(defun mew-gnus-reply (&optional yank)
"Reply or followup to GNUS article using mew.
Optional argument YANK means yank original article."
(interactive)
(mew-gnus-init)
(let ((draft (mew-folder-new-message mew-draft-folder))
from cc subject to reply-to newsgroups in-reply-to references
distribution)
(mew-current-set-window-config)
(mew-window-configure 'draft)
(mew-summary-prepare-draft
(delete-other-windows)
(gnus-summary-display-article (gnus-summary-article-number) t) ;;redisplay
(pop-to-buffer gnus-article-buffer)
(goto-char (point-max))
(push-mark (point) t t)
(goto-char (point-min))
(search-forward "\n\n" nil t)
(let ((split-window-keep-point t))
(split-window-vertically))
(setq from (mew-addrstr-parse-address-list (gnus-fetch-field "From"))
subject (let ((subject (gnus-fetch-field "Subject")))
(if (and subject
(not (string-match "^[Rr][Ee]:.+$" subject)))
(concat "Re: " subject) subject))
reply-to (gnus-fetch-field "Reply-to")
to (or reply-to from)
cc (gnus-fetch-field "Cc")
newsgroups (or (gnus-fetch-field "Followup-To")
(gnus-fetch-field "Newsgroups"))
distribution (gnus-fetch-field "Distribution"))
;; see comments at mew-summary-reply() function
(let ((old-message-id (gnus-fetch-field "Message-Id"))
(old-in-reply-to (gnus-fetch-field "In-Reply-To"))
(old-references (gnus-fetch-field "References"))
(regex "<[^>]+>")
(start 0) tmp-ref skip)
(if (and old-message-id (string-match regex old-message-id))
(setq old-message-id (mew-match 0 old-message-id))
(setq old-message-id nil))
(if (and old-in-reply-to (string-match regex old-in-reply-to))
(setq old-in-reply-to (mew-match 0 old-in-reply-to))
(setq old-in-reply-to nil))
(if (null old-message-id)
() ;; we don't care even if old-references exist.
(setq in-reply-to old-message-id)
(if (null old-references)
(setq tmp-ref (if old-in-reply-to
(list old-in-reply-to old-message-id)
(list old-message-id)))
(while (string-match "<[^>]+>" old-references start)
(setq start (match-end 0))
(setq tmp-ref (cons (mew-match 0 old-references) tmp-ref)))
(if (and old-in-reply-to (not (member old-in-reply-to tmp-ref)))
(setq tmp-ref (cons old-in-reply-to tmp-ref)))
(setq tmp-ref (nreverse (cons old-message-id tmp-ref))))
(if (integerp mew-references-max-count)
(setq skip (- (length tmp-ref) mew-references-max-count)))
(if (and (numberp skip) (> skip 0))
(setq tmp-ref (nthcdr skip tmp-ref)))
(setq references (mew-join "\n\t" tmp-ref))))
(mew-draft-find-and-switch draft t)
(mew-delete-directory-recursively (mew-attachdir draft))
(mew-draft-header subject nil to cc newsgroups in-reply-to references)
(if (stringp distribution)
(save-excursion
(goto-char (point-min))
(search-forward "Newsgroups:")
(forward-line 1)
(insert (concat "Distribution: " distribution "\n"))))
(if (eq mew-summary-reply-position 'body)
(progn
(goto-char (mew-header-end))
(forward-line)))
(make-variable-buffer-local 'mew-message-citation-buffer)
(setq mew-message-citation-buffer gnus-article-buffer)
(undo-boundary)
(mew-draft-mode)
(run-hooks 'mew-draft-mode-newdraft-hook)
(if yank
(progn
(goto-char (point-max))
(mew-draft-cite))))))
(defun mew-gnus-reply-with-citation ()
"Reply or followup to GNUS article using mew.
Original article is yanked automatically."
(interactive)
(mew-gnus-reply t))
(defun mew-gnus-mail-forward (&optional buffer)
"Forward the current message to another user using mew."
(interactive)
(mew-gnus-init)
(mew-current-set-window-config)
(mew-window-configure 'draft)
(gnus-summary-display-article (gnus-summary-article-number)) ;; redisplay
(sit-for 0)
(pop-to-buffer gnus-article-buffer)
(let* ((subject (concat "[" gnus-newsgroup-name "] "
(or (gnus-fetch-field "subject") "")))
(draft (mew-folder-new-message mew-draft-folder))
(dirname (file-name-nondirectory draft)))
(mew-summary-prepare-draft
(mew-summary-prepare-three-windows)
(mew-draft-find-and-switch draft t)
(mew-delete-directory-recursively (mew-attachdir draft))
(mew-gnus-buffer-copy draft
(or (and (boundp 'gnus-original-article-buffer)
gnus-original-article-buffer)
gnus-article-buffer))
(mew-draft-header subject 'nl)
(mew-draft-mode)
(run-hooks 'mew-draft-mode-newdraft-hook)
(setq mew-encode-syntax (mew-encode-syntax-initial-multi dirname 1))
(save-excursion
(mew-draft-prepare-attachments t)))))
(defun mew-gnus-buffer-copy (draft buffer)
(let* ((attach (mew-draft-to-attach draft))
(attachdir (mew-expand-folder attach)))
(if (not (file-directory-p attachdir))
(mew-make-directory attachdir))
(save-excursion
(set-buffer buffer)
(write-region (point-min) (point-max)
(mew-folder-new-message attach)))))
(provide 'mew-gnus)
;;; mew-gnus.el ends here
Mew-dist メーリングリストの案内