mirror of
https://codeberg.org/cage/tinmop/
synced 2024-12-14 22:54:02 +01:00
- allowed selecting a suggestion from suggestion-window;
- highlighted matching characters in suggestion window.
This commit is contained in:
cage
parent
677a6bac43
commit
218cd141e4
@ -388,6 +388,10 @@ suggestions-window.background = blue
|
||||
|
||||
suggestions-window.foreground = yellow
|
||||
|
||||
suggestions-window.selected.foreground = black
|
||||
|
||||
suggestions-window.selected.background = #ffa100
|
||||
|
||||
suggestions-window.height = 1/4
|
||||
|
||||
# the directive belows configure the window at the very bottom of the
|
||||
|
||||
@ -370,7 +370,7 @@ be either `:keybinding' or `:string'. the former for key command the latter for
|
||||
(setf (error-message object) nil))
|
||||
|
||||
(defun move-suggestion-page (win offset)
|
||||
"Paginate win (suggestion window) by offset, will not go past the numer of pages."
|
||||
"Paginate win (suggestion window) by offset, will not go past the number of pages."
|
||||
(with-accessors ((suggestions-win suggestions-win)) win
|
||||
(when suggestions-win
|
||||
(with-accessors ((current-page suggestions-window:current-page)
|
||||
@ -386,6 +386,57 @@ be either `:keybinding' or `:string'. the former for key command the latter for
|
||||
(defun move-suggestion-page-right (win)
|
||||
(move-suggestion-page win 1))
|
||||
|
||||
(defun select-suggestion (win offset)
|
||||
"Paginate win (suggestion window) by offset, will not go past the number of pages."
|
||||
(with-accessors ((suggestions-win suggestions-win)) win
|
||||
(when suggestions-win
|
||||
(with-accessors ((current-page suggestions-window:current-page)
|
||||
(paginated-info suggestions-window:paginated-info)
|
||||
(selected-item-row-index complete-window:selected-item-row-index)
|
||||
(selected-item-column-index complete-window:selected-item-column-index))
|
||||
suggestions-win
|
||||
(incf selected-item-row-index offset)
|
||||
(let* ((columns (elt paginated-info current-page))
|
||||
(columns-count (length columns))
|
||||
(column (elt columns selected-item-column-index))
|
||||
(rows-count (length column)))
|
||||
(cond
|
||||
((< selected-item-row-index 0)
|
||||
(decf selected-item-column-index)
|
||||
(when (< selected-item-column-index 0)
|
||||
(setf selected-item-column-index
|
||||
(1- (length columns))))
|
||||
(let* ((previous-column (elt columns selected-item-column-index))
|
||||
(previous-column-size (length previous-column)))
|
||||
(setf selected-item-row-index (1- previous-column-size))))
|
||||
((>= selected-item-row-index rows-count)
|
||||
(setf selected-item-row-index complete-window:+starting-item-index+)
|
||||
(setf selected-item-column-index
|
||||
(+ complete-window:+starting-item-index+
|
||||
(rem (1+ selected-item-column-index) columns-count))))))))))
|
||||
|
||||
(defun select-suggestion-next (win)
|
||||
(select-suggestion win -1))
|
||||
|
||||
(defun select-suggestion-previous (win)
|
||||
(select-suggestion win 1))
|
||||
|
||||
(defun insert-selected-suggestion (win)
|
||||
(with-accessors ((suggestions-win suggestions-win)
|
||||
(command-line command-line)) win
|
||||
(when suggestions-win
|
||||
(with-accessors ((current-page suggestions-window:current-page)
|
||||
(paginated-info suggestions-window:paginated-info)
|
||||
(selected-item-row-index complete-window::selected-item-row-index)
|
||||
(selected-item-column-index complete-window::selected-item-column-index))
|
||||
suggestions-win
|
||||
(let* ((columns (elt paginated-info current-page))
|
||||
(column (elt columns selected-item-column-index))
|
||||
(suggestion (trim-blanks (elt column selected-item-row-index))))
|
||||
(setf command-line suggestion)
|
||||
(move-point-to-end win command-line)
|
||||
(win-hide suggestions-win))))))
|
||||
|
||||
(defun fire-user-input-event (win)
|
||||
"Generates an event to notify that the user inserted an input on the
|
||||
command line."
|
||||
@ -423,10 +474,16 @@ command line."
|
||||
(set-history-most-recent command-window prompt)))
|
||||
(remove-messages command-window)
|
||||
(cond
|
||||
((eq :control-left event)
|
||||
((eq :alt-left event)
|
||||
(move-suggestion-page-left command-window))
|
||||
((eq :control-right event)
|
||||
((eq :alt-right event)
|
||||
(move-suggestion-page-right command-window))
|
||||
((eq :alt-up event)
|
||||
(select-suggestion-next command-window))
|
||||
((eq :alt-down event)
|
||||
(select-suggestion-previous command-window))
|
||||
((eq :alt-i event)
|
||||
(insert-selected-suggestion command-window))
|
||||
((eq :backspace event)
|
||||
(setf command-line (delete-at-point command-window command-line :direction :left))
|
||||
(show-candidate-completion command-window))
|
||||
|
||||
@ -16,48 +16,118 @@
|
||||
|
||||
(in-package :complete-window)
|
||||
|
||||
(define-constant +starting-item-index+ 0)
|
||||
|
||||
(defclass complete-window (suggestions-window)
|
||||
()
|
||||
((selected-item-row-index
|
||||
:initform +starting-item-index+
|
||||
:accessor selected-item-row-index)
|
||||
(selected-item-column-index
|
||||
:initform +starting-item-index+
|
||||
:accessor selected-item-column-index)
|
||||
(pagination-info-matched
|
||||
:initform nil
|
||||
:initarg :paginated-info-matched
|
||||
:accessor paginated-info-matched)
|
||||
(foreground-selected-item
|
||||
:initform nil
|
||||
:initarg :foreground-selected-item
|
||||
:accessor foreground-selected-item)
|
||||
(background-selected-item
|
||||
:initform nil
|
||||
:initarg :background-selected-item
|
||||
:accessor background-selected-item))
|
||||
(:documentation "A window to shows the possible completion for an
|
||||
user input"))
|
||||
|
||||
(defmethod calculate ((object complete-window) dt)
|
||||
(declare (ignore object dt)))
|
||||
|
||||
(defmethod refresh-config :after ((object complete-window))
|
||||
(with-accessors ((foreground-selected-item foreground-selected-item)
|
||||
(background-selected-item background-selected-item)) object
|
||||
(multiple-value-bind (bg fg)
|
||||
(swconf:suggestion-window-selected-item-colors)
|
||||
(setf foreground-selected-item fg
|
||||
background-selected-item bg)
|
||||
object)))
|
||||
|
||||
(defmethod update-suggestions ((object complete-window) hint &key &allow-other-keys)
|
||||
"List the possible expansion of `hint' using the function
|
||||
`complete:*complete-function*'."
|
||||
(with-accessors ((paginated-info paginated-info)) object
|
||||
(multiple-value-bind (candidates common-prefix)
|
||||
(funcall complete:*complete-function* hint)
|
||||
(when candidates
|
||||
(when-let ((batches (text-utils:box-fit-multiple-column candidates
|
||||
(- (win-width object) 2)
|
||||
(- (win-height object)
|
||||
+box-height-diff+))))
|
||||
(setf paginated-info batches)
|
||||
(values candidates common-prefix))))))
|
||||
(flet ((partitions (template data)
|
||||
(when data
|
||||
(let ((ct 0))
|
||||
(loop for page in template
|
||||
collect
|
||||
(loop for column in page
|
||||
collect
|
||||
(loop for row in column
|
||||
collect
|
||||
(prog1
|
||||
(elt data ct)
|
||||
(incf ct)))))))))
|
||||
(with-accessors ((paginated-info paginated-info)
|
||||
(paginated-info-matched paginated-info-matched)) object
|
||||
(multiple-value-bind (candidates common-prefix underline-char-indices)
|
||||
(funcall complete:*complete-function* hint)
|
||||
(when candidates
|
||||
(let* ((batches (text-utils:box-fit-multiple-column candidates
|
||||
(- (win-width object) 2)
|
||||
(- (win-height object)
|
||||
+box-height-diff+)))
|
||||
(padding-size (- (length candidates)
|
||||
(length underline-char-indices)))
|
||||
(padding (when (> padding-size 0)
|
||||
(make-list padding-size :initial-element nil)))
|
||||
(underline-batch (partitions batches (append underline-char-indices padding))))
|
||||
(setf paginated-info batches)
|
||||
(setf paginated-info-matched underline-batch)
|
||||
(values candidates common-prefix underline-batch)))))))
|
||||
|
||||
(defmethod draw :after ((object complete-window))
|
||||
(with-accessors ((keybindings-tree keybindings-tree)
|
||||
(paginated-info paginated-info)
|
||||
(current-page current-page)) object
|
||||
(with-accessors ((keybindings-tree keybindings-tree)
|
||||
(paginated-info paginated-info)
|
||||
(paginated-info-matched paginated-info-matched)
|
||||
(current-page current-page)
|
||||
(selected-item-row-index selected-item-row-index)
|
||||
(selected-item-column-index selected-item-column-index)
|
||||
(foreground-selected-item foreground-selected-item)
|
||||
(background-selected-item background-selected-item)) object
|
||||
(when-window-shown (object)
|
||||
(win-clear object :redraw nil)
|
||||
(win-box object)
|
||||
(when paginated-info
|
||||
(loop
|
||||
for column in (elt paginated-info current-page)
|
||||
with column-count = 1
|
||||
do
|
||||
(let ((column-size (length (first column))))
|
||||
(loop
|
||||
for row in column
|
||||
with row-count = 1 do
|
||||
(print-text object row column-count row-count)
|
||||
(incf row-count))
|
||||
(incf column-count column-size)))
|
||||
(draw-pagination-info object))
|
||||
(let ((columns (elt paginated-info current-page))
|
||||
(indices-matched (elt paginated-info-matched current-page))
|
||||
(matched-attributes (combine-attributes (attribute-bold)
|
||||
(attribute-underline))))
|
||||
(loop
|
||||
for column in columns
|
||||
for column-indices in indices-matched
|
||||
for column-count from 0
|
||||
with column-offset = 1
|
||||
do
|
||||
(let ((column-size (length (first column))))
|
||||
(loop
|
||||
for row in column
|
||||
for indices-row-underlined in column-indices
|
||||
with row-count = 1 do
|
||||
(let ((text (if (and (= row-count (1+ selected-item-row-index))
|
||||
(= column-count selected-item-column-index))
|
||||
(make-tui-string row
|
||||
:fgcolor foreground-selected-item
|
||||
:bgcolor background-selected-item)
|
||||
(make-tui-string row))))
|
||||
(print-text object
|
||||
(apply-attributes text
|
||||
indices-row-underlined
|
||||
matched-attributes)
|
||||
column-offset
|
||||
row-count))
|
||||
(incf row-count))
|
||||
(incf column-offset column-size)))
|
||||
(draw-pagination-info object)))
|
||||
(win-refresh object))))
|
||||
|
||||
(defun init ()
|
||||
|
||||
@ -181,13 +181,31 @@ list af all possible candidtae for completion."
|
||||
|
||||
(with-simple-complete conversation-folder db:all-conversation-folders)
|
||||
|
||||
(defun uri-matcher (scanner bag &optional (accum-strings '()) (accum-indices '()))
|
||||
(if (null bag)
|
||||
(values accum-strings accum-indices)
|
||||
(let ((tested (first bag)))
|
||||
(multiple-value-bind (start end)
|
||||
(cl-ppcre:scan scanner tested)
|
||||
(if start
|
||||
(uri-matcher scanner
|
||||
(rest bag)
|
||||
(push tested accum-strings)
|
||||
(push (loop for i from start below end collect i)
|
||||
accum-indices))
|
||||
(uri-matcher scanner (rest bag) accum-strings accum-indices))))))
|
||||
|
||||
(defun make-complete-gemini-iri-fn (prompt)
|
||||
(lambda (hint)
|
||||
(when-let ((matched (remove-if-not (contains-clsr hint)
|
||||
(remove-duplicates (funcall #'db:history-prompt->values
|
||||
prompt)
|
||||
:test #'string=))))
|
||||
(values matched (reduce-to-common-prefix matched)))))
|
||||
(when-let ((bag (remove-duplicates (funcall #'db:history-prompt->values
|
||||
prompt)
|
||||
:test #'string=)))
|
||||
(multiple-value-bind (matched-strings indices)
|
||||
(uri-matcher (cl-ppcre:create-scanner hint) bag)
|
||||
(when matched-strings
|
||||
(values matched-strings
|
||||
(reduce-to-common-prefix matched-strings)
|
||||
indices))))))
|
||||
|
||||
(defun complete-chat-message (hint)
|
||||
(append (username-complete hint)
|
||||
|
||||
@ -1113,6 +1113,7 @@
|
||||
:load-config-file
|
||||
:external-editor
|
||||
:gemini-downloading-animation
|
||||
:suggestion-window-selected-item-colors
|
||||
:gemini-default-favicon
|
||||
:directory-symbol
|
||||
:gemini-fetch-favicon-p
|
||||
@ -1240,7 +1241,8 @@
|
||||
:with-notify-errors
|
||||
:with-print-error-message
|
||||
:make-tui-char
|
||||
:make-tui-string))
|
||||
:make-tui-string
|
||||
:apply-attributes))
|
||||
|
||||
(defpackage :command-line
|
||||
(:use
|
||||
@ -1737,7 +1739,10 @@
|
||||
(:shadowing-import-from :text-utils :split-lines)
|
||||
(:shadowing-import-from :misc :random-elt :shuffle)
|
||||
(:export
|
||||
:+starting-item-index+
|
||||
:complete-window
|
||||
:selected-item-row-index
|
||||
:selected-item-column-index
|
||||
:init))
|
||||
|
||||
(defpackage :keybindings-window
|
||||
|
||||
@ -564,6 +564,15 @@
|
||||
(access-key->user-directive keys))))
|
||||
value)))
|
||||
|
||||
(defun suggestion-window-selected-item-colors ()
|
||||
(values (access-non-null-conf-value *software-configuration*
|
||||
+key-suggestions-window+
|
||||
+key-selected+
|
||||
+key-background+)
|
||||
(access-non-null-conf-value *software-configuration*
|
||||
+key-suggestions-window+
|
||||
+key-selected+
|
||||
+key-foreground+)))
|
||||
(defun gemini-downloading-animation ()
|
||||
(let ((animation (access-non-null-conf-value *software-configuration*
|
||||
+key-gemini+
|
||||
|
||||
@ -412,6 +412,28 @@ latter has a length equals to `total-size'"))
|
||||
last-char-bg))))
|
||||
res))))
|
||||
|
||||
(defgeneric apply-attributes (object index attributes))
|
||||
|
||||
(defmethod apply-attributes ((object complex-string) (index fixnum) attributes)
|
||||
(let ((char (elt (complex-char-array object) index)))
|
||||
(setf (attributes char) attributes)
|
||||
object))
|
||||
|
||||
(defmethod apply-attributes ((object string) (index fixnum) attributes)
|
||||
(apply-attributes (make-tui-string object) index attributes))
|
||||
|
||||
(defmethod apply-attributes ((object string) (index list) attributes)
|
||||
(apply-attributes (make-tui-string object) index attributes))
|
||||
|
||||
(defmethod apply-attributes ((object complex-string) (index list) attributes)
|
||||
(if (null index)
|
||||
object
|
||||
(let ((partial (apply-attributes object (first index) attributes)))
|
||||
(apply-attributes partial (rest index) attributes))))
|
||||
|
||||
(defmethod apply-attributes (object (index null) attributes)
|
||||
object)
|
||||
|
||||
(defmethod remove-corrupting-utf8-chars ((object complex-string))
|
||||
(setf (complex-char-array object)
|
||||
(remove-if (lambda (a) (display-corrupting-utf8-p (simple-char a)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user