mirror of https://codeberg.org/cage/tinmop/
- prefixed all parsing rule for keybindings parsing to avoid clash with other rules in the code.
This commit is contained in:
parent
9c4503e3bd
commit
61f8a68313
|
@ -89,49 +89,49 @@
|
|||
;; FUNCTION-PLACEHOLDER := 'function-placeholder'
|
||||
|
||||
|
||||
(defrule function-placeholder "function-placeholder"
|
||||
(defrule keybindings-function-placeholder "function-placeholder"
|
||||
(:constant +function-placeholder-value+))
|
||||
|
||||
(defrule blank (or #\space #\Newline #\Tab)
|
||||
(defrule keybindings-blank (or #\space #\Newline #\Tab)
|
||||
(:constant nil))
|
||||
|
||||
(defrule blanks (* blank)
|
||||
(defrule keybindings-blanks (* blank)
|
||||
(:constant nil))
|
||||
|
||||
(defrule escaped-character (and #\\ character)
|
||||
(defrule keybindings-escaped-character (and #\\ character)
|
||||
(:function (lambda (a) (list (second a)))))
|
||||
|
||||
(defrule dash #\-
|
||||
(defrule keybindings-dash #\-
|
||||
(:text t))
|
||||
|
||||
(defrule arrow-right "right"
|
||||
(defrule keybindings-arrow-right "right"
|
||||
(:constant "key-arrow-right"))
|
||||
|
||||
(defrule arrow-left "left"
|
||||
(defrule keybindings-arrow-left "left"
|
||||
(:constant "key-arrow-left"))
|
||||
|
||||
(defrule arrow-up "up"
|
||||
(defrule keybindings-arrow-up "up"
|
||||
(:constant "key-arrow-up"))
|
||||
|
||||
(defrule arrow-down "down"
|
||||
(defrule keybindings-arrow-down "down"
|
||||
(:constant "key-arrow-down"))
|
||||
|
||||
(defrule key-home "home"
|
||||
(defrule keybindings-key-home "home"
|
||||
(:constant "key-home"))
|
||||
|
||||
(defrule key-end "end"
|
||||
(defrule keybindings-key-end "end"
|
||||
(:constant "key-end"))
|
||||
|
||||
(defrule key-next-page "npage"
|
||||
(defrule keybindings-key-next-page "npage"
|
||||
(:constant "key-next-page"))
|
||||
|
||||
(defrule key-previous-page "ppage"
|
||||
(defrule keybindings-key-previous-page "ppage"
|
||||
(:constant "key-previous-page"))
|
||||
|
||||
(defrule key-delete-next-char "dc"
|
||||
(defrule keybindings-key-delete-next-char "dc"
|
||||
(:constant "key-delete-char"))
|
||||
|
||||
(defrule non-printable-key
|
||||
(defrule keybindings-non-printable-key
|
||||
(or "f10"
|
||||
"f1"
|
||||
"f2"
|
||||
|
@ -163,7 +163,7 @@
|
|||
(:text t)
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule after-meta-key
|
||||
(defrule keybindings-after-meta-key
|
||||
(or "right"
|
||||
"left"
|
||||
"up"
|
||||
|
@ -171,29 +171,31 @@
|
|||
(:text t)
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule char
|
||||
(or escaped-character
|
||||
(not (or dash blank)))
|
||||
(defrule keybindings-char
|
||||
(or keybindings-escaped-character
|
||||
(not (or keybindings-dash keybindings-blank)))
|
||||
(:text t))
|
||||
|
||||
(defrule meta-mod #\M
|
||||
(defrule keybindings-meta-mod #\M
|
||||
(:text t))
|
||||
|
||||
(defrule command-mod-1 #\C)
|
||||
(defrule keybindings-command-mod-1 #\C)
|
||||
|
||||
(defrule command-mod-2 #\^)
|
||||
(defrule keybindings-command-mod-2 #\^)
|
||||
|
||||
(defrule simple-key char)
|
||||
(defrule keybindings-simple-key keybindings-char)
|
||||
|
||||
(defrule keycode (or non-printable-key simple-key)) ; keep the order
|
||||
(defrule keybindings-keycode (or keybindings-non-printable-key
|
||||
keybindings-simple-key)) ; keep the order
|
||||
|
||||
(defrule after-meta-keycode (or after-meta-key simple-key)) ; keep the order
|
||||
(defrule keybindings-after-meta-keycode (or keybindings-after-meta-key
|
||||
keybindings-simple-key)) ; keep the order
|
||||
|
||||
(defun to-meta-code-string (command)
|
||||
(strcat +meta-prefix+ (string-upcase (third command))))
|
||||
|
||||
(defrule meta-key
|
||||
(and meta-mod dash after-meta-keycode)
|
||||
(defrule keybindings-meta-key
|
||||
(and keybindings-meta-mod keybindings-dash keybindings-after-meta-keycode)
|
||||
(:function to-meta-code-string)
|
||||
(:text t))
|
||||
|
||||
|
@ -202,28 +204,28 @@
|
|||
|
||||
;; not part of the actual grammar, just syntactic sugar
|
||||
|
||||
(defrule command-key-1
|
||||
(and command-mod-1 dash keycode)
|
||||
(defrule keybindings-command-key-1
|
||||
(and keybindings-command-mod-1 keybindings-dash keybindings-keycode)
|
||||
(:function to-control-code-string))
|
||||
|
||||
(defrule command-key-2
|
||||
(and command-mod-2 keycode)
|
||||
(defrule keybindings-command-key-2
|
||||
(and keybindings-command-mod-2 keybindings-keycode)
|
||||
(:text t))
|
||||
|
||||
(defrule command-key
|
||||
(or command-key-1
|
||||
command-key-2))
|
||||
(defrule keybindings-command-key
|
||||
(or keybindings-command-key-1
|
||||
keybindings-command-key-2))
|
||||
|
||||
(defrule key
|
||||
(and (or function-placeholder ; keep the order
|
||||
command-key
|
||||
meta-key
|
||||
keycode)
|
||||
(? blanks))
|
||||
(defrule keybindings-key
|
||||
(and (or keybindings-function-placeholder ; keep the order
|
||||
keybindings-command-key
|
||||
keybindings-meta-key
|
||||
keybindings-keycode)
|
||||
(? keybindings-blanks))
|
||||
(:function first))
|
||||
|
||||
(defrule keypath
|
||||
(and key (? keypath))
|
||||
(defrule keybindings-keypath
|
||||
(and keybindings-key (? keybindings-keypath))
|
||||
(:function (lambda (a) (remove-if-null (flatten a)))))
|
||||
|
||||
(defun make-starting-comand-tree ()
|
||||
|
|
Loading…
Reference in New Issue