cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- tracked incompatible changes from croatoan; 

An event  is no  more a character  or symbol but  is an  instabce of
  class 'event'.
This commit is contained in:
cage 2021-12-26 13:03:47 +01:00
parent 50bf7a8716
commit a29c6aa058
3 changed files with 75 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
quick_quicklisp.sh.in
View File

@ -43,7 +43,7 @@ CROATOAN_GIT_URL=https://github.com/McParen/croatoan.git
CROATOAN_DIR="$QUICKLISP_INSTALL_DIR"/local-projects/croatoan/; CROATOAN_DIR="$QUICKLISP_INSTALL_DIR"/local-projects/croatoan/;
CROATOAN_COMMIT=cf875137a23ed4efbfde63e52691f1b544d55d17 CROATOAN_COMMIT=000c60428fe73d796d4ee032cfa5901eb57b4703
echo_bold () { echo_bold () {
echo -e "${BOLD_TEXT}${1}${NORMAL_TEXT}"; echo -e "${BOLD_TEXT}${1}${NORMAL_TEXT}";

127
src/command-window.lisp
View File

@ -492,68 +492,71 @@ command line."
(insert-in-history (prompt command-line) (insert-in-history (prompt command-line)
(db:insert-in-history prompt command-line) (db:insert-in-history prompt command-line)
(set-history-most-recent command-window prompt))) (set-history-most-recent command-window prompt)))
(remove-messages command-window) (multiple-value-bind (decoded-event original-key-event)
(cond (decode-key-event event)
((string= (decode-key-event event) "^K") (cond
(setf command-line (safe-subseq command-line 0 (no-prompt-point-pos command-window)))) ((string= decoded-event "^K")
((eq :alt-left event) (setf command-line (safe-subseq command-line 0 (no-prompt-point-pos command-window))))
(move-suggestion-page-left command-window)) ((eq :alt-left original-key-event)
((eq :alt-right event) (move-suggestion-page-left command-window))
(move-suggestion-page-right command-window)) ((eq :alt-right original-key-event)
((eq :backspace event) (move-suggestion-page-right command-window))
(setf command-line (delete-at-point command-window command-line :direction :left)) ((eq :backspace original-key-event)
(when 'hooks:*after-char-to-command-window* (setf command-line (delete-at-point command-window command-line :direction :left))
(hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window)) (when 'hooks:*after-char-to-command-window*
(show-candidate-completion command-window)) (hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window))
((eq :dc event) (show-candidate-completion command-window))
(setf command-line (delete-at-point command-window command-line :direction :right)) ((eq :dc original-key-event)
(when 'hooks:*after-char-to-command-window* (setf command-line (delete-at-point command-window command-line :direction :right))
(hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window)) (when 'hooks:*after-char-to-command-window*
(show-candidate-completion command-window)) (hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window))
((eq :left event) (show-candidate-completion command-window))
(move-point-left command-window)) ((eq :left original-key-event)
((eq :right event) (move-point-left command-window))
(move-point-right command-window (length command-line))) ((eq :right original-key-event)
((eq :end event) (move-point-right command-window (length command-line)))
(move-point-to-end command-window command-line)) ((eq :end original-key-event)
((eq :home event) (move-point-to-end command-window command-line))
(move-point-to-start command-window)) ((eq :home original-key-event)
((eq :up event) (move-point-to-start command-window))
(if (win-shown-p suggestions-win) ((eq :up original-key-event)
(select-suggestion-previous command-window) (if (win-shown-p suggestions-win)
(multiple-value-bind (new-id new-input) (select-suggestion-previous command-window)
(db:previous-in-history history-position prompt) (multiple-value-bind (new-id new-input)
(set-history new-id new-input)))) (db:previous-in-history history-position prompt)
((eq :down event) (set-history new-id new-input))))
(if (win-shown-p suggestions-win) ((eq :down original-key-event)
(select-suggestion-next command-window) (if (win-shown-p suggestions-win)
(multiple-value-bind (new-id new-input) (select-suggestion-next command-window)
(db:next-in-history history-position prompt) (multiple-value-bind (new-id new-input)
(set-history new-id new-input)))) (db:next-in-history history-position prompt)
((characterp event) (set-history new-id new-input))))
(cond ((characterp original-key-event)
((char= #\Newline event) (cond
(when 'hooks:*before-fire-string-event-command-window* ((char= #\Newline original-key-event)
(hooks:run-hook 'hooks:*before-fire-string-event-command-window* (when 'hooks:*before-fire-string-event-command-window*
command-window)) (hooks:run-hook 'hooks:*before-fire-string-event-command-window*
(insert-in-history prompt command-line) command-window))
(fire-user-input-event command-window) (insert-in-history prompt command-line)
(setf command-line nil) (fire-user-input-event command-window)
(move-point-to-start command-window) (setf command-line nil)
(set-keybinding-mode command-window)) (move-point-to-start command-window)
((char= #\Tab event) (set-keybinding-mode command-window))
(complete-at-point command-window)) ((char= #\Tab original-key-event)
(t (complete-at-point command-window))
(if (null suggestions-win) (t
(setf suggestions-win (complete-window:init)) (if (null suggestions-win)
(complete-window:reset-selected-item suggestions-win)) (setf suggestions-win (complete-window:init))
(win-show suggestions-win) (complete-window:reset-selected-item suggestions-win))
(setf command-line (win-show suggestions-win)
(insert-at-point command-window event command-line)) (setf command-line
(when 'hooks:*after-char-to-command-window* (insert-at-point command-window original-key-event command-line))
(hooks:run-hook 'hooks:*after-char-to-command-window* (when 'hooks:*after-char-to-command-window*
command-window)) (hooks:run-hook 'hooks:*after-char-to-command-window*
(show-candidate-completion command-window))))))) command-window))
(show-candidate-completion command-window))))
(t
(misc:dbg "unknow ~s ~a" decoded-event (type-of decoded-event)))))))
command-window) command-window)
(defun set-input-mode (win mode suggestions-cached-win) (defun set-input-mode (win mode suggestions-cached-win)

16
src/tui-utils.lisp
View File

@ -96,13 +96,15 @@ as argument `complex-string'."
(length (complex-char-array complex-string))) (length (complex-char-array complex-string)))
(defun decode-key-event (event) (defun decode-key-event (event)
(cond (let* ((key (croatoan:event-key event))
((characterp event) (decoded-event (cond
(key-to-string event)) ((characterp key)
((symbolp event) (key-to-string key))
(symbol-name event)) ((symbolp key)
(t (symbol-name key))
(error (_ "Unknown event ~a") event)))) (t
(error (_ "Unknown key event ~a") key)))))
(values decoded-event key)))
(defun colorize-tree-element (color-map annotated-element) (defun colorize-tree-element (color-map annotated-element)
"Colormap is an alist like: "Colormap is an alist like: