mirror of https://codeberg.org/cage/tinmop/
- changed decoding of events to match changes in croatoan.
This commit is contained in:
cage
parent
a00a363091
commit
3b16fdbbb5
|
|
@ -249,7 +249,7 @@ be either `:keybinding' or `:string'. the former for key command the latter for
|
|||
(defgeneric remove-messages (object))
|
||||
|
||||
(defun event-wants-delete-last-element-p (decoded-event)
|
||||
(or (eq decoded-event :key-backspace)
|
||||
(or (eq decoded-event :backspace)
|
||||
(string= decoded-event "^?")))
|
||||
|
||||
(defun manage-command-event (command-window event)
|
||||
|
|
@ -519,35 +519,35 @@ command line."
|
|||
(move-point-to-start command-window)
|
||||
(set-keybinding-mode command-window)
|
||||
(fire-user-input-event command-window :canceled t))
|
||||
((eq :alt-left original-key-event)
|
||||
((eq :alt-left decoded-event)
|
||||
(move-suggestion-page-left command-window))
|
||||
((eq :alt-right original-key-event)
|
||||
((eq :alt-right decoded-event)
|
||||
(move-suggestion-page-right command-window))
|
||||
((event-wants-delete-last-element-p decoded-event)
|
||||
(setf command-line (delete-at-point command-window command-line :direction :left))
|
||||
(when 'hooks:*after-char-to-command-window*
|
||||
(hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window))
|
||||
(show-candidate-completion command-window))
|
||||
((eq :key-delete-char original-key-event)
|
||||
((eq :delete decoded-event)
|
||||
(setf command-line (delete-at-point command-window command-line :direction :right))
|
||||
(when 'hooks:*after-char-to-command-window*
|
||||
(hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window))
|
||||
(show-candidate-completion command-window))
|
||||
((eq :key-arrow-left original-key-event)
|
||||
((eq :left decoded-event)
|
||||
(move-point-left command-window))
|
||||
((eq :key-arrow-right original-key-event)
|
||||
((eq :right decoded-event)
|
||||
(move-point-right command-window (length command-line)))
|
||||
((eq :key-end original-key-event)
|
||||
((eq :end decoded-event)
|
||||
(move-point-to-end command-window command-line))
|
||||
((eq :key-home original-key-event)
|
||||
((eq :home decoded-event)
|
||||
(move-point-to-start command-window))
|
||||
((eq :key-arrow-up original-key-event)
|
||||
((eq :up decoded-event)
|
||||
(if (win-shown-p suggestions-win)
|
||||
(select-suggestion-previous command-window)
|
||||
(multiple-value-bind (new-id new-input)
|
||||
(db:previous-in-history history-position prompt)
|
||||
(set-history new-id new-input))))
|
||||
((eq :key-arrow-down original-key-event)
|
||||
((eq :down decoded-event)
|
||||
(if (win-shown-p suggestions-win)
|
||||
(select-suggestion-next command-window)
|
||||
(multiple-value-bind (new-id new-input)
|
||||
|
|
|
|||
|
|
@ -52,15 +52,6 @@
|
|||
;; |'f8'
|
||||
;; |'f9'
|
||||
;; |'f10
|
||||
;; | 'key-arrow-right'
|
||||
;; | 'key-arrow-left'
|
||||
;; | 'key-arrow-up'
|
||||
;; | 'key-arrow-down'
|
||||
;; | 'key-home'
|
||||
;; | 'key-end'
|
||||
;; | 'key-next-page'
|
||||
;; | 'key-previous-page'
|
||||
;; | 'key-delete-char'
|
||||
;; | ARROW-RIGHT
|
||||
;; | ARROW-LEFT
|
||||
;; | ARROW-UP
|
||||
|
|
@ -105,31 +96,40 @@
|
|||
(:text t))
|
||||
|
||||
(defrule keybindings-arrow-right "right"
|
||||
(:constant "key-arrow-right"))
|
||||
(:constant "right")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-arrow-left "left"
|
||||
(:constant "key-arrow-left"))
|
||||
(:constant "left")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-arrow-up "up"
|
||||
(:constant "key-arrow-up"))
|
||||
(:constant "up")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-arrow-down "down"
|
||||
(:constant "key-arrow-down"))
|
||||
(:constant "down")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-key-home "home"
|
||||
(:constant "key-home"))
|
||||
(:constant "home")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-key-end "end"
|
||||
(:constant "key-end"))
|
||||
(:constant "end")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-key-next-page "npage"
|
||||
(:constant "key-next-page"))
|
||||
(:constant "page-down")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-key-previous-page "ppage"
|
||||
(:constant "key-previous-page"))
|
||||
(:constant "page-up")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-key-delete-next-char "dc"
|
||||
(:constant "key-delete-char"))
|
||||
(:constant "delete-char")
|
||||
(:function string-upcase))
|
||||
|
||||
(defrule keybindings-non-printable-key
|
||||
(or "f10"
|
||||
|
|
@ -142,15 +142,13 @@
|
|||
"f7"
|
||||
"f8"
|
||||
"f9"
|
||||
"key-arrow-right"
|
||||
"key-arrow-left"
|
||||
"key-arrow-up"
|
||||
"key-arrow-down"
|
||||
"key-home"
|
||||
"key-end"
|
||||
"key-next-page"
|
||||
"key-previous-page"
|
||||
"key-delete-char"
|
||||
"right"
|
||||
"left"
|
||||
"up"
|
||||
"down"
|
||||
"home"
|
||||
"end"
|
||||
"delete-char"
|
||||
keybindings-arrow-right
|
||||
keybindings-arrow-left
|
||||
keybindings-arrow-up
|
||||
|
|
@ -523,19 +521,17 @@ understand"
|
|||
(function-name key)))
|
||||
((string= key "^J")
|
||||
(_ "Enter"))
|
||||
((or (string= key "KEY-DELETE-CHAR")
|
||||
((or (string= key "DELETE-CHAR")
|
||||
(string= key "DC"))
|
||||
(_ "Delete"))
|
||||
((or (string= key "KEY-NEXT-PAGE")
|
||||
(string= key "NPAGE"))
|
||||
((string= key "PAGE-DOWN")
|
||||
(_ "Page-up"))
|
||||
((or (string= key "KEY-PREVIOUS-PAGE")
|
||||
(string= key "PPAGE"))
|
||||
((string= key "PAGE-UP")
|
||||
(_ "Page-down"))
|
||||
((or (string= key "KEY-ARROW-DOWN")
|
||||
((or (string= key "ARROW-DOWN")
|
||||
(string= key "UP"))
|
||||
(_ "Arrow up"))
|
||||
((or (string= key "KEY-ARROW-UP")
|
||||
((or (string= key "ARROW-UP")
|
||||
(string= key "DOWN"))
|
||||
(_ "Arrow down"))
|
||||
(t
|
||||
|
|
|
|||
|
|
@ -516,7 +516,7 @@ will fire the `callback' function (with the selected field from `all-fields'
|
|||
(window-height (min (truncate (* 0.9 (win-height screen)))
|
||||
(+ (max (length text-lines)
|
||||
+min-shown-win-height+)
|
||||
2)))
|
||||
2)))
|
||||
(window-x (truncate (- (* 0.5 (win-width screen))
|
||||
(* 0.5 window-width))))
|
||||
(window-y (truncate (- (* 0.5 (win-height screen))
|
||||
|
|
@ -537,34 +537,35 @@ will fire the `callback' function (with the selected field from `all-fields'
|
|||
(win-move high-level-window window-x window-y)
|
||||
(setf (rows high-level-window)
|
||||
(loop
|
||||
for text in text-lines
|
||||
for fields in all-fields
|
||||
collect
|
||||
(make-instance 'line
|
||||
:fields fields
|
||||
:normal-text text
|
||||
:selected-text text
|
||||
:normal-bg bg
|
||||
:normal-fg fg
|
||||
:selected-bg fg
|
||||
:selected-fg bg)))
|
||||
for text in text-lines
|
||||
for fields in all-fields
|
||||
collect
|
||||
(make-instance 'line
|
||||
:fields fields
|
||||
:normal-text text
|
||||
:selected-text text
|
||||
:normal-bg bg
|
||||
:normal-fg fg
|
||||
:selected-bg fg
|
||||
:selected-fg bg)))
|
||||
(select-row high-level-window 0)
|
||||
(draw)
|
||||
(loop named inner
|
||||
for c = (tui:decode-key-event (c:get-wide-event low-level-window))
|
||||
for c = (tui:decode-key-event (c:get-wide-event low-level-window)
|
||||
:convert-symbol-to-string nil)
|
||||
while (not (event-quit-blocking-list-dialog-window-p c))
|
||||
do
|
||||
(cond
|
||||
((string= c :key-arrow-up)
|
||||
(unselect-all high-level-window)
|
||||
(row-move high-level-window -1))
|
||||
((string= c :key-arrow-down)
|
||||
(unselect-all high-level-window)
|
||||
(row-move high-level-window 1))
|
||||
((string= c "^J")
|
||||
(let ((selected-fields (selected-row-fields high-level-window))
|
||||
(selected-text (selected-text (selected-row high-level-window))))
|
||||
(when callback
|
||||
(funcall callback selected-text selected-fields)))))
|
||||
(draw))
|
||||
(cond
|
||||
((string= c :up)
|
||||
(unselect-all high-level-window)
|
||||
(row-move high-level-window -1))
|
||||
((string= c :down)
|
||||
(unselect-all high-level-window)
|
||||
(row-move high-level-window 1))
|
||||
((string= c "^J")
|
||||
(let ((selected-fields (selected-row-fields high-level-window))
|
||||
(selected-text (selected-text (selected-row high-level-window))))
|
||||
(when callback
|
||||
(funcall callback selected-text selected-fields)))))
|
||||
(draw))
|
||||
(win-close high-level-window))))
|
||||
|
|
|
|||
|
|
@ -96,17 +96,23 @@ as argument `complex-string'."
|
|||
(length (complex-char-array complex-string)))
|
||||
|
||||
(defun decode-key-event (event &key (convert-symbol-to-string t))
|
||||
(let* ((key (croatoan:event-key event))
|
||||
(decoded-event (cond
|
||||
((characterp key)
|
||||
(key-to-string key))
|
||||
((symbolp key)
|
||||
(if convert-symbol-to-string
|
||||
(symbol-name key)
|
||||
key))
|
||||
(t
|
||||
(error (_ "Unknown key event ~a") key)))))
|
||||
(values decoded-event key)))
|
||||
(labels ((decode-event (key)
|
||||
(cond
|
||||
((characterp key)
|
||||
(key-to-string key))
|
||||
((symbolp key)
|
||||
(if convert-symbol-to-string
|
||||
(string-upcase (symbol-name key))
|
||||
key))
|
||||
((croatoan:key-p key)
|
||||
(decode-event (croatoan:key-name key)))
|
||||
(t
|
||||
(error (_ "Unknown key event ~a") key)))))
|
||||
|
||||
(let* ((key (croatoan:event-key event))
|
||||
(decoded-event (decode-event key)))
|
||||
#+debug-croatoan-events (misc:dbg "event ~s" decoded-event)
|
||||
(values decoded-event key))))
|
||||
|
||||
(defun colorize-tree-element (color-map annotated-element)
|
||||
"Colormap is an alist like:
|
||||
|
|
|
|||
|
|
@ -201,3 +201,4 @@
|
|||
;; (push :debug-sql *features*)
|
||||
;; (push :debug-gemini-request *features*)
|
||||
;; (push :debug-json-rpc *features*)
|
||||
;; (push :debug-croatoan-events *features*)
|
||||
|
|
|
|||
Loading…
Reference in New Issue