diff --git a/data/icons/fmw_bullet-go.png b/data/icons/fmw_bullet-go.png new file mode 100644 index 0000000..4fd63c1 Binary files /dev/null and b/data/icons/fmw_bullet-go.png differ diff --git a/data/icons/fmw_bus-go.png b/data/icons/fmw_bus-go.png new file mode 100644 index 0000000..54b5689 Binary files /dev/null and b/data/icons/fmw_bus-go.png differ diff --git a/data/icons/fmw_bus.png b/data/icons/fmw_bus.png new file mode 100644 index 0000000..24dc1dd Binary files /dev/null and b/data/icons/fmw_bus.png differ diff --git a/src/gui/client/icons.lisp b/src/gui/client/icons.lisp index 529af7c..09f33ff 100644 --- a/src/gui/client/icons.lisp +++ b/src/gui/client/icons.lisp @@ -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+))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index f1a6f70..d0f4914 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -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)) diff --git a/src/gui/client/menu-command.lisp b/src/gui/client/menu-command.lisp index 3d17461..8c632db 100644 --- a/src/gui/client/menu-command.lisp +++ b/src/gui/client/menu-command.lisp @@ -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))) diff --git a/src/gui/client/tour-window.lisp b/src/gui/client/tour-window.lisp new file mode 100644 index 0000000..51e87f9 --- /dev/null +++ b/src/gui/client/tour-window.lisp @@ -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)))) diff --git a/src/gui/server/public-api-gemini-tour-links.lisp b/src/gui/server/public-api-gemini-tour-links.lisp index 302b3bd..d3f3310 100644 --- a/src/gui/server/public-api-gemini-tour-links.lisp +++ b/src/gui/server/public-api-gemini-tour-links.lisp @@ -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*))) diff --git a/src/package.lisp b/src/package.lisp index f999c5b..64b6c05 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/tinmop.asd b/tinmop.asd index dfc4f88..00a5a24 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -167,6 +167,7 @@ (:file "validation") (:file "icons") (:file "certificates-window") + (:file "tour-window") (:file "stream-window") (:file "bookmark-window") (:file "menu-command")