1;;; gnus-vm.el --- vm interface for Gnus 2 3;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 4;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Per Persson <pp@gnu.ai.mit.edu> 7;; Keywords: news, mail 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; Major contributors: 29;; Christian Limpach <Christian.Limpach@nice.ch> 30;; Some code stolen from: 31;; Rick Sladkey <jrs@world.std.com> 32 33;;; Code: 34 35(require 'sendmail) 36(require 'message) 37(require 'gnus) 38(require 'gnus-msg) 39 40(eval-when-compile 41 (require 'cl) 42 (autoload 'vm-mode "vm") 43 (autoload 'vm-save-message "vm") 44 (autoload 'vm-forward-message "vm") 45 (autoload 'vm-reply "vm") 46 (autoload 'vm-mail "vm")) 47 48(defvar gnus-vm-inhibit-window-system nil 49 "Inhibit loading `win-vm' if using a window-system. 50Has to be set before gnus-vm is loaded.") 51 52(unless gnus-vm-inhibit-window-system 53 (ignore-errors 54 (when window-system 55 (require 'win-vm)))) 56 57(when (not (featurep 'vm)) 58 (load "vm")) 59 60(defun gnus-vm-make-folder (&optional buffer) 61 (let ((article (or buffer (current-buffer))) 62 (tmp-folder (generate-new-buffer " *tmp-folder*")) 63 (start (point-min)) 64 (end (point-max))) 65 (set-buffer tmp-folder) 66 (insert-buffer-substring article start end) 67 (goto-char (point-min)) 68 (if (looking-at "^\\(From [^ ]+ \\).*$") 69 (replace-match (concat "\\1" (current-time-string))) 70 (insert "From " gnus-newsgroup-name " " 71 (current-time-string) "\n")) 72 (while (re-search-forward "\n\nFrom " nil t) 73 (replace-match "\n\n>From ")) 74 ;; insert a newline, otherwise the last line gets lost 75 (goto-char (point-max)) 76 (insert "\n") 77 (vm-mode) 78 tmp-folder)) 79 80(defun gnus-summary-save-article-vm (&optional arg) 81 "Append the current article to a vm folder. 82If N is a positive number, save the N next articles. 83If N is a negative number, save the N previous articles. 84If N is nil and any articles have been marked with the process mark, 85save those articles instead." 86 (interactive "P") 87 (require 'gnus-art) 88 (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) 89 (gnus-summary-save-article arg))) 90 91(defun gnus-summary-save-in-vm (&optional folder) 92 (interactive) 93 (setq folder 94 (gnus-read-save-file-name 95 "Save %s in VM folder:" folder 96 gnus-mail-save-name gnus-newsgroup-name 97 gnus-current-headers 'gnus-newsgroup-last-mail)) 98 (gnus-eval-in-buffer-window gnus-original-article-buffer 99 (save-excursion 100 (save-restriction 101 (widen) 102 (let ((vm-folder (gnus-vm-make-folder))) 103 (vm-save-message folder) 104 (kill-buffer vm-folder)))))) 105 106(provide 'gnus-vm) 107 108;;; arch-tag: 42ca7f88-a12f-461d-be3e-cac7efb44866 109;;; gnus-vm.el ends here 110