view lisp/gnus-vm.el @ 23681:af0276da2059

(Vw32_pass_optional_keys_to_system): Variable removed. (Vw32_pass_lwindow_to_system): (Vw32_pass_rwindow_to_system): (Vw32_lwindow_modifier): (Vw32_rwindow_modifier): (Vw32_apps_modifier): (Vw32_enable_num_lock): (Vw32_enable_caps_lock): (Vw32_scroll_lock_modifier): New variables. (modifier_set): Return toggle state for Scroll Lock. (w32_key_to_modifier): New function. Returns chosen modifier bit for given key. (w32_get_modifiers): Returns modifier flags for non-keyboard input events. (construct_console_modifiers): Renamed from construct_modifiers; recognize Windows and Apps keys as modifiers. (w32_get_key_modifiers): New function. Returns modifier flags for keyboard input events. (map_keypad_keys): Make non-static. Use second arg as extended flag. (w32_grabbed_keys): New variable. (HOTKEY, HOTKEY_ID, HOTKEY_VK_CODE, HOTKEY_MODIFIERS): New macros. (register_hot_keys): (unregister_hot_keys): (lookup_vk_code): (w32_parse_hot_key): (Fw32_register_hot_key): (Fw32_unregister_hot_key): (Fw32_registered_hot_keys): (Fw32_reconstruct_hot_key): New functions to support hotkeys. (post_character_message): New function. (w32_msg_pump): Handle new messages for using hotkeys and changing keyboard layout/language. (w32_wnd_proc): Major rework of keyboard input handling: optionally recognize Windows keys and Apps key as modifiers; optionally treat NumLock, CapsLock and ScrollLock as function keys; let system translate keystrokes to characters to avoid system bugs relating to dead-key handling; preserve shift distinction for control characters; forward keyboard layout/language changes to lisp; detect and convert hot-key events to normal keystrokes. (syms_of_w32fns): Register new functions and variables. (w32_last_error): New function for use in debugging.

;;; gnus-vm.el --- vm interface for Gnus
;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.

;; Author: Per Persson <[e-mail]>
;; 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 <[e-mail]>
;; Some code stolen from: 
;;	Rick Sladkey <[e-mail]>

;;; 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
	(if window-system
	    (require 'win-vm))
      (error nil)))

(if (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)
  (let ((default-name
	  (funcall gnus-mail-save-name gnus-newsgroup-name
		   gnus-current-headers gnus-newsgroup-last-mail)))
    (setq folder
	  (cond ((eq folder 'default) default-name)
		(folder folder)
		(t (gnus-read-save-file-name 
		    "Save article in VM folder:" default-name))))
    (gnus-make-directory (file-name-directory folder))
    (set-buffer 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)))

(provide 'gnus-vm)

;;; gnus-vm.el ends here.