X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-mh.el;h=7df4b466292dbf552c2958d0737ae4cc8684a950;hb=daae30b5b3e1592f628dd74543820de9282cac3a;hp=9281019117b1276358c30db3c8403fc130aaffba;hpb=1f1262fa36e6242e098aa77199628058523195d4;p=gnus diff --git a/lisp/gnus-mh.el b/lisp/gnus-mh.el index 928101911..7df4b4662 100644 --- a/lisp/gnus-mh.el +++ b/lisp/gnus-mh.el @@ -1,16 +1,18 @@ -;;; gnus-mh: mh-e interface for Gnus -;; Copyright (C) 1994,95 Free Software Foundation, Inc. +;;; gnus-mh.el --- mh-e interface for Gnus + +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen +;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -18,8 +20,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -32,9 +33,24 @@ ;;; Code: +(require 'gnus) (require 'mh-e) (require 'mh-comp) -(require 'gnus) +(require 'gnus-msg) +(require 'gnus-sum) + +(defvar mh-lib-progs) + +(defun gnus-summary-save-article-folder (&optional arg) + "Append the current article to an mh folder. +If N is a positive number, save the N next articles. +If N is a negative number, save the N previous articles. +If N is nil and any articles have been marked with the process mark, +save those articles instead." + (interactive "P") + (require 'gnus-art) + (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) + (gnus-summary-save-article arg))) (defun gnus-summary-save-in-folder (&optional folder) "Save this article to MH folder (using `rcvstore' in MH library). @@ -42,113 +58,35 @@ Optional argument FOLDER specifies folder name." ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. (mh-find-path) (let ((folder - (or folder - (mh-prompt-for-folder - "Save article in" - (funcall gnus-folder-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-folder) - t))) - (errbuf (get-buffer-create " *Gnus rcvstore*"))) - (gnus-eval-in-buffer-window - gnus-article-buffer - (save-restriction - (widen) - (unwind-protect - (call-process-region (point-min) (point-max) - (expand-file-name "rcvstore" mh-lib) - nil errbuf nil folder) - (set-buffer errbuf) - (if (zerop (buffer-size)) - (message "Article saved in folder: %s" folder) - (message "%s" (buffer-string))) - (kill-buffer errbuf)))) + (cond ((and (eq folder 'default) + gnus-newsgroup-last-folder) + gnus-newsgroup-last-folder) + (folder folder) + (t (mh-prompt-for-folder + "Save article in" + (funcall gnus-folder-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-folder) + t)))) + (errbuf (gnus-get-buffer-create " *Gnus rcvstore*")) + ;; Find the rcvstore program. + (exec-path (cond + ((and (boundp 'mh-lib-progs) mh-lib-progs) + (cons mh-lib-progs exec-path)) + (mh-lib (cons mh-lib exec-path)) + (t exec-path)))) + (with-current-buffer gnus-original-article-buffer + (save-restriction + (widen) + (unwind-protect + (call-process-region + (point-min) (point-max) "rcvstore" nil errbuf nil folder) + (set-buffer errbuf) + (if (zerop (buffer-size)) + (message "Article saved in folder: %s" folder) + (message "%s" (buffer-string))) + (kill-buffer errbuf)))) (setq gnus-newsgroup-last-folder folder))) -(defun gnus-mail-reply-using-mhe (&optional yank) - "Compose reply mail using mh-e. -Optional argument YANK means yank original article. -The command \\[mh-yank-cur-msg] yank the original message into current buffer." - ;; First of all, prepare mhe mail buffer. - ;; Bug fix by Timo METZEMAKERS . - (pop-to-buffer gnus-article-buffer) - (let (from cc subject date to reply-to (buffer (current-buffer))) - (save-restriction - (gnus-article-show-all-headers) ;I don't think this is really needed. - (setq from (gnus-fetch-field "from") - subject (let ((subject (or (gnus-fetch-field "subject") - "(None)"))) - (if (and subject - (not (string-match "^[Rr][Ee]:.+$" subject))) - (concat "Re: " subject) subject)) - reply-to (gnus-fetch-field "reply-to") - cc (gnus-fetch-field "cc") - date (gnus-fetch-field "date")) - (setq mh-show-buffer buffer) - (setq to (or reply-to from)) - (mh-find-path) - (mh-send to (or cc "") subject) - (save-excursion - (mh-insert-fields - "In-reply-to:" - (concat - (substring from 0 (string-match " *at \\| *@ \\| *(\\| *<" from)) - "'s message of " date))) - (setq mh-sent-from-folder buffer) - (setq mh-sent-from-msg 1) - )) - ;; Then, yank original article if requested. - (if yank - (let ((last (point))) - (mh-yank-cur-msg) - (goto-char last) - ))) - -;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh -;; - -(defun gnus-mail-forward-using-mhe () - "Forward the current message to another user using mh-e." - ;; First of all, prepare mhe mail buffer. - (let ((to (read-string "To: ")) - (cc (read-string "Cc: ")) - (buffer (current-buffer)) - subject beg) - ;;(gnus-article-show-all-headers) - (setq subject - (concat "[" gnus-newsgroup-name "] " - ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " - (or (gnus-fetch-field "subject") ""))) - (setq mh-show-buffer buffer) - (mh-find-path) - (mh-send to (or cc "") subject) - (save-excursion - (goto-char (point-max)) - (setq beg (point)) - (insert "\n------- Forwarded Message\n\n") - (insert-buffer buffer) - (goto-char (point-max)) - (insert "\n------- End of Forwarded Message\n") - (goto-char beg) - (while (setq beg (next-single-property-change (point) 'invisible)) - (goto-char beg) - (delete-region beg (or (next-single-property-change - (point) 'invisible) - (point-max)))) - (setq mh-sent-from-folder buffer) - (setq mh-sent-from-msg 1)))) - -(defun gnus-mail-other-window-using-mhe () - "Compose mail other window using mh-e." - (let ((to (read-string "To: ")) - (cc (read-string "Cc: ")) - (subject (read-string "Subject: "))) - (gnus-article-show-all-headers) ;I don't think this is really needed. - (setq mh-show-buffer (current-buffer)) - (mh-find-path) - (mh-send-other-window to cc subject) - (setq mh-sent-from-folder (current-buffer)) - (setq mh-sent-from-msg 1))) - (defun gnus-Folder-save-name (newsgroup headers &optional last-folder) "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. If variable `gnus-use-long-file-name' is nil, it is +News.group. @@ -169,4 +107,6 @@ Otherwise, it is like +news/group." newsgroup (gnus-newsgroup-directory-form newsgroup))))) +(provide 'gnus-mh) + ;;; gnus-mh.el ends here