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

- [GUI] added basic functionalities of link tour.

This commit is contained in:
cage 2023-04-13 15:03:57 +02:00
parent d3e5782104
commit c07ccb054f
10 changed files with 153 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
data/icons/fmw_bullet-go.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 647 B

BIN
data/icons/fmw_bus-go.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.6 KiB

BIN
data/icons/fmw_bus.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.9 KiB

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

@ -34,6 +34,8 @@
(a:define-constant +cross+ "fmw_cross" :test #'string=)
(a:define-constant +bus-go+ "fmw_bus-go" :test #'string=)
(defparameter *search* nil)
(defparameter *back* nil)
@ -66,6 +68,8 @@
(defparameter *cross* nil)
(defparameter *bus-go* nil)
(defun load-icon (filename)
(let ((path (if (not (re:scan "(?i)png$" filename))
(res:get-data-file (fs:cat-parent-dir +icon-dir+
@ -91,6 +95,5 @@
(setf *star-blue* (load-icon +star-blue+))
(setf *arrow-up* (load-icon +arrow-up+))
(setf *arrow-down* (load-icon +arrow-down+))
(setf *cross* (load-icon +cross+)))
(defparameter *arrow-down* nil)
(setf *cross* (load-icon +cross+))
(setf *bus-go* (load-icon +bus-go+)))

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

@ -203,6 +203,7 @@
(gui:make-menubutton tools (_ "Streams") #'menu:show-streams :underline 0)
(gui:make-menubutton tools (_ "Search") (menu:show-search-frame-clsr main-window)
:underline 1)
(gui:make-menubutton tools (_ "Tour") #'menu:show-tour :underline 0)
(gui:make-menubutton file (_ "Quit") #'menu:quit :underline 0)
(gui:make-menubutton help (_ "About") #'menu:help-about :underline 0)
(gui:make-menubutton bookmarks
@ -238,7 +239,11 @@
(bookmark-button
:initform nil
:initarg :bookmark-button
:accessor bookmark-button)))
:accessor bookmark-button)
(tour-button
:initform nil
:initarg :tour-button
:accessor tour-button)))
(defun autocomplete-iri-clsr (toolbar)
(declare (ignore toolbar))
@ -394,7 +399,7 @@
main-window)
:button-3-callback
(contextual-menu-link-clrs link-name
link-value
target-iri
main-window)
:over-callback
(lambda () (print-info-message target-iri))
@ -773,6 +778,16 @@
(progn
(client-bookmark-window:init-window main-window (gui:text iri-entry)))))))))
(defun tour-visit-next-iri-clsr (main-window)
(lambda ()
(let ((next-link (cev:enqueue-request-and-wait-results :tour-pop-link
1
ev:+standard-event-priority+)))
(if next-link
(funcall (link-click-mouse-1-callback-clsr (getf next-link :link-value)
main-window))
(print-info-message (_ "Tour is terminated") :bold t)))))
(defun setup-main-window-events (main-window)
(with-accessors ((tool-bar tool-bar)
(toc-frame toc-frame)
@ -783,7 +798,8 @@
(reload-button reload-button)
(up-button up-button)
(go-button go-button)
(bookmark-button bookmark-button)) tool-bar
(bookmark-button bookmark-button)
(tour-button tour-button)) tool-bar
(let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry))
(toc-listbox (gui:listbox (toc-listbox toc-frame))))
(gui:bind entry-autocomplete
@ -799,7 +815,8 @@
(setf (gui:command reload-button) (reload-iri-clsr main-window))
(setf (gui:command back-button) (back-iri-clsr main-window))
(setf (gui:command up-button) (up-iri-clsr main-window))
(setf (gui:command bookmark-button) (bookmark-iri-clsr main-window))))))
(setf (gui:command bookmark-button) (bookmark-iri-clsr main-window))
(setf (gui:command tour-button) (tour-visit-next-iri-clsr main-window))))))
(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
(with-accessors ((iri-entry iri-entry)
@ -807,7 +824,8 @@
(reload-button reload-button)
(up-button up-button)
(go-button go-button)
(bookmark-button bookmark-button)) object
(bookmark-button bookmark-button)
(tour-button tour-button)) object
(gui:configure object :relief :raised)
(setf iri-entry (make-instance 'gui-mw:autocomplete-entry
:master object
@ -817,17 +835,20 @@
(setf go-button (make-instance 'gui:button :master object :image icons:*open-iri*))
(setf up-button (make-instance 'gui:button :master object :image icons:*up*))
(setf bookmark-button (make-instance 'gui:button :master object))
(setf tour-button (make-instance 'gui:button :master object :image icons:*bus-go*))
(gui-goodies:attach-tooltips (back-button (_ "go back"))
(reload-button (_ "reload address"))
(go-button (_ "go to address"))
(up-button (_ "one level up"))
(bookmark-button (_ "add or remove bookmark")))
(bookmark-button (_ "add or remove bookmark"))
(tour-button (_ "go to the next link in tour")))
(gui:grid back-button 0 0 :sticky :nsw)
(gui:grid reload-button 0 1 :sticky :nsw)
(gui:grid up-button 0 2 :sticky :nsw)
(gui:grid iri-entry 0 3 :sticky :nswe :padx +minimum-padding+)
(gui:grid go-button 0 4 :sticky :nsw)
(gui:grid bookmark-button 0 5 :sticky :nsw)
(gui:grid tour-button 0 6 :sticky :nsw)
(gui:grid-columnconfigure object 3 :weight 2)
object))

4
src/gui/client/menu-command.lisp
View File

@ -36,3 +36,7 @@
(defun show-search-frame-clsr (main-window)
(lambda ()
(gui:grid (client-main-window::search-frame main-window) 3 0 :sticky :news :columnspan 2)))
(defun show-tour ()
(let ((master gui-goodies:*toplevel*))
(client-tour-window:init-window master)))

65
src/gui/client/tour-window.lisp Normal file
View File

@ -0,0 +1,65 @@
(in-package :client-tour-window)
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
(defclass tour-frame (gui-goodies:table-frame) ())
(defun resync-rows (tour-frame new-rows)
(with-accessors ((tree gui-goodies:tree)
(rows gui-goodies:rows)) tour-frame
(gui:treeview-delete-all tree)
(setf rows new-rows)
(loop for row in rows do
(let* ((tree-row (make-instance 'gui:tree-item
:id (getf row :target)
:text (getf row :target)
:column-values (list (getf row :name))
:index gui:+treeview-last-index+)))
(gui:treeview-insert-item tree :item tree-row))))
(gui:treeview-refit-columns-width (gui-goodies:tree tour-frame))
tour-frame)
(defun all-rows ()
(cev:enqueue-request-and-wait-results :tour-all-links
1
ev:+standard-event-priority+))
(defmethod initialize-instance :after ((object tour-frame) &key &allow-other-keys)
(with-accessors ((tree gui-goodies:tree)
(rows gui-goodies:rows)) object
(let ((new-rows (all-rows))
(treeview (make-instance 'gui:scrolled-treeview
:master object
:pack '(:side :top :expand t :fill :both)
:columns (list (_ "Description")))))
(setf tree treeview)
(gui:treeview-heading tree gui:+treeview-first-column-id+
:text (_ "Address"))
(resync-rows object new-rows)
object)))
(defun delete-tour-clsr (tour-frame)
(lambda ()
(a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree tour-frame))))
(loop for selection in selections do
(let ((url (gui:id selection)))
(ev:with-enqueued-process-and-unblock ()
(comm:make-request :tour-delete-link
1
url))
(let ((new-rows (all-rows)))
(resync-rows tour-frame new-rows)))))))
(defun init-window (master)
(gui:with-toplevel (toplevel :master master :title (_ "Tour"))
(gui:transient toplevel master)
(let* ((table (make-instance 'tour-frame :master toplevel))
(buttons-frame (make-instance 'gui:frame :master toplevel))
(delete-button (make-instance 'gui:button
:master buttons-frame
:image icons:*document-delete*
:command (delete-tour-clsr table))))
(gui-goodies:attach-tooltips (delete-button (_ "delete selected links")))
(gui:grid table 0 0 :sticky :nwe)
(gui:grid buttons-frame 1 0 :sticky :s)
(gui:grid delete-button 0 0 :sticky :s))))

35
src/gui/server/public-api-gemini-tour-links.lisp
View File

@ -28,13 +28,24 @@
:target link-value))
t))
(defclass popped-tour-link (box) ())
(defmethod yason:encode ((object popped-tour-link) &optional (stream *standard-output*))
(let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase)
(yason:*list-encoder* #'yason:encode-plist)
(json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase))
(yason:encode-plist (unbox object) stream)))
(defun tour-pop-link ()
(a:when-let ((link (pop-tour-link *gemini-window*)))
(list :link-value (gemini-parser:target link)
:link-label (gemini-parser:name link))))
(make-instance 'popped-tour-link
:contents (list :link-value (gemini-parser:target link)
:link-label (gemini-parser:name link)))))
(defun tour-delete-link (url)
(delete-tour-link-element *gemini-window* url))
(progn
(delete-tour-link-element *gemini-window* url)
t))
(defun clear-tour ()
(clear-tour-link *gemini-window*))
@ -42,16 +53,18 @@
(defclass tour (box) ())
(defmethod yason:encode ((object tour) &optional (stream *standard-output*))
(let ((tour (unbox object)))
(let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase)
(yason:*list-encoder* #'yason:encode-plist)
(json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase))
(let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase)
(yason:*list-encoder* #'yason:encode-plist)
(json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase)
(tour (unbox object)))
(yason:with-output (stream)
(yason:with-array ()
(yason:encode-array-element
(loop for tour-link in tour collect
(list :target (gemini-parser:target tour-link)
:name (json:encode (gemini-parser:name tour-link))))))))))
(loop for tour-link in tour do
(yason:encode-array-elements
(list :name
(gemini-parser:name tour-link)
:target
(gemini-parser:target tour-link))))))))
(defun tour-all-links ()
(make-instance 'tour :contents (links-tour *gemini-window*)))

28
src/package.lisp
View File

@ -3337,7 +3337,8 @@
:*star-blue*
:*arrow-up*
:*arrow-down*
:*cross*))
:*cross*
:*bus-go*))
(defpackage :validation
(:use
@ -3412,7 +3413,8 @@
:show-streams
:show-bookmarks-clsr
:manage-bookmarks-clsr
:show-search-frame-clsr))
:show-search-frame-clsr
:show-tour))
(defpackage :client-certificates-window
(:use
@ -3436,6 +3438,28 @@
:rows
:init-window))
(defpackage :client-tour-window
(: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)
(:menu :client-menu-command))
(:export
:certificate-frame
:tree
:rows
:init-window))
(defpackage :client-stream-window
(:use
:cl

1
tinmop.asd
View File

@ -167,6 +167,7 @@
(:file "validation")
(:file "icons")
(:file "certificates-window")
(:file "tour-window")
(:file "stream-window")
(:file "bookmark-window")
(:file "menu-command")