cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hmouse-mod.el

   1 ;;; hmouse-mod.el --- Action Key acts as CONTROL modifier and Assist Key as META modifier.
   2
   3 ;; Copyright (C) 1992-1995 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia, mouse
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;   This module is meant to be used with a chord keyboard in one hand for
  30 ;;   typing and a mouse in the other.  It requires that Hyperbole be loaded
  31 ;;   in order to work.  Hyperbole defines two Smart Keys, the Action Key and
  32 ;;   the Assist Key, on the middle and right buttons by default.
  33 ;;
  34 ;;   If the Action Key is held down while alpha characters are typed,
  35 ;;   they are translated into Control keys instead.  The Assist
  36 ;;   Key translates them into Meta keys.  When both Smart Keys
  37 ;;   are depressed, Control-Meta keys are produced.  The commands bound
  38 ;;   to the characters produced are then run.
  39 ;;
  40 ;;   So the Smart Keys modify the keys typed, e.g. Action Key + {a}
  41 ;;   runs the function for {C-a}.
  42 ;;
  43 ;;   If no keys are typed while the Smart Keys are down, they operate as
  44 ;;   normally under Hyperbole.
  45 ;;
  46 ;;   TO INVOKE:
  47 ;;
  48 ;;       (hmouse-mod-set-global-map)
  49 ;;
  50
  51 ;;; Code:
  52
  53 ;;;
  54 ;;; Other required Elisp libraries
  55 ;;;
  56
  57 (require 'hyperbole)
  58
  59 ;;;
  60 ;;; Public variables
  61 ;;;
  62
  63 (defvar hmouse-mod-global-map nil
  64   "Global key map installed by hmouse-mod-set-global-map function.
  65 Translates self-insert-command characters into control and meta characters if
  66 the Action or Assist Keys are depressed at the time of key press.")
  67
  68 ;;;
  69 ;;; Public functions
  70 ;;;
  71
  72 (defun hmouse-mod-insert-command (count)
  73   "Surrogate function for self-insert-command.  Accounts for modifier Smart Keys."
  74   (interactive "p")
  75   (if (and (boundp 'action-key-depressed-flag)
  76            (boundp 'assist-key-depressed-flag))
  77       (cond ((and action-key-depressed-flag assist-key-depressed-flag)
  78              (setq action-key-cancelled t
  79                    assist-key-cancelled t)
  80              (let* ((c (downcase last-command-char))
  81                     (key (char-to-string (+ 128 (% (- c ?\`) 128)))))
  82                (if (and (or (= c ?\C-@)
  83                             (>= c ?a) (<= c ?z)))
  84                    (hmouse-mod-execute-command key)
  85                  (beep)))
  86              )
  87             ;; Control keys
  88             (action-key-depressed-flag
  89               (setq action-key-cancelled t)
  90               (let ((c (downcase last-command-char)))
  91                 (if (and (or (= c ?\C-@)
  92                              (>= c ?a) (<= c ?z)))
  93                     (hmouse-mod-execute-command
  94                       (char-to-string (- c ?\`)))
  95                   (beep)))
  96               )
  97             ;; Meta keys
  98             (assist-key-depressed-flag
  99               (setq assist-key-cancelled t)
 100               (hmouse-mod-execute-command
 101                 (char-to-string (+ 128 (% last-command-char 128))))
 102               )
 103             (t (call-interactively 'self-insert-command)))
 104     (call-interactively 'self-insert-command))
 105   )
 106
 107 (defun hmouse-mod-keyboard-quit ()
 108   "Surrogate function for keyboard-quit.  Cancels any hmouse-mod-prefix."
 109   (interactive)
 110   (setq hmouse-mod-prefix nil)
 111   (keyboard-quit))
 112
 113 (defun hmouse-mod-set-global-map ()
 114   "Creates 'hmouse-mod-global-map' and installs as current global map.
 115 It accounts for modifier Smart Keys."
 116   (interactive)
 117   (setq hmouse-mod-global-map (copy-keymap global-map))
 118   (substitute-key-definition
 119     'self-insert-command 'hmouse-mod-insert-command hmouse-mod-global-map)
 120   (substitute-key-definition
 121     'keyboard-quit 'hmouse-mod-keyboard-quit hmouse-mod-global-map)
 122   (use-global-map hmouse-mod-global-map))
 123
 124 ;;;
 125 ;;; Private functions
 126 ;;;
 127
 128 (defun hmouse-mod-execute-command (key)
 129   "Executes command associated with keyboard KEY or if KEY prefix, records it."
 130   (setq key (concat hmouse-mod-prefix key))
 131   (let ((binding (key-binding key)))
 132     (cond ((and (not (or (vectorp binding) (stringp binding)))
 133                 (commandp binding))
 134            (if (> (length key) 1)
 135                (or noninteractive (message (key-description key))))
 136            (setq hmouse-mod-prefix nil)
 137            (call-interactively binding))
 138           ((symbolp binding)
 139            (setq hmouse-mod-prefix nil)
 140            (error "(hmouse-mod-execute-command): {%s} not bound to a command."
 141                   (key-description key)))
 142           ((integerp binding)
 143            (setq hmouse-mod-prefix nil)
 144            (error "(hmouse-mod-execute-command): {%s} invalid key sequence."
 145                   (key-description key)))
 146           (t (or noninteractive (message (key-description key)))
 147              (setq hmouse-mod-prefix key)))))
 148
 149 ;;;
 150 ;;; Private variables
 151 ;;;
 152
 153 (defvar hmouse-mod-prefix nil
 154   "Prefix key part of current key sequence.")
 155
 156 (provide 'hmouse-mod)
 157
 158 ;;; hmouse-mod.el ends here