1
0
Fork 0
tinmop/src/complete-window.lisp

160 lines
7.7 KiB
Common Lisp
Raw Normal View History

;; tinmop: a multiprotocol client
2023-10-19 17:46:22 +02:00
;; Copyright © cage
2020-05-08 15:45:43 +02:00
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :complete-window)
(define-constant +starting-item-index+ 0)
2020-05-08 15:45:43 +02:00
(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))
2020-05-08 15:45:43 +02:00
(:documentation "A window to shows the possible completion for an
user input"))
(defun reset-selected-item (complete-win)
(setf (selected-item-column-index complete-win) +starting-item-index+
(selected-item-row-index complete-win) +starting-item-index+)
complete-win)
2020-05-08 15:45:43 +02:00
(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)))
2020-05-08 15:45:43 +02:00
(defmethod update-suggestions ((object complete-window) hint &key &allow-other-keys)
"List the possible expansion of `hint' using the function
`complete:*complete-function*'."
(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* ((max-string-size (max 1 (floor (/ (win-width-no-border object) 2.5))))
(truncate-fn (lambda (batch)
(mapcar (lambda (a)
(safe-subseq a
0
max-string-size))
batch)))
(batches (handler-bind ((conditions:out-of-bounds
(lambda (e)
(declare (ignore e))
(invoke-restart 'truncate))))
(text-utils:box-fit-multiple-column candidates
(- (win-width object) 2)
(- (win-height object)
+box-height-diff+)
:truncate-restart-fn
truncate-fn)))
(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)))))))
2020-05-08 15:45:43 +02:00
(defmethod draw :after ((object complete-window))
(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
2020-05-08 15:45:43 +02:00
(when-window-shown (object)
(win-clear object :redraw nil)
(win-box object)
(when paginated-info
(let ((columns (elt paginated-info current-page))
(indices-matched (elt paginated-info-matched current-page))
(matched-attributes (combine-attributes (attribute-bold)
(attribute-underline)
(attribute-reverse))))
(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)))
(tui-text (handler-case
(apply-attributes text
indices-row-underlined
matched-attributes)
(error () text))))
(print-text object tui-text column-offset row-count))
(incf row-count))
(incf column-offset column-size)))
(draw-pagination-info object)))
2020-05-08 15:45:43 +02:00
(win-refresh object))))
(defun init ()
"Initialize a complete window"
(let* ((low-level-window (make-croatoan-window :border t))
2020-05-08 15:45:43 +02:00
(high-level-window (make-instance 'complete-window
:croatoan-window low-level-window)))
(refresh-config high-level-window)
(win-hide high-level-window)
high-level-window))