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