diff options
Diffstat (limited to 'hib-kbd.el')
| -rw-r--r-- | hib-kbd.el | 131 |
1 files changed, 62 insertions, 69 deletions
@@ -11,15 +11,16 @@ ;; ;;; Commentary: ;; -;; A press of the Action Key on a key sequence executes its -;; command binding or Hyperbole minibuffer menu binding. +;; A press of the Action Key on any sequence of keys delimited by braces +;; executes its command binding or Hyperbole minibuffer menu binding. ;; -;; A press of the Assist Key on a key sequence displays the -;; documentation for it. +;; A press of the Assist Key on any sequence of keys delimited by braces +;; displays the documentation for it. ;; -;; Key sequences should be in human readable string form with spaces -;; between each key and the whole sequence delimited by braces, -;; e.g. {C-x o}. Forms such as {\C-b}, {\^b}, and {^b} will not be +;; Sequences of keys should be in human readable string form with spaces +;; between each key, may contain any number of individual key sequences +;; and the whole thing should be delimited by braces, e.g. {M-x apropos +;; RET hyperbole RET}. Forms such as {\C-b}, {\^b}, and {^b} will not be ;; recognized. ;;; Code: @@ -32,10 +33,10 @@ ;;; ************************************************************************ ;;; Public implicit button types ;;; ************************************************************************ - -(defact kbd-key (key-sequence) + +(defact kbd-key (key-series) "Executes a normalized key sequence without curly braces, {}. -KEY-SEQUENCE must be a string of one of the following: +KEY-SERIES must be a string of one of the following: a Hyperbole minibuffer menu item key sequence, a HyControl key sequence, a M-x extended command, @@ -43,7 +44,7 @@ KEY-SEQUENCE must be a string of one of the following: Returns t if the sequence appears to be valid, else nil." (interactive "kKey sequence to execute (no {}): ") - (kbd-key:act key-sequence)) + (kbd-key:act key-series)) (defib kbd-key () "Executes a key sequence found around point, delimited by curly braces, {}, if any. @@ -65,37 +66,38 @@ Any key sequence must be a string of one of the following: ;; these are special quote marks, not the ;; standard ASCII characters. (hbut:label-p t "‘" "’" t))) - (key-sequence (car seq-and-pos)) + ;; This excludes delimiters + (key-series (car seq-and-pos)) (start (cadr seq-and-pos)) binding) ;; Match only when start delimiter is preceded by whitespace or ;; is the 1st buffer character, so do not match to things like ${variable}. - (when (= (char-syntax (or (char-before start) ?\t)) ?\ ) - (when (and (stringp key-sequence) - (not (eq key-sequence ""))) - (setq key-sequence (kbd-key:normalize key-sequence) - binding (key-binding key-sequence))) - (and (stringp key-sequence) + (when (memq (char-before start) '(nil ?\ ?\t ?\n ?\j ?\f)) + (when (and (stringp key-series) + (not (eq key-series ""))) + (setq key-series (kbd-key:normalize key-series) + binding (key-binding key-series))) + (and (stringp key-series) (or (and binding (not (integerp binding))) - (kbd-key:special-sequence-p key-sequence)) + (kbd-key:special-sequence-p key-series)) (ibut:label-set seq-and-pos) - (hact 'kbd-key key-sequence)))))) + (hact 'kbd-key key-series)))))) ;;; ************************************************************************ ;;; Public functions ;;; ************************************************************************ -(defun kbd-key:act (key-sequence) - "Executes the command binding for normalized KEY-SEQUENCE. -Returns t if KEY-SEQUENCE has a binding, else nil." +(defun kbd-key:act (key-series) + "Executes the command binding for normalized KEY-SERIES. +Returns t if KEY-SERIES has a binding, else nil." (interactive "kKeyboard key to execute (no {}): ") - (setq current-prefix-arg nil) ;; Execution of the key-sequence may set it. - (let ((binding (key-binding key-sequence))) + (setq current-prefix-arg nil) ;; Execution of the key-series may set it. + (let ((binding (key-binding key-series))) (cond ((null binding) ;; If this is a special key seqence, execute it by adding ;; its keys to the stream of unread command events. - (when (kbd-key:special-sequence-p key-sequence) - (setq unread-command-events (nconc unread-command-events (mapcar 'identity key-sequence))) + (when (kbd-key:special-sequence-p key-series) + (setq unread-command-events (nconc unread-command-events (mapcar 'identity key-series))) t)) ((memq binding '(action-key action-mouse-key hkey-either)) (beep) @@ -103,11 +105,11 @@ Returns t if KEY-SEQUENCE has a binding, else nil." t) (t (call-interactively binding) t)))) -(defun kbd-key:doc (key-sequence &optional full) - "Shows first line of doc for binding of keyboard KEY-SEQUENCE in minibuffer. +(defun kbd-key:doc (key-series &optional full) + "Shows first line of doc for binding of keyboard KEY-SERIES in minibuffer. With optional prefix arg FULL, displays full documentation for command." (interactive "kKey sequence: \nP") - (let* ((keys (kbd-key:normalize key-sequence)) + (let* ((keys (kbd-key:normalize key-series)) (cmd (let ((cmd (key-binding keys))) (if (not (integerp cmd)) cmd))) (doc (and cmd (documentation cmd))) @@ -117,7 +119,7 @@ With optional prefix arg FULL, displays full documentation for command." (or full (setq end-line (string-match "[\n]" doc) doc (substitute-command-keys (substring doc 0 end-line)))) - (setq doc (format "No documentation for {%s} %s" key-sequence (or cmd "")))) + (setq doc (format "No documentation for {%s} %s" key-series (or cmd "")))) (if (and cmd doc) (if full (describe-function cmd) @@ -126,18 +128,19 @@ With optional prefix arg FULL, displays full documentation for command." (if full (hui:menu-help doc) (message doc))) - (t (error "(kbd-key:doc): No binding found for keys {%s}" key-sequence))))) + (t (hkey-help))))) + (defun kbd-key:help (but) "Display documentation for binding of keyboard key given by BUT's label." (let ((kbd-key (hbut:key-to-label (hattr:get but 'lbl-key)))) (if kbd-key (kbd-key:doc kbd-key t)))) -(defun kbd-key:normalize (key-sequence) - "Returns KEY-SEQUENCE string (without surrounding {}) normalized into a form that can be parsed by commands." +(defun kbd-key:normalize (key-series) + "Returns KEY-SERIES string (without surrounding {}) normalized into a form that can be parsed by commands." (interactive "kKeyboard key sequence to normalize (no {}): ") - (if (stringp key-sequence) - (let ((norm-key-seq (copy-sequence key-sequence)) + (if (stringp key-series) + (let ((norm-key-seq (copy-sequence key-series)) (case-fold-search nil) (case-replace t) (substring) @@ -171,17 +174,7 @@ With optional prefix arg FULL, displays full documentation for command." (string-to-number (substring norm-key-seq (match-beginning 2) (match-end 2))) norm-key-seq (substring norm-key-seq (match-end 0)))) - (let (arg-val) - (while (string-match "\\`C-u" norm-key-seq) - (if (or (not (listp arg)) - (not (integerp (setq arg-val (car arg))))) - (setq arg '(1) - arg-val 1)) - (setq arg-val (* arg-val 4) - arg (cons arg-val nil) - norm-key-seq (substring norm-key-seq (match-end 0))))) - (if arg (setq norm-key-seq (concat (format "\025%s" arg) norm-key-seq))) - ;; + ;; Quote Control and Meta key names (setq norm-key-seq (hypb:replace-match-string "C-\\(.\\)" norm-key-seq @@ -197,36 +190,36 @@ With optional prefix arg FULL, displays full documentation for command." (lambda (str) (concat "" (substring str (match-beginning 1) (1+ (match-beginning 1)))))))) - (error "(kbd-key:normalize): requires a string argument, not `%s'" key-sequence))) + (error "(kbd-key:normalize): requires a string argument, not `%s'" key-series))) ;;; ************************************************************************ ;;; Private functions ;;; ************************************************************************ -(defun kbd-key:extended-command-p (key-sequence) - "Returns non-nil if the string KEY-SEQUENCE is a normalized extended command invocation, i.e. M-x command." - (and (stringp key-sequence) (string-match kbd-key:extended-command-prefix key-sequence))) +(defun kbd-key:extended-command-p (key-series) + "Returns non-nil if the string KEY-SERIES is a normalized extended command invocation, i.e. M-x command." + (and (stringp key-series) (string-match kbd-key:extended-command-prefix key-series))) -(defun kbd-key:hyperbole-hycontrol-key-p (key-sequence) - "Returns t if normalized KEY-SEQUENCE is given when in a HyControl mode, else nil. +(defun kbd-key:hyperbole-hycontrol-key-p (key-series) + "Returns t if normalized, non-nil KEY-SERIES is given when in a HyControl mode, else nil. Allows for multiple key sequences strung together." - (and key-sequence + (and key-series (featurep 'hycontrol) (or hycontrol-windows-mode hycontrol-frames-mode) ;; If wanted to limit to single key bindings and provide tighter checking: - ;; (string-match "[-.0-9]*\\(.*\\)" key-sequence) - ;; (key-binding (match-string 1 key-sequence)) + ;; (string-match "[-.0-9]*\\(.*\\)" key-series) + ;; (key-binding (match-string 1 key-series)) t)) -(defun kbd-key:hyperbole-mini-menu-key-p (key-sequence) - "Returns t if normalized KEY-SEQUENCE appears to invoke a Hyperbole menu item or sequence of keys, else nil." - (when key-sequence +(defun kbd-key:hyperbole-mini-menu-key-p (key-series) + "Returns t if normalized KEY-SERIES appears to invoke a Hyperbole menu item or sequence of keys, else nil." + (when key-series (let ((mini-menu-key (kbd-key:normalize (key-description (car (where-is-internal 'hyperbole)))))) - (if (string-match (regexp-quote mini-menu-key) key-sequence) t)))) + (if (string-match (regexp-quote mini-menu-key) key-series) t)))) -(defun kbd-key:key-and-arguments (key-sequence) - "Returns t if normalized KEY-SEQUENCE appears to be a bound key sequence possibly with following interactive arguments, else nil." - (let ((prefix-binding (and (stringp key-sequence) (key-binding (substring key-sequence 0 1))))) +(defun kbd-key:key-and-arguments (key-series) + "Returns t if normalized KEY-SERIES appears to be a bound key sequence possibly with following interactive arguments, else nil." + (let ((prefix-binding (and (stringp key-series) (key-binding (substring key-series 0 1))))) ;; Just ensure that 1st character is bound to something that is ;; not a self-insert-command or a number. (and prefix-binding @@ -253,16 +246,16 @@ Allows for multiple key sequences strung together." start end)) string)) -(defun kbd-key:special-sequence-p (key-sequence) - "Returns non-nil if normalized KEY-SEQUENCE string is one of the following: +(defun kbd-key:special-sequence-p (key-series) + "Returns non-nil if normalized KEY-SERIES string is one of the following: a Hyperbole minibuffer menu item key sequence, a HyControl key sequence, a M-x extended command, or a valid key sequence together with its interactive arguments." - (or (kbd-key:hyperbole-mini-menu-key-p key-sequence) - (kbd-key:hyperbole-hycontrol-key-p key-sequence) - (kbd-key:extended-command-p key-sequence) - (kbd-key:key-and-arguments key-sequence))) + (or (kbd-key:hyperbole-mini-menu-key-p key-series) + (kbd-key:hyperbole-hycontrol-key-p key-series) + (kbd-key:extended-command-p key-series) + (kbd-key:key-and-arguments key-series))) ;;; ************************************************************************ ;;; Private variables |