mirror of https://codeberg.org/cage/tinmop/
85 lines
4.0 KiB
Common Lisp
85 lines
4.0 KiB
Common Lisp
(in-package :client-search-frame)
|
|
|
|
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
|
|
|
|
(defclass search-frame (gui:frame)
|
|
((entry
|
|
:initform nil
|
|
:initarg :entry
|
|
:accessor entry)
|
|
(button-next
|
|
:initform nil
|
|
:initarg :button-next
|
|
:accessor button-next)
|
|
(button-previous
|
|
:initform nil
|
|
:initarg :button-previous
|
|
:accessor button-previous)
|
|
(matches
|
|
:initform nil
|
|
:initarg :matches
|
|
:accessor matches)
|
|
(counter
|
|
:initform 0
|
|
:initarg :counter
|
|
:accessor counter)))
|
|
|
|
(defun start-search-clsr (search-frame gemtext-widget case-sensitive)
|
|
(lambda (e)
|
|
(declare (ignore e))
|
|
(loop for match in (matches search-frame) do
|
|
(gui:tag-delete gemtext-widget (gui:match-tag-name match)))
|
|
(let ((tags (gui:search-all-text gemtext-widget
|
|
(gui:text (entry search-frame))
|
|
:case-insensitive
|
|
case-sensitive)))
|
|
(setf (matches search-frame) (nreverse tags)))
|
|
(loop for match in (matches search-frame) do
|
|
(gui:tag-configure gemtext-widget
|
|
(gui:match-tag-name match)
|
|
:foreground (gui:cget gemtext-widget
|
|
:selectforeground)
|
|
:background (gui:cget gemtext-widget
|
|
:selectbackground)))))
|
|
(defun init-window (main-window)
|
|
(let* ((frame (make-instance 'search-frame :master main-window))
|
|
(gemtext-widget (client-main-window::gemtext-widget main-window))
|
|
(search-label (make-instance 'gui:label :master frame :text (_ "Search: ")))
|
|
(case-sensitive-checkbox (make-instance 'gui:check-button
|
|
:master frame
|
|
:text (_ "Case sensitive")))
|
|
(button-close (make-instance 'gui:button :image icons:*cross*
|
|
:master frame)))
|
|
(setf (entry frame) (make-instance 'gui:entry :master frame))
|
|
(setf (button-next frame) (make-instance 'gui:button :image icons:*arrow-down*
|
|
:master frame))
|
|
(setf (button-previous frame) (make-instance 'gui:button :image icons:*arrow-up*
|
|
:master frame))
|
|
(gui:grid search-label 0 0 :sticky :news :padx +minimum-padding+)
|
|
(gui:grid (entry frame) 0 1 :sticky :news :padx +minimum-padding+)
|
|
(gui:grid (button-previous frame) 0 2 :sticky :nw :padx +minimum-padding+)
|
|
(gui:grid (button-next frame) 0 3 :sticky :nw :padx +minimum-padding+)
|
|
(gui:grid case-sensitive-checkbox 0 4 :sticky :nws :padx +minimum-padding+)
|
|
(gui:grid button-close 0 5 :sticky :ne)
|
|
(gui:grid-columnconfigure frame 5 :weight 1)
|
|
(gui-goodies:attach-tooltips ((button-next frame) (_ "make next match visible"))
|
|
((button-previous frame) (_ "make previous match visible"))
|
|
(button-close (_ "end searching")))
|
|
(gui:bind (entry frame)
|
|
#$<KeyPress-Return>$
|
|
(start-search-clsr frame
|
|
gemtext-widget
|
|
(not (gui:value case-sensitive-checkbox))))
|
|
(setf (gui:command (button-next frame))
|
|
(lambda ()
|
|
(when (matches frame)
|
|
(setf (counter frame) (rem (1+ (counter frame)) (length (matches frame))))
|
|
(gui:see gemtext-widget (gui:match-start (elt (matches frame) (counter frame)))))))
|
|
(setf (gui:command (button-previous frame))
|
|
(lambda ()
|
|
(when (matches frame)
|
|
(setf (counter frame) (max 0 (1- (counter frame))))
|
|
(gui:see gemtext-widget (gui:match-start (elt (matches frame) (counter frame)))))))
|
|
(setf (gui:command button-close) (lambda () (gui:grid-forget frame)))
|
|
frame))
|