mirror of https://codeberg.org/cage/tinmop/
160 lines
7.7 KiB
Common Lisp
160 lines
7.7 KiB
Common Lisp
;; tinmop: a multiprotocol client
|
|
;; Copyright © cage
|
|
|
|
;; 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)
|
|
|
|
(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"))
|
|
|
|
(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)
|
|
|
|
(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*'."
|
|
(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)))))))
|
|
|
|
(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
|
|
(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)))
|
|
(win-refresh object))))
|
|
|
|
(defun init ()
|
|
"Initialize a complete window"
|
|
(let* ((low-level-window (make-croatoan-window :border t))
|
|
(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))
|