home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / functions / function-keys.el < prev    next >
Encoding:
Text File  |  1993-02-03  |  8.4 KB  |  216 lines
  1. ;;; $Id: function-keys.el,v 1.3 1992/10/28 21:42:04 rwhitby Exp $ */
  2. ;;; $File: ~elib/functions/function-keys.el $ */
  3.  
  4. ;; LCD Archive Entry:
  5. ;; function-keys|Rod Whitby|rwhitby@research.canon.oz.au|
  6. ;; Provides define-function-key for Epoch and X Emacs.|
  7. ;; 1992-10-28|1.3|~/functions/function-keys.el.Z|
  8.  
  9. ;;; Check if we are running under epoch
  10. (if (boundp 'epoch::version)
  11. (progn
  12.  
  13. ;;; Turn off function key mapping
  14. (setq epoch::function-key-mapping nil)
  15.  
  16. ;;; Support for generic function key binding (originally by Ken Laprade):
  17. ;;;
  18. (defvar function-key-prefix-string "\C-^*"
  19.   "Prefix for function key definitions created by define-function-key.")
  20.  
  21. (defun define-function-key (keymap key def)
  22.   "\
  23. Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.
  24. KEYMAP is a keymap. KEY is a string naming the key (as known to X) with
  25. optional `M', `S', or `C' prefixes specifying meta, shift and control
  26. qualifiers. Prefixes are separated from the key name by a hyphen.
  27. DEF is the key definition.  It may be any valid definition for define-key.
  28. If it is a string, it will be directly bound to the key using rebind-key."
  29.   (let* ((i (string-match "-" key))
  30.      (keyname (let ((name (substring key (if i (1+ i) 0))))
  31.             (cond ((string-match "R8" name) "Up")
  32.               ((string-match "R10" name) "Left")
  33.               ((string-match "R12" name) "Right")
  34.               ((string-match "R14" name) "Down")
  35.               (t name))))
  36.      (meta (string-match "M.*-" key))
  37.      (shift (string-match "S.*-" key))
  38.      (control (string-match "C.*-" key))
  39.      quals)
  40.     (if meta (setq quals (append '(meta) quals)))
  41.     (if control (setq quals (append '(control) quals)))
  42.     (if shift (setq quals (append '(shift) quals)))
  43.     (or quals (setq quals 0))
  44.     (if (stringp def)
  45.     (rebind-key keyname quals def)
  46.       ;; Make an intermediate binding for the definition.
  47.       (let* ((keytype (cond ((string-match "L\\([1-9]\\|10\\)$" key) "L")
  48.                 ((string-match "F\\([1-9]\\)$" key) "F")
  49.                 ((string-match "R\\([1-9]\\|1[0-5]\\)$" key) "R")
  50.                 (t keyname)))
  51.          (keynum (and (match-beginning 1)
  52.               (string-to-int (substring key (match-beginning 1) (match-end 1)))))
  53.          (binding (concat function-key-prefix-string
  54.                   (if meta "M") (if shift "S") (if control "C")
  55.                   keytype
  56.                   (if keynum (format "%02d" keynum)))))
  57.     (rebind-key keyname quals binding)
  58.     (define-key keymap binding def)))))
  59.  
  60. )) ;;; End test for epoch
  61.  
  62. ;;; Check if we are running under X emacs
  63. (if (and (not (boundp 'epoch::version))
  64.      (equal window-system 'x))
  65. (progn
  66.  
  67. ;;; Support for generic function key binding (originally by Ken Laprade):
  68. ;;;
  69. (defun define-function-key (keymap key def)
  70.   "\
  71. Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.
  72. KEYMAP is a keymap. KEY is a string naming the key (as known to X) with
  73. optional `M', `S', or `C' prefixes specifying meta, shift and control
  74. qualifiers. Prefixes are separated from the key name by a hyphen.
  75. Raw keys (as from the normal X version) do not provide the shift or
  76. control prefixes, but the emacstool version does.
  77. Both maps are setup by this function.
  78. DEF is the key definition.  It may be any valid definition for define-key."
  79.   (let* ((i (string-match "-" key))
  80.      (keyname (let ((name (substring key (if i (1+ i) 0))))
  81.             (cond ((string-match "Up" name) "R8")
  82.               ((string-match "Left" name) "R10")
  83.               ((string-match "Right" name) "R12")
  84.               ((string-match "Down" name) "R14")
  85.               (t name))))
  86.      (meta (string-match "M.*-" key))
  87.      (shift (string-match "S.*-" key))
  88.      (control (string-match "C.*-" key))
  89.      (keybase (cond ((string-match "L\\([1-9]\\|10\\)$" keyname) 191)
  90.               ((string-match "F\\([1-9]\\)$" keyname) 223)
  91.               ((string-match "F1\\([1-2]\\)$" keyname) 191)
  92.               ((string-match "R\\([1-9]\\|1[0-5]\\)$" keyname) 207)
  93.               (t 0)))    ; Unknown key.
  94.      (keynum (if (match-beginning 1)
  95.              (string-to-int (substring keyname (match-beginning 1)
  96.                            (match-end 1)))
  97.            0)))
  98.     ;; The raw key version:
  99.     (or shift control (not sun-esc-bracket)
  100.     (define-key keymap (format "\e[%03dz" (+ keybase keynum)) def)
  101.     )))
  102.  
  103. (defvar sun-raw-map (make-sparse-keymap) "*Keymap for ESC-[ encoded keyboard")
  104.  
  105. (defvar sun-esc-bracket t
  106.   "*If non-nil, rebind ESC [ as prefix for Sun function keys.")
  107.  
  108. ;;; Hook in the function key maps:
  109. (if sun-esc-bracket
  110.     (progn
  111.       (define-key esc-map "[" sun-raw-map)        ; Install sun-raw-map
  112.       (define-key esc-map "[-1z" nil)            ; Undefined keys
  113.       (define-key esc-map "[A" 'previous-line )        ; R8
  114.       (define-key esc-map "[B" 'next-line)        ; R14
  115.       (define-key esc-map "[C" 'forward-char)        ; R12
  116.       (define-key esc-map "[D" 'backward-char)        ; R10
  117.       (define-key esc-map "[[" 'backward-paragraph)    ; the original esc-\[
  118.       ))
  119.  
  120. )) ;;; End test for X emacs
  121.  
  122. ;;; Check if we are running under a character based emacs
  123. (if (and (not (boundp 'epoch::version))
  124.      (not (equal window-system 'x)))
  125. (progn
  126.  
  127. ;;; Support for generic function key binding (originally by Ken Laprade):
  128. ;;;
  129. (defun define-function-key (keymap key def)
  130.   "\
  131. Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.
  132. KEYMAP is a keymap. KEY is a string naming the key (as known to X) with
  133. optional `M', `S', or `C' prefixes specifying meta, shift and control
  134. qualifiers. Prefixes are separated from the key name by a hyphen.
  135. Raw keys (as from the normal X version) do not provide the shift or
  136. control prefixes, but the emacstool version does.
  137. Both maps are setup by this function.
  138. DEF is the key definition.  It may be any valid definition for define-key."
  139.   (let* ((i (string-match "-" key))
  140.      (keyname (let ((name (substring key (if i (1+ i) 0))))
  141.             (cond ((string-match "Up" name) "R8")
  142.               ((string-match "Left" name) "R10")
  143.               ((string-match "Right" name) "R12")
  144.               ((string-match "Down" name) "R14")
  145.               (t name))))
  146.      (meta (string-match "M.*-" key))
  147.      (shift (string-match "S.*-" key))
  148.      (control (string-match "C.*-" key))
  149.      (keybase (cond ((string-match "L\\([1-4]\\)$" keyname) 22)
  150.             ((string-match "L\\([5-6]\\)$" keyname) 23)
  151.             ((string-match "L\\([7-9]\\|10\\)$" keyname) 24)
  152.             ((string-match "F\\([1-5]\\)$" keyname) 10)
  153.             ((string-match "F\\([6-9]\\|10\\)$" keyname) 11)
  154.             ((string-match "F1\\([1-2]\\)$" keyname) 12)
  155.             (t 0)))    ; Unknown key.
  156.      (keynum (if (match-beginning 1)
  157.              (string-to-int (substring keyname (match-beginning 1)
  158.                            (match-end 1)))
  159.            0)))
  160.     ;; The raw key version:
  161.     (or shift control (not sun-esc-bracket)
  162.     (define-key keymap (format "\e[%03d~" (+ keybase keynum)) def)
  163.     )))
  164.  
  165. (defvar sun-raw-map (make-sparse-keymap) "*Keymap for ESC-[ encoded keyboard")
  166.  
  167. (defvar sun-esc-bracket t
  168.   "*If non-nil, rebind ESC [ as prefix for Sun function keys.")
  169.  
  170. ;;; Hook in the function key maps:
  171. (if sun-esc-bracket
  172.     (progn
  173.       (define-key esc-map "[" sun-raw-map)        ; Install sun-raw-map
  174.       (define-key esc-map "[-1z" nil)            ; Undefined keys
  175.       (define-key esc-map "[A" 'previous-line )        ; R8
  176.       (define-key esc-map "[B" 'next-line)        ; R14
  177.       (define-key esc-map "[C" 'forward-char)        ; R12
  178.       (define-key esc-map "[D" 'backward-char)        ; R10
  179.       (define-key esc-map "[[" 'backward-paragraph)    ; the original esc-\[
  180.       ))
  181.  
  182. )) ;;; End test for character based emacs
  183.  
  184. (defun global-set-function-key (keys function)
  185.   "\
  186. Give KEY a definition of COMMAND.
  187. COMMAND is a symbol naming an interactively-callable function.
  188. KEY is a string naming the key (as known to X) with
  189. optional `M', `S', or `C' prefixes specifying meta, shift and control
  190. qualifiers. Prefixes are separated from the key name by a hyphen.
  191. Note that if KEY has a local definition in the current buffer
  192. that local definition will continue to shadow any global definition."
  193.   (interactive "sSet key globally: \nCSet key %s to command: ")
  194.   (define-function-key global-map keys function)
  195.   nil)
  196.  
  197. (defun local-set-function-key (keys function)
  198.   "\
  199. Give KEY a local definition of COMMAND.
  200. COMMAND is a symbol naming an interactively-callable function.
  201. KEY is a string naming the key (as known to X) with
  202. optional `M', `S', or `C' prefixes specifying meta, shift and control
  203. qualifiers. Prefixes are separated from the key name by a hyphen.
  204. The definition goes in the current buffer's local map,
  205. which is shared with other buffers in the same major mode."
  206.   (interactive "sSet key locally: \nCSet key %s locally to command: ")
  207.   (let ((local-map (current-local-map)))
  208.     (or local-map
  209.     (progn
  210.       (setq local-map (make-sparse-keymap))
  211.       (use-local-map local-map)))
  212.     (define-function-key local-map keys function)
  213.     nil))
  214.  
  215. (provide 'function-keys)
  216.