X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-vm.el;h=bbefaaca5f99ecbbe12eab373e92d7c0d0a11337;hp=ee32d743a6f734a0e695a0eeb6486b7c337e2d2f;hb=a629ef97108075cbae0b8b69b2dd1a4723a520c8;hpb=fa6dccfb0a8266821441e51b15cf1ad8d05b9a9f diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index ee32d743a..bbefaaca5 100644 --- a/lisp/gnus-vm.el +++ b/lisp/gnus-vm.el @@ -1,7 +1,7 @@ ;;; gnus-vm.el --- vm interface for Gnus -;; Copyright (C) 1994,95 Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98 Free Software Foundation, Inc. -;; Author: Per Persson +;; Author: Per Persson ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -17,19 +17,21 @@ ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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: +;; Major contributors: ;; Christian Limpach -;; Some code stolen from: +;; Some code stolen from: ;; Rick Sladkey ;;; Code: (require 'sendmail) +(require 'message) (require 'gnus) (require 'gnus-msg) @@ -46,12 +48,12 @@ Has to be set before gnus-vm is loaded.") (or gnus-vm-inhibit-window-system (condition-case nil - (if window-system - (require 'win-vm)) + (when window-system + (require 'win-vm)) (error nil))) -(if (not (featurep 'vm)) - (load "vm")) +(when (not (featurep 'vm)) + (load "vm")) (defun gnus-vm-make-folder (&optional buffer) (let ((article (or buffer (current-buffer))) @@ -70,10 +72,9 @@ Has to be set before gnus-vm is loaded.") ;; insert a newline, otherwise the last line gets lost (goto-char (point-max)) (insert "\n") - (let (vm-use-toolbar vm-use-menus) - (vm-mode)) + (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. @@ -86,177 +87,19 @@ save those articles instead." (defun gnus-summary-save-in-vm (&optional folder) (interactive) - (let ((default-name - (funcall gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-mail))) - (or folder - (setq folder - (read-file-name - (concat "Save article in VM folder: (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name))) - (setq folder - (expand-file-name folder - (and default-name - (file-name-directory default-name)))) - (gnus-make-directory (file-name-directory folder)) - (set-buffer gnus-article-buffer) + (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)))) - ;; Remember the directory name to save articles. - (setq gnus-newsgroup-last-mail folder))) - -(defun gnus-mail-forward-using-vm (&optional buffer) - "Forward the current message to another user using vm." - (let* ((gnus-buffer (or buffer (current-buffer))) - (subject (gnus-forward-make-subject gnus-buffer))) - (or (featurep 'win-vm) - (if gnus-use-full-window - (pop-to-buffer gnus-article-buffer) - (switch-to-buffer gnus-article-buffer))) - (gnus-copy-article-buffer) - (set-buffer gnus-article-copy) - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder)) - (vm-forward-message-hook - (append (symbol-value 'vm-forward-message-hook) - '((lambda () - (save-excursion - (mail-position-on-field "Subject") - (beginning-of-line) - (looking-at "^\\(Subject: \\).*$") - (replace-match (concat "\\1" subject)))))))) - (vm-forward-message) - (gnus-vm-init-reply-buffer gnus-buffer) - (run-hooks 'gnus-mail-hook) (kill-buffer vm-folder)))))) -(defun gnus-vm-init-reply-buffer (buffer) - (make-local-variable 'gnus-summary-buffer) - (setq gnus-summary-buffer buffer) - (set 'vm-mail-buffer nil) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-y" 'gnus-yank-article)) - -(defun gnus-mail-reply-using-vm (&optional yank) - "Compose reply mail using vm. -Optional argument YANK means yank original article. -The command \\[vm-yank-message] yank the original message into current buffer." - (let ((gnus-buffer (current-buffer))) - (gnus-copy-article-buffer) - (set-buffer gnus-article-copy) - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder gnus-article-copy))) - (vm-reply 1) - (gnus-vm-init-reply-buffer gnus-buffer) - (setq gnus-buffer (current-buffer)) - (and yank - ;; nil will (magically :-)) yank the current article - (gnus-yank-article nil)) - (kill-buffer vm-folder)))) - (if (featurep 'win-vm) nil - (pop-to-buffer gnus-buffer)) - (run-hooks 'gnus-mail-hook))) - -(defun gnus-mail-other-window-using-vm () - "Compose mail in the other window using VM." - (interactive) - (let ((gnus-buffer (current-buffer))) - (vm-mail) - (gnus-vm-init-reply-buffer gnus-buffer)) - (run-hooks 'gnus-mail-hook)) - -(defun gnus-yank-article (article &optional prefix) - ;; Based on vm-yank-message by Kyle Jones. - "Yank article number N into the current buffer at point. -When called interactively N is read from the minibuffer. - -This command is meant to be used in GNUS created Mail mode buffers; -the yanked article comes from the newsgroup containing the article -you are replying to or forwarding. - -All article headers are yanked along with the text. Point is left -before the inserted text, the mark after. Any hook functions bound to -`mail-citation-hook' are run, after inserting the text and setting -point and mark. - -Prefix arg means to ignore `mail-citation-hook', don't set the mark, -prepend the value of `vm-included-text-prefix' to every yanked line. -For backwards compatibility, if `mail-citation-hook' is set to nil, -`mail-yank-hooks' is run instead. If that is also nil, a default -action is taken." - (interactive - (list - (let ((result 0) - default prompt) - (setq default (and gnus-summary-buffer - (save-excursion - (set-buffer gnus-summary-buffer) - (and gnus-current-article - (int-to-string gnus-current-article)))) - prompt (if default - (format "Yank article number: (default %s) " default) - "Yank article number: ")) - (while (and (not (stringp result)) (zerop result)) - (setq result (read-string prompt)) - (and (string= result "") default (setq result default)) - (or (string-match "^<.*>$" result) - (setq result (string-to-int result)))) - result) - current-prefix-arg)) - (if gnus-summary-buffer - (save-excursion - (let ((message (current-buffer)) - (start (point)) end - (tmp (generate-new-buffer " *tmp-yank*"))) - (set-buffer gnus-summary-buffer) - ;; Make sure the connection to the server is alive. - (or (gnus-server-opened (gnus-find-method-for-group - gnus-newsgroup-name)) - (progn - (gnus-check-server - (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-request-group gnus-newsgroup-name t))) - (and (stringp article) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article))) - (gnus-request-article (or article - gnus-current-article) - gnus-newsgroup-name tmp) - (set-buffer tmp) - (run-hooks 'gnus-article-prepare-hook) - ;; Decode MIME message. - (if (and gnus-show-mime - (gnus-fetch-field "Mime-Version")) - (funcall gnus-show-mime-method)) - ;; Perform the article display hooks. - (let ((buffer-read-only nil)) - (run-hooks 'gnus-article-display-hook)) - (append-to-buffer message (point-min) (point-max)) - (kill-buffer tmp) - (set-buffer message) - (setq end (point)) - (goto-char start) - (if (or prefix - (not (or mail-citation-hook mail-yank-hooks))) - (save-excursion - (while (< (point) end) - (insert (symbol-value 'vm-included-text-prefix)) - (forward-line 1))) - (push-mark end) - (cond - (mail-citation-hook (run-hooks 'mail-citation-hook)) - (mail-yank-hooks (run-hooks 'mail-yank-hooks)))))))) - (provide 'gnus-vm) ;;; gnus-vm.el ends here.