X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-vm.el;h=e0bf16efa5a0a5f9d5004b7e02f4ff8e78b584ce;hb=ff13fdd54974932dc7d1baebee0c572febcff1b6;hp=6fe4b26445a16e7cd4490131ba43f64f7d51204e;hpb=82300762c3419b73fc2e994b14e3d520fe88b0a9;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index 6fe4b26..e0bf16e 100644 --- a/lisp/gnus-vm.el +++ b/lisp/gnus-vm.el @@ -1,7 +1,10 @@ ;;; gnus-vm.el --- vm interface for Gnus -;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Per Persson +;; Katsumi Yamaoka ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -30,31 +33,23 @@ ;;; Code: -(require 'sendmail) -(require 'message) -(require 'gnus) -(require 'gnus-msg) +(eval-when-compile (require 'cl)) + +(require 'gnus-art) (eval-when-compile (autoload 'vm-mode "vm") - (autoload 'vm-save-message "vm") - (autoload 'vm-forward-message "vm") - (autoload 'vm-reply "vm") - (autoload 'vm-mail "vm")) - -(defvar gnus-vm-inhibit-window-system nil - "Inhibit loading `win-vm' if using a window-system. -Has to be set before gnus-vm is loaded.") - -(or gnus-vm-inhibit-window-system - (condition-case nil - (when window-system - (require 'win-vm)) - (error nil))) + (autoload 'vm-read-file-name "vm") + (autoload 'vm-save-message "vm")) (when (not (featurep 'vm)) (load "vm")) +(defvar vm-folder-directory) +(defvar vm-folder-history) +(defvar vm-primary-inbox) +(defvar vm-use-toolbar) + (defun gnus-vm-make-folder (&optional buffer) (let ((article (or buffer (current-buffer))) (tmp-folder (generate-new-buffer " *tmp-folder*")) @@ -72,33 +67,100 @@ Has to be set before gnus-vm is loaded.") ;; insert a newline, otherwise the last line gets lost (goto-char (point-max)) (insert "\n") - (vm-mode) + (let (mime-display-header-hook + mime-display-text/plain-hook mime-text-decode-hook + mime-view-define-keymap-hook mime-view-mode-hook) + (vm-mode)) tmp-folder)) -(defun gnus-summary-save-article-vm (&optional arg) +(defvar gnus-summary-save-article-vm-folder nil) +(defvar gnus-summary-save-article-vm-count nil) + +(defun gnus-summary-save-article-vm (&optional arg folder) "Append the current article to a vm 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") - (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) - (gnus-summary-save-article arg))) + (interactive + (let ((prefix-arg current-prefix-arg) + articles marks default-folder) + (setq default-folder (or (car vm-folder-history) vm-primary-inbox)) + (if (numberp prefix-arg) + (setq articles prefix-arg) + (setq marks (delq nil (gnus-summary-work-articles nil)) + articles (length marks))) + (list + prefix-arg + (unless (zerop articles) + (vm-read-file-name + (format + "Save %s in VM folder: " + (cond ((eq 1 articles) + (if (or (not marks) (eq gnus-current-article (car marks))) + "this article" + "the marked article")) + ((< 0 articles) + (if marks + (format "the marked %d articles" articles) + (format "the %d next articles" articles))) + ((> 0 articles) + (format "the %d previous articles" (- articles))))) + (if default-folder "" vm-folder-directory) + nil nil default-folder 'vm-folder-history))))) + (if (interactive-p) + (unless folder + (error "No articles to be saved")) + (unless (setq folder (or folder gnus-summary-save-article-vm-folder)) + (error "No VM folder is specified"))) + (unwind-protect + (progn + (setq gnus-summary-save-article-vm-folder folder + gnus-summary-save-article-vm-count 0) + (let ((gnus-default-article-saver 'gnus-summary-save-in-vm) + mime-display-header-hook mime-display-text/plain-hook + mime-text-decode-hook mime-view-define-keymap-hook + mime-view-mode-hook) + (gnus-summary-save-article arg)) + (cond ((eq 1 gnus-summary-save-article-vm-count) + (message "One article is saved in %s" folder)) + ((< 0 gnus-summary-save-article-vm-count) + (message "%d articles are saved in %s" + gnus-summary-save-article-vm-count folder)) + (t + (message "Maybe no articles are saved in %s" folder)))) + (setq gnus-summary-save-article-vm-folder nil + gnus-summary-save-article-vm-count nil))) (defun gnus-summary-save-in-vm (&optional folder) - (interactive) - (setq folder - (gnus-read-save-file-name - "Save %s in VM folder:" folder - gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-mail)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder))) - (vm-save-message folder) - (kill-buffer vm-folder)))))) + (interactive + (let (default-folder) + (setq default-folder (or (car vm-folder-history) vm-primary-inbox)) + (list (vm-read-file-name "Save this article in VM folder: " + (if default-folder "" vm-folder-directory) + nil nil default-folder 'vm-folder-history)))) + (unless (interactive-p) + (setq folder (or folder gnus-summary-save-article-vm-folder))) + (unless folder + (error "No VM folder is specified")) + (unless (interactive-p) + (message "Saving the article %d in %s..." gnus-current-article folder) + (when (numberp gnus-summary-save-article-vm-count) + (incf gnus-summary-save-article-vm-count))) + (save-window-excursion + (apply 'gnus-summary-select-article gnus-show-all-headers + (unless (interactive-p) + (list nil nil gnus-current-article))) + (gnus-eval-in-buffer-window gnus-original-article-buffer + (save-excursion + (save-restriction + (widen) + (let* ((vm-use-toolbar nil) + (vm-folder (gnus-vm-make-folder))) + (vm-save-message folder) + (when (interactive-p) + (message "This article is saved in %s" folder)) + (kill-buffer vm-folder))))))) (provide 'gnus-vm)