|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hib-kbd.el
|
|
|
4 ;; SUMMARY: Implicit button type for key sequences delimited with {}.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: extensions, hypermedia
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Brown U.
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 22-Nov-91 at 01:37:57
|
|
|
12 ;; LAST-MOD: 23-Oct-95 at 05:02:49 by Bob Weiner
|
|
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
|
17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
|
|
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;;
|
|
|
22 ;; A click of the Hyperbole execution key on a key sequence executes its
|
|
|
23 ;; command binding.
|
|
|
24 ;;
|
|
|
25 ;; A click of the Hyperbole help key on a key sequence displays the
|
|
|
26 ;; documentation for its command binding.
|
|
|
27 ;;
|
|
|
28 ;; Key sequences should be in human readable form, e.g. {C-b}.
|
|
|
29 ;; Forms such as {\C-b}, {\^b}, and {^b} will not be recognized.
|
|
|
30 ;;
|
|
|
31 ;; DESCRIP-END.
|
|
|
32
|
|
|
33 ;;; ************************************************************************
|
|
|
34 ;;; Public implicit button types
|
|
|
35 ;;; ************************************************************************
|
|
|
36
|
|
|
37 (defact kbd-key (key-sequence)
|
|
|
38 "Executes the function binding for KEY-SEQUENCE, delimited by {}.
|
|
|
39 Returns t if a KEY-SEQUENCE has a binding, else nil."
|
|
|
40 (interactive "kKeyboard key to execute (no {}): ")
|
|
|
41 (kbd-key:act key-sequence))
|
|
|
42
|
|
|
43 (defib kbd-key ()
|
|
|
44 "Executes a key sequence delimited by curly braces.
|
|
|
45 Key sequences should be in human readable form, e.g. {C-b}.
|
|
|
46 Forms such as {\C-b}, {\^b}, and {^b} will not be recognized."
|
|
|
47 (if (br-in-browser)
|
|
|
48 nil
|
|
|
49 (let* ((seq-and-pos (or (hbut:label-p t "{`" "'}" t)
|
|
|
50 (hbut:label-p t "{" "}" t)))
|
|
|
51 (key-sequence (car seq-and-pos))
|
|
|
52 (binding (and (stringp key-sequence)
|
|
|
53 (key-binding (kbd-key:normalize key-sequence)))))
|
|
|
54 (and binding (not (integerp binding))
|
|
|
55 (ibut:label-set seq-and-pos)
|
|
|
56 (hact 'kbd-key key-sequence)))))
|
|
|
57
|
|
|
58 ;;; ************************************************************************
|
|
|
59 ;;; Public functions
|
|
|
60 ;;; ************************************************************************
|
|
|
61
|
|
|
62 (defun kbd-key:act (key-sequence)
|
|
|
63 "Executes the command binding for KEY-SEQUENCE.
|
|
|
64 Returns t if KEY-SEQUENCE has a binding, else nil."
|
|
|
65 (interactive "kKeyboard key to execute (no {}): ")
|
|
|
66 (setq current-prefix-arg nil) ;; kbd-key:normalize below sets it.
|
|
|
67 (let ((binding (key-binding (kbd-key:normalize key-sequence))))
|
|
|
68 (cond ((null binding) nil)
|
|
|
69 ((memq binding '(action-key action-mouse-key hkey-either))
|
|
|
70 (beep)
|
|
|
71 (message "(kbd-key:act): This key does what the Action Key does.")
|
|
|
72 t)
|
|
|
73 (t (call-interactively binding) t))))
|
|
|
74
|
|
|
75 (defun kbd-key:doc (key &optional full)
|
|
|
76 "Shows first line of doc for binding of keyboard KEY in minibuffer.
|
|
|
77 With optional FULL, displays full documentation for command."
|
|
|
78 (interactive "kKey sequence: \nP")
|
|
|
79 (let* ((cmd (let ((cmd (key-binding (kbd-key:normalize key))))
|
|
|
80 (if (not (integerp cmd)) cmd)))
|
|
|
81 (doc (and cmd (documentation cmd)))
|
|
|
82 (end-line))
|
|
|
83 (if doc
|
|
|
84 (or full
|
|
|
85 (setq end-line (string-match "[\n]" doc)
|
|
|
86 doc (substitute-command-keys (substring doc 0 end-line))))
|
|
|
87 (setq doc (format "No documentation for {%s} %s" key (or cmd ""))))
|
|
|
88 (if (and cmd doc)
|
|
|
89 (if full
|
|
|
90 (describe-function cmd)
|
|
|
91 (message doc)))))
|
|
|
92
|
|
|
93 (defun kbd-key:help (but)
|
|
|
94 "Display documentation for binding of keyboard key given by BUT's label."
|
|
|
95 (let ((kbd-key (hbut:key-to-label (hattr:get but 'lbl-key))))
|
|
|
96 (and kbd-key (kbd-key:doc kbd-key 'full))))
|
|
|
97
|
|
|
98 (defun kbd-key:normalize (key-sequence)
|
|
|
99 "Returns KEY-SEQUENCE normalized into a form that can be parsed by commands."
|
|
|
100 (interactive "kKeyboard key sequence to normalize (no {}): ")
|
|
|
101 (let ((norm-key-seq (copy-sequence key-sequence))
|
|
|
102 (case-fold-search nil) (case-replace t))
|
|
|
103 ;; Quote Control and Meta key names
|
|
|
104 (setq norm-key-seq (hypb:replace-match-string
|
|
|
105 "[ \t\n\^M]+" norm-key-seq "" t)
|
|
|
106 norm-key-seq (hypb:replace-match-string
|
|
|
107 "@key{SPC}\\|SPC" norm-key-seq "\040" t)
|
|
|
108 norm-key-seq (hypb:replace-match-string
|
|
|
109 "@key{DEL}\\|DEL" norm-key-seq "\177" t)
|
|
|
110 norm-key-seq (hypb:replace-match-string
|
|
|
111 "@key{RET}\\|@key{RTN}\\|RET\\|RTN"
|
|
|
112 norm-key-seq "\015" t)
|
|
|
113 norm-key-seq (hypb:replace-match-string
|
|
|
114 "ESCESC" norm-key-seq "\233" t)
|
|
|
115 norm-key-seq (hypb:replace-match-string
|
|
|
116 "@key{ESC}\\|ESC" norm-key-seq "M-" t)
|
|
|
117 ;; Unqote special {} chars.
|
|
|
118 norm-key-seq (hypb:replace-match-string "\\\\\\([{}]\\)"
|
|
|
119 norm-key-seq "\\1")
|
|
|
120 )
|
|
|
121 (while (string-match "\\`\\(C-u\\|M-\\)\\(-?[0-9]+\\)" norm-key-seq)
|
|
|
122 (setq current-prefix-arg
|
|
|
123 (string-to-int (substring norm-key-seq (match-beginning 2)
|
|
|
124 (match-end 2)))
|
|
|
125 norm-key-seq (substring norm-key-seq (match-end 0))))
|
|
|
126 (let (arg-val)
|
|
|
127 (while (string-match "\\`C-u" norm-key-seq)
|
|
|
128 (if (or (not (listp current-prefix-arg))
|
|
|
129 (not (integerp (setq arg-val (car current-prefix-arg)))))
|
|
|
130 (setq current-prefix-arg '(1)
|
|
|
131 arg-val 1))
|
|
|
132 (setq arg-val (* arg-val 4)
|
|
|
133 current-prefix-arg (cons arg-val nil)
|
|
|
134 norm-key-seq (substring norm-key-seq (match-end 0)))))
|
|
|
135 (setq norm-key-seq (hypb:replace-match-string
|
|
|
136 "C-\\(.\\)" norm-key-seq
|
|
|
137 (function
|
|
|
138 (lambda (str)
|
|
|
139 (char-to-string
|
|
|
140 (1+ (- (downcase
|
|
|
141 (string-to-char
|
|
|
142 (substring str (match-beginning 1)
|
|
|
143 (1+ (match-beginning 1)))))
|
|
|
144 ?a)))))))
|
|
|
145 (hypb:replace-match-string
|
|
|
146 "M-\\(.\\)" norm-key-seq
|
|
|
147 (function
|
|
|
148 (lambda (str)
|
|
|
149 (char-to-string (+ (downcase (string-to-char
|
|
|
150 (substring str (match-beginning 1)
|
|
|
151 (1+ (match-beginning 1)))))
|
|
|
152 128)))))))
|
|
|
153
|
|
|
154 (provide 'hib-kbd)
|
