X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-mh.el;h=f01811b1ac639d75ef39f0534e010898c65aa996;hp=77e5b35d4ca6c52883f6f68b26f819df9884bd21;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=82921b6ccad224823d8f4c69ba1cbbb18c3bf34e diff --git a/lisp/gnus-mh.el b/lisp/gnus-mh.el index 77e5b35d4..f01811b1a 100644 --- a/lisp/gnus-mh.el +++ b/lisp/gnus-mh.el @@ -1,16 +1,17 @@ ;;; gnus-mh.el --- mh-e interface for Gnus -;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. + +;; Copyright (C) 1994-2016 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 +19,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,11 +32,13 @@ ;;; Code: +(require 'gnus) (require 'mh-e) (require 'mh-comp) -(require 'gnus) (require 'gnus-msg) -(eval-when-compile (require 'cl)) +(require 'gnus-sum) + +(defvar mh-lib-progs) (defun gnus-summary-save-article-folder (&optional arg) "Append the current article to an mh folder. @@ -45,6 +47,7 @@ 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))) @@ -58,75 +61,31 @@ Optional argument FOLDER specifies folder name." gnus-newsgroup-last-folder) gnus-newsgroup-last-folder) (folder folder) - (t (mh-prompt-for-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 (get-buffer-create " *Gnus rcvstore*")) + (errbuf (gnus-get-buffer-create " *Gnus rcvstore*")) ;; Find the rcvstore program. - (exec-path (if mh-lib (cons mh-lib exec-path) exec-path))) - (gnus-eval-in-buffer-window - 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)))) + (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-mh-mail-setup (to subject in-reply-to cc replybuffer actions) - (let ((config (current-window-configuration))) - (mh-find-path) - (mh-send-sub (or to "") (or cc "") (or subject "") config) - (when in-reply-to - (save-excursion - (goto-char (point-min)) - (insert "In-Reply-To: " in-reply-to "\n"))) - (setq mh-sent-from-folder gnus-original-article-buffer) - (setq mh-sent-from-msg 1) - (setq gnus-mail-buffer (buffer-name (current-buffer))) - (setq mail-reply-buffer replybuffer) - (save-excursion - (set-buffer mh-sent-from-folder) - (setq mh-show-buffer replybuffer) - ) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-mh-mail-send-and-exit) - (setq mh-show-buffer gnus-article-copy) - (setq mh-previous-window-config config))) - -(defun gnus-mh-mail-send-and-exit (&optional dont-send) - "Send the current mail and return to Gnus." - (interactive) - (let* ((reply gnus-article-reply) - (winconf gnus-prev-winconf) - (address-group gnus-add-to-address) - (to-address (and address-group - (mail-fetch-field "to")))) - (setq gnus-add-to-address nil) - (or dont-send (mh-send-letter)) - (bury-buffer) - ;; This mail group doesn't have a `to-address', so we add one - ;; here. Magic! - (and to-address - (gnus-group-add-parameter - address-group (cons 'to-address to-address))) - (if (get-buffer gnus-group-buffer) - (progn - (if (gnus-buffer-exists-p (car-safe reply)) - (progn - (set-buffer (car reply)) - (and (cdr reply) - (gnus-summary-mark-article-as-replied - (cdr reply))))) - (and winconf (set-window-configuration winconf)))))) - (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. @@ -147,4 +106,6 @@ Otherwise, it is like +news/group." newsgroup (gnus-newsgroup-directory-form newsgroup))))) +(provide 'gnus-mh) + ;;; gnus-mh.el ends here