diff options
Diffstat (limited to 'lisp/gnus/gnus-vm.el')
-rw-r--r-- | lisp/gnus/gnus-vm.el | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el new file mode 100644 index 00000000000..8e83dbea95a --- /dev/null +++ b/lisp/gnus/gnus-vm.el @@ -0,0 +1,107 @@ +;;; gnus-vm.el --- vm interface for Gnus +;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc. + +;; Author: Per Persson <pp@gnu.ai.mit.edu> +;; Keywords: news, mail + +;; This file is part of GNU Emacs. + +;; 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. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Major contributors: +;; Christian Limpach <Christian.Limpach@nice.ch> +;; Some code stolen from: +;; Rick Sladkey <jrs@world.std.com> + +;;; Code: + +(require 'sendmail) +(require 'message) +(require 'gnus) +(require 'gnus-msg) + +(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))) + +(when (not (featurep 'vm)) + (load "vm")) + +(defun gnus-vm-make-folder (&optional buffer) + (let ((article (or buffer (current-buffer))) + (tmp-folder (generate-new-buffer " *tmp-folder*")) + (start (point-min)) + (end (point-max))) + (set-buffer tmp-folder) + (insert-buffer-substring article start end) + (goto-char (point-min)) + (if (looking-at "^\\(From [^ ]+ \\).*$") + (replace-match (concat "\\1" (current-time-string))) + (insert "From " gnus-newsgroup-name " " + (current-time-string) "\n")) + (while (re-search-forward "\n\nFrom " nil t) + (replace-match "\n\n>From ")) + ;; insert a newline, otherwise the last line gets lost + (goto-char (point-max)) + (insert "\n") + (vm-mode) + tmp-folder)) + +(defun gnus-summary-save-article-vm (&optional arg) + "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))) + +(defun gnus-summary-save-in-vm (&optional folder) + (interactive) + (setq folder + (cond ((eq folder 'default) default-name) + (folder folder) + (t (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)))))) + +(provide 'gnus-vm) + +;;; gnus-vm.el ends here. |