--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hyperbole/hmouse-mod.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,148 @@
+;;!emacs
+;;
+;; FILE:         hmouse-mod.el
+;; SUMMARY:      Action Key acts as CONTROL modifier and Assist Key as META modifier.
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     hypermedia, mouse
+;;
+;; AUTHOR:       Bob Weiner
+;; ORG:          Motorola, Inc., PPG
+;;
+;; ORIG-DATE:     8-Oct-92 at 19:08:31
+;; LAST-MOD:     14-Apr-95 at 16:06:26 by Bob Weiner
+;;
+;; This file is part of Hyperbole.
+;; Available for use and distribution under the same terms as GNU Emacs.
+;;
+;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
+;; Developed with support from Motorola Inc.
+;;
+;; DESCRIPTION:  
+;;
+;;   This module is meant to be used with a chord keyboard in one hand for
+;;   typing and a mouse in the other.  It requires that Hyperbole be loaded
+;;   in order to work.  Hyperbole defines two Smart Keys, the Action Key and
+;;   the Assist Key, on the middle and right buttons by default.
+;;
+;;   If the Action Key is held down while alpha characters are typed,
+;;   they are translated into Control keys instead.  The Assist
+;;   Key translates them into Meta keys.  When both Smart Keys
+;;   are depressed, Control-Meta keys are produced.  The commands bound
+;;   to the characters produced are then run.
+;;
+;;   So the Smart Keys modify the keys typed, e.g. Action Key + {a}
+;;   runs the function for {C-a}.
+;;
+;;   If no keys are typed while the Smart Keys are down, they operate as
+;;   normally under Hyperbole.
+;;
+;;   TO INVOKE:
+;;
+;;       (hmouse-mod-set-global-map)
+;;
+;; DESCRIP-END.
+
+;;; ************************************************************************
+;;; Other required Elisp libraries
+;;; ************************************************************************
+
+(require 'hyperbole)
+
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defvar hmouse-mod-global-map nil
+  "Global key map installed by hmouse-mod-set-global-map function.
+Translates self-insert-command characters into control and meta characters if
+the Action or Assist Keys are depressed at the time of key press.")
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+(defun hmouse-mod-insert-command (count)
+  "Surrogate function for self-insert-command.  Accounts for modifier Smart Keys."
+  (interactive "p")
+  (if (and (boundp 'action-key-depressed-flag)
+	   (boundp 'assist-key-depressed-flag))
+      (cond ((and action-key-depressed-flag assist-key-depressed-flag)
+	     (setq action-key-cancelled t
+		   assist-key-cancelled t)
+	     (let* ((c (downcase last-command-char))
+		    (key (char-to-string (+ 128 (% (- c ?\`) 128)))))
+	       (if (and (or (= c ?\C-@)
+			    (>= c ?a) (<= c ?z)))
+		   (hmouse-mod-execute-command key)
+		 (beep)))
+	     )
+	    ;; Control keys
+	    (action-key-depressed-flag
+	      (setq action-key-cancelled t)
+	      (let ((c (downcase last-command-char)))
+		(if (and (or (= c ?\C-@)
+			     (>= c ?a) (<= c ?z)))
+		    (hmouse-mod-execute-command
+		      (char-to-string (- c ?\`)))
+		  (beep)))
+	      )
+	    ;; Meta keys
+	    (assist-key-depressed-flag
+	      (setq assist-key-cancelled t)
+	      (hmouse-mod-execute-command
+		(char-to-string (+ 128 (% last-command-char 128))))
+	      )
+	    (t (call-interactively 'self-insert-command)))
+    (call-interactively 'self-insert-command))
+  )
+
+(defun hmouse-mod-keyboard-quit ()
+  "Surrogate function for keyboard-quit.  Cancels any hmouse-mod-prefix."
+  (interactive)
+  (setq hmouse-mod-prefix nil)
+  (keyboard-quit))
+
+(defun hmouse-mod-set-global-map ()
+  "Creates 'hmouse-mod-global-map' and installs as current global map.
+It accounts for modifier Smart Keys."
+  (interactive)
+  (setq hmouse-mod-global-map (copy-keymap global-map))
+  (substitute-key-definition
+    'self-insert-command 'hmouse-mod-insert-command hmouse-mod-global-map)
+  (substitute-key-definition
+    'keyboard-quit 'hmouse-mod-keyboard-quit hmouse-mod-global-map)
+  (use-global-map hmouse-mod-global-map))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(defun hmouse-mod-execute-command (key)
+  "Executes command associated with keyboard KEY or if KEY prefix, records it."
+  (setq key (concat hmouse-mod-prefix key))
+  (let ((binding (key-binding key)))
+    (cond ((and (not (or (vectorp binding) (stringp binding)))
+		(commandp binding))
+	   (if (> (length key) 1)
+	       (or noninteractive (message (key-description key))))
+	   (setq hmouse-mod-prefix nil)
+	   (call-interactively binding))
+	  ((symbolp binding)
+	   (setq hmouse-mod-prefix nil)
+	   (error "(hmouse-mod-execute-command): {%s} not bound to a command."
+		  (key-description key)))
+	  ((integerp binding)
+	   (setq hmouse-mod-prefix nil)
+	   (error "(hmouse-mod-execute-command): {%s} invalid key sequence."
+		  (key-description key)))
+	  (t (or noninteractive (message (key-description key)))
+	     (setq hmouse-mod-prefix key)))))
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defvar hmouse-mod-prefix nil
+  "Prefix key part of current key sequence.")
+
+(provide 'hmouse-mod)