[Mew-dist 07761] mew-gus.el patch
SAKAI Kiyotaka
ksakai at example.com
1999年 2月 26日 (金) 17:37:50 JST
mew-gnus.el を最近の Mew の変更に追従させるためのパッチです。
コードをなるべく mew-summary-xxx に似せるようにしました。
ユーザーにとって目に見える変更点は mew-references-max-count への対応だ
けだと思います。
--
酒井 清隆 (E-mail: ksakai at example.com)
-------------- next part --------------
--- /home/ksakai/src/mew-1.94b9/contrib/mew-gnus.el Fri Feb 26 10:27:01 1999
+++ mew-gnus.el Fri Feb 26 17:25:52 1999
@@ -15,7 +15,7 @@
;; (add-hook
;; 'gnus-summary-mode-hook
;; (function
-;; (lambda ()
+;; (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)
@@ -24,7 +24,7 @@
;; (setq gnus-default-article-saver 'gnus-summary-save-in-mew)
;;
-(eval-when-compile
+(eval-when-compile
(require 'gnus)
(if (not (or (string-match "^GNUS [34]" gnus-version)
(string-match "^Gnus v5.0" gnus-version)
@@ -108,10 +108,9 @@
(switch-to-buffer (find-file-noselect file))
(mew-draft-rename file)
(mew-draft-header nil nil 'no nil "")
- (mew-draft-mode) ;; for hilight
- ))
- (goto-char (point-min))
- (search-forward "Newsgroups: "))
+ (goto-char (point-min))
+ (search-forward "Newsgroups: ")
+ (mew-draft-mode))))
(defun mew-gnus-reply (&optional yank)
"Reply or followup to GNUS article using mew.
@@ -119,12 +118,12 @@
(interactive)
(mew-gnus-init)
(let ((file (mew-folder-new-message mew-draft-folder))
- from cc subject date to reply-to newsgroups in-reply-to references
+ from cc subject to reply-to newsgroups in-reply-to references
distribution)
(mew-summary-prepare-draft
(mew-current-set 'window (current-window-configuration))
(delete-other-windows)
- (gnus-summary-display-article (gnus-summary-article-number) t) ;; redisplay
+ (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)
@@ -132,6 +131,7 @@
(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
@@ -142,51 +142,58 @@
cc (gnus-fetch-field "Cc")
newsgroups (or (gnus-fetch-field "Followup-To")
(gnus-fetch-field "Newsgroups"))
- date (gnus-fetch-field "Date")
- distribution (gnus-fetch-field "Distribution")
- in-reply-to (mew-header-get-value mew-message-id:)
- references (mew-header-get-value mew-references:))
- (if (and in-reply-to (string-match "<[^\t >]+>" in-reply-to))
- (setq in-reply-to (mew-match 0 in-reply-to))
- (setq in-reply-to nil))
- (if in-reply-to
- (let ((ref references)
- (refl nil))
- (if (null ref)
- (setq references in-reply-to)
- (while (string-match "<[^>]+>" ref)
- (setq refl (append refl (list (mew-match 0 ref))))
- (setq ref (substring ref (match-end 0))))
- (if (member in-reply-to refl)
- ()
- (setq references (car refl))
- (setq refl (append (cdr refl) (list in-reply-to)))
- (mapcar (lambda (i)
- (setq references (concat references "\n\t" i)))
- refl)))))
+ 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)
+ (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 references (or old-in-reply-to 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 tmp-ref
+ (nthcdr (- (length tmp-ref) mew-references-max-count)
+ tmp-ref)))
+ (setq references (mapconcat (lambda (x) x) tmp-ref "\n\t")))))
+
(switch-to-buffer-other-window (find-file-noselect file))
(mew-draft-rename file)
(mew-draft-header subject nil to cc newsgroups in-reply-to references)
- (cond
- ((eq mew-summary-reply-position 'body)
- (goto-char (mew-header-end))
- (forward-line))
- )
- (mew-draft-mode) ;; for hilight
- )
- (if (stringp distribution)
- (save-excursion
- (goto-char (point-min))
- (search-forward "Newsgroups:")
- (forward-line 1)
- (insert (concat "Distribution: " distribution "\n"))))
- (make-variable-buffer-local 'mew-message-citation-buffer)
- (setq mew-message-citation-buffer gnus-article-buffer))
- (undo-boundary)
- (if yank
- (progn
- (goto-char (point-max))
- (mew-draft-cite))))
+ (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)
+ (if yank
+ (progn
+ (goto-char (point-max))
+ (mew-draft-cite))))))
(defun mew-gnus-reply-with-citation ()
"Reply or followup to GNUS article using mew.
@@ -199,36 +206,41 @@
(interactive)
(mew-gnus-init)
(mew-current-set 'window (current-window-configuration))
- (pop-to-buffer (or (and (boundp 'gnus-original-article-buffer)
- gnus-original-article-buffer)
- gnus-article-buffer))
+ (gnus-summary-display-article (gnus-summary-article-number)) ;; redisplay
+ (pop-to-buffer gnus-article-buffer)
(let* ((subject (concat "[" gnus-newsgroup-name "] "
(or (gnus-fetch-field "subject") "")))
- (file (mew-folder-new-message mew-draft-folder))
- (mimefolder (mew-draft-to-mime file))
- (mimedir (mew-expand-folder mimefolder)))
- (if (null (file-directory-p mimedir))
- (mew-make-directory mimedir)
- (if (null (mew-directory-empty-p mimedir))
- (if (y-or-n-p (format "Mime folder %s is not empty. Delete it? "
- mimefolder))
- (progn
- (call-process "rm" nil nil nil "-rf" mimedir)
- (mew-make-directory mimedir)))))
+ (draft (mew-folder-new-message mew-draft-folder))
+ (dirname (file-name-nondirectory draft)))
(mew-summary-prepare-draft
- (write-region (point-min) (point-max)
- (mew-folder-new-message mimefolder))
+ (mew-gnus-buffer-copy draft
+ (or (and (boundp 'gnus-original-article-buffer)
+ gnus-original-article-buffer)
+ gnus-article-buffer))
(let ((split-window-keep-point t))
(split-window-vertically))
- (switch-to-buffer-other-window (find-file-noselect file))
- (mew-draft-rename file)
+ (switch-to-buffer-other-window (find-file-noselect draft))
+ (mew-draft-rename draft)
(mew-draft-header subject 'nl)
(mew-draft-mode)
- (setq mew-encode-syntax
- (mew-encode-syntax-initial-multi
- (file-name-nondirectory mimedir) 1))
+ (setq mew-encode-syntax (mew-encode-syntax-initial-multi dirname 1))
(save-excursion
- (mew-draft-prepare-attachments)))))
+ (mew-draft-prepare-attachments t)))))
+
+(defun mew-gnus-buffer-copy (draft buffer)
+ (let* ((mimefolder (mew-draft-to-mime draft))
+ (mimedir (mew-expand-folder mimefolder)))
+ (if (null (file-directory-p mimedir))
+ (mew-make-directory mimedir)
+ (if (null (mew-directory-empty-p mimedir))
+ (if (y-or-n-p (format "%s is not empty. Delete it? " mimefolder))
+ (progn
+ (mew-delete-directory-recursively mimedir)
+ (mew-make-directory mimedir)))))
+ (save-excursion
+ (set-buffer buffer)
+ (write-region (point-min) (point-max)
+ (mew-folder-new-message mimefolder)))))
(provide 'mew-gnus)
;;; mew-gnus.el ends here
Mew-dist メーリングリストの案内