cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [GUI] added searching regex in gemtext window.

This commit is contained in:
cage 2023-04-10 14:12:00 +02:00
parent cf7fe38829
commit 6dc7298b5b
5 changed files with 112 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/gui/client/icons.lisp
View File

@ -28,6 +28,10 @@
(a:define-constant +star-blue+ "fmw_star-blue.png" :test #'string=)
(a:define-constant +arrow-up+ "fmw_arrow-up" :test #'string=)
(a:define-constant +arrow-down+ "fmw_arrow-down" :test #'string=)
(defparameter *search* nil)
(defparameter *back* nil)
@ -54,6 +58,10 @@
(defparameter *star-blue* nil)
(defparameter *arrow-up* nil)
(defparameter *arrow-down* nil)
(defun load-icon (filename)
(let ((path (if (not (re:scan "(?i)png$" filename))
(res:get-data-file (fs:cat-parent-dir +icon-dir+
@ -76,4 +84,8 @@
(setf *document-edit* (load-icon +document-edit+))
(setf *folder* (load-icon +folder+))
(setf *star-yellow* (load-icon +star-yellow+))
(setf *star-blue* (load-icon +star-blue+)))
(setf *star-blue* (load-icon +star-blue+))
(setf *arrow-up* (load-icon +arrow-up+))
(setf *arrow-down* (load-icon +arrow-down+)))
(defparameter *arrow-down* nil)

13
src/gui/client/main-window.lisp
View File

@ -870,6 +870,10 @@
:initform nil
:initarg :info-text
:accessor info-text)
(search-frame
:initform nil
:initarg :search-frame
:accessor search-frame)
(ir-rendered-lines
:initform (misc:make-fresh-array 0)
:initarg :ir-rendered-lines
@ -884,6 +888,7 @@
(tool-bar tool-bar)
(toc-frame toc-frame)
(info-frame info-frame)
(search-frame search-frame)
(info-text info-text)
(gemtext-widget gemtext-widget)) object
(setf tool-bar (make-instance 'tool-bar :master object))
@ -894,15 +899,17 @@
:read-only t
:font (gui-conf:gemini-text-font-configuration)))
(gui:configure gemtext-widget :wrap :word)
(setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1))
(setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1))
(setf info-text (make-instance 'gui:text :height 1 :wrap :none :master info-frame))
(gui:configure info-text :font gui:+tk-small-caption-font+)
(setf search-frame (client-search-frame:init-window object))
(gui:grid info-text 0 0 :sticky :news)
(gui-goodies:gui-resize-grid-all info-frame)
(gui:grid tool-bar 0 0 :sticky :new :columnspan 2)
(gui:grid toc-frame 1 0 :sticky :nsw)
(gui:grid gemtext-widget 1 1 :sticky :news)
(gui:grid info-frame 3 0 :sticky :news :columnspan 2)
(gui:grid search-frame 3 0 :sticky :news :columnspan 2)
(gui:grid info-frame 4 0 :sticky :news :columnspan 2)
(gui:grid-columnconfigure object 1 :weight 1)
(gui:grid-rowconfigure object 1 :weight 1)
(setup-main-window-events object)
@ -954,7 +961,7 @@
(setf (gui:text (iri-entry (tool-bar main-window))) text))
(defun init-main-window ()
(let ((gui:*debug-tk* nil))
(let ((gui:*debug-tk* t))
(gui:with-nodgui (:title +program-name+)
(icons:load-icons)
(setf gui-goodies:*toplevel* gui:*tk*)

67
src/gui/client/search-frame.lisp Normal file
View File

@ -0,0 +1,67 @@
(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 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"))))
(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 :ns :padx +minimum-padding+)
(gui:bind (entry frame)
#$<KeyPress-Return>$
(lambda (e)
(declare (ignore e))
(loop for match in (matches frame) do
(gui:tag-delete gemtext-widget (gui:match-tag-name match)))
(setf (matches frame)
(gui:search-all-text gemtext-widget (gui:text (entry frame))
:case-insensitive (gui:value case-sensitive-checkbox)))
(loop for match in (matches frame) do
(gui:tag-configure gemtext-widget
(gui:match-tag-name match)
:background (gui:cget gemtext-widget
:highlightbackground)))))
(setf (gui:command (button-next frame))
(lambda ()
(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 ()
(setf (counter frame) (max 0 (1- (counter frame))))
(gui:see gemtext-widget (gui:match-start (elt (matches frame) (counter frame))))))
frame))

22
src/package.lisp
View File

@ -3334,7 +3334,9 @@
:*document-edit*
:*folder*
:*star-yellow*
:*star-blue*))
:*star-blue*
:*arrow-up*
:*arrow-down*))
(defpackage :validation
(:use
@ -3473,6 +3475,24 @@
:init-window
:manage-bookmarks))
(defpackage :client-search-frame
(:use
:cl
:config
:constants
:text-utils
:misc-utils)
(:local-nicknames (:comm :json-rpc-communication)
(:re :cl-ppcre)
(:a :alexandria)
(:ev :program-events)
(:cev :client-events)
(:gui :nodgui)
(:gui-mw :nodgui.mw)
(:gui-shapes :nodgui.shapes))
(:export
:init-window))
(defpackage :client-main-window
(:use
:cl

1
tinmop.asd
View File

@ -171,6 +171,7 @@
(:file "bookmark-window")
(:file "menu-command")
(:file "internal-paths")
(:file "search-frame")
(:file "main-window")))
(:file "main")
(:module tests