From 218cd141e420f7f7c87f0f824178f5e465b9f848 Mon Sep 17 00:00:00 2001 From: cage Date: Thu, 22 Jul 2021 14:59:29 +0200 Subject: [PATCH] - allowed selecting a suggestion from suggestion-window; - highlighted matching characters in suggestion window. --- etc/default-theme.conf | 4 ++ src/command-window.lisp | 63 ++++++++++++++++- src/complete-window.lisp | 122 +++++++++++++++++++++++++------- src/complete.lisp | 28 ++++++-- src/package.lisp | 7 +- src/software-configuration.lisp | 9 +++ src/tui-utils.lisp | 22 ++++++ 7 files changed, 220 insertions(+), 35 deletions(-) diff --git a/etc/default-theme.conf b/etc/default-theme.conf index bb5088f..48a2d32 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -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 diff --git a/src/command-window.lisp b/src/command-window.lisp index a0c085e..05ed77d 100644 --- a/src/command-window.lisp +++ b/src/command-window.lisp @@ -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)) diff --git a/src/complete-window.lisp b/src/complete-window.lisp index ec7663e..d07d812 100644 --- a/src/complete-window.lisp +++ b/src/complete-window.lisp @@ -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 () diff --git a/src/complete.lisp b/src/complete.lisp index 61db029..37203b6 100644 --- a/src/complete.lisp +++ b/src/complete.lisp @@ -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) diff --git a/src/package.lisp b/src/package.lisp index f81f8b2..89d442a 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index b9ee8bf..9d7f3f4 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -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+ diff --git a/src/tui-utils.lisp b/src/tui-utils.lisp index 8c674de..5bb92e5 100644 --- a/src/tui-utils.lisp +++ b/src/tui-utils.lisp @@ -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)))