X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-vm.el;h=a7f69347e8bba17b4c39c7508cd3eaf03995acff;hb=refs%2Ftags%2Fbefore-feeding-back-t-gnus-6_15-;hp=53b741f711c7e2a200a58921f68a27be5b62a552;hpb=a707b63af25b91cb730c12e65156ca364bf49a44;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index 53b741f..a7f6934 100644 --- a/lisp/gnus-vm.el +++ b/lisp/gnus-vm.el @@ -1,9 +1,8 @@ ;;; gnus-vm.el --- vm interface for Gnus - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 -;; Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. ;; Author: Per Persson +;; Katsumi Yamaoka ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -32,31 +31,23 @@ ;;; Code: -(require 'sendmail) -(require 'message) -(require 'gnus) -(require 'gnus-msg) +(eval-when-compile (require 'cl)) + +(require 'gnus-art) (eval-when-compile - (require 'cl) (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.") - -(unless gnus-vm-inhibit-window-system - (ignore-errors - (when window-system - (require 'win-vm)))) + (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*")) @@ -74,34 +65,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") - (require 'gnus-art) - (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)