diff --git a/Makefile.am b/Makefile.am index 5a49121..f37f91c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -42,19 +42,23 @@ confdir = $(sysconfdir)/$(PACKAGE) dist_conf_DATA = etc/init.lisp etc/default-theme.conf etc/shared.conf -nobase_dist_pkgdata_DATA = \ -data/modules/delete-by-regex.lisp \ -data/modules/expand-abbrev-command-window.lisp \ -data/modules/next-previous-open.lisp \ -data/modules/rewrite-message-urls.lisp \ -data/modules/share-gemini-link.lisp \ -data/scripts/export-gemini-subscriptions.lisp \ -data/scripts/gemget.lisp \ -data/scripts/get-following.lisp \ -data/scripts/import-following.lisp \ -data/scripts/import-gemini-subscriptions.lisp \ -data/scripts/welcome-bot.lisp \ -data/icons/search.png +nobase_dist_pkgdata_DATA = \ +data/modules/delete-by-regex.lisp \ +data/modules/expand-abbrev-command-window.lisp \ +data/modules/next-previous-open.lisp \ +data/modules/rewrite-message-urls.lisp \ +data/modules/share-gemini-link.lisp \ +data/scripts/export-gemini-subscriptions.lisp \ +data/scripts/gemget.lisp \ +data/scripts/get-following.lisp \ +data/scripts/import-following.lisp \ +data/scripts/import-gemini-subscriptions.lisp \ +data/scripts/welcome-bot.lisp \ +data/icons/fmw_open_tour.png \ +data/icons/fmw_search.png \ +data/icons/fmw_refresh.png \ +data/icons/fmw_back.png \ +data/icons/fmw_go.png dist_man1_MANS = doc/tinmop.man diff --git a/Makefile.in b/Makefile.in index fe2046f..0d427ed 100644 --- a/Makefile.in +++ b/Makefile.in @@ -407,18 +407,22 @@ doc/tinmop.org doc/send-toot.lisp NEWS.org ChangeLog AUTHORS confdir = $(sysconfdir)/$(PACKAGE) dist_conf_DATA = etc/init.lisp etc/default-theme.conf etc/shared.conf nobase_dist_pkgdata_DATA = \ -data/modules/delete-by-regex.lisp \ -data/modules/expand-abbrev-command-window.lisp \ -data/modules/next-previous-open.lisp \ -data/modules/rewrite-message-urls.lisp \ -data/modules/share-gemini-link.lisp \ -data/scripts/export-gemini-subscriptions.lisp \ -data/scripts/gemget.lisp \ -data/scripts/get-following.lisp \ -data/scripts/import-following.lisp \ -data/scripts/import-gemini-subscriptions.lisp \ -data/scripts/welcome-bot.lisp \ -data/icons/search.png +data/modules/delete-by-regex.lisp \ +data/modules/expand-abbrev-command-window.lisp \ +data/modules/next-previous-open.lisp \ +data/modules/rewrite-message-urls.lisp \ +data/modules/share-gemini-link.lisp \ +data/scripts/export-gemini-subscriptions.lisp \ +data/scripts/gemget.lisp \ +data/scripts/get-following.lisp \ +data/scripts/import-following.lisp \ +data/scripts/import-gemini-subscriptions.lisp \ +data/scripts/welcome-bot.lisp \ +data/icons/fmw_open_tour.png \ +data/icons/fmw_search.png \ +data/icons/fmw_refresh.png \ +data/icons/fmw_back.png \ +data/icons/fmw_go.png dist_man1_MANS = doc/tinmop.man all: $(BUILT_SOURCES) diff --git a/src/gui/client/constants.lisp b/src/gui/client/constants.lisp new file mode 100644 index 0000000..247ede5 --- /dev/null +++ b/src/gui/client/constants.lisp @@ -0,0 +1,5 @@ +(in-package :constants) + +(define-constant +minimum-padding+ 2 :test #'=) + +(define-constant +ps-file-dialog-filter+ '(("PostScript Files" "*.ps")) :test #'equalp) diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp new file mode 100644 index 0000000..cfe99bf --- /dev/null +++ b/src/gui/client/gui-goodies.lisp @@ -0,0 +1,72 @@ +(in-package :gui-goodies) + +(cl-syntax:use-syntax 'gui-utils:nodgui-color-syntax) + +(a:define-constant +font-h1+ "sans 20 bold" :test #'string=) + +(a:define-constant +font-h2+ "sans 15 bold" :test #'string=) + +(a:define-constant +font-h3+ "bold" :test #'string=) + +(defun gui-resize-grid-all (w) + (gui:grid-columnconfigure w :all :weight 1) + (gui:grid-rowconfigure w :all :weight 1)) + +(defun confirm-deletion (parent how-many) + (gui:ask-yesno (format nil (n_ "~a element will be deleted; continue?" + "~a elements will be deleted; continue?" + how-many) + how-many) + :title (_ "Confirm operation") + :parent parent)) + +(defun info-operation-completed (parent) + (gui:message-box (_ "Operation completed") (_ "information") :ok "info" :parent parent)) + +(defun info-dialog (parent message &key (title (_ "Information"))) + (gui:message-box message title :ok "info" :parent parent)) + +(defun error-dialog (parent message &key (title (_ "Error"))) + (gui:message-box message title :ok "error" :parent parent)) + +(defun re-validate (parent datum regex error-message) + (let* ((validator (make-instance 'validation:regexp-validator + :error-message error-message + :regexp regex)) + (passedp (validation:validate validator datum))) + (if (not passedp) + (progn + (error-dialog parent error-message) + nil) + t))) + +(defmacro with-re-validate ((parent &rest filters) &body body) + "each filter is -> '(datum regexp error-message)" + `(and ,@(loop for filter in filters collect + `(apply #'re-validate (list ,parent ,@filter))) + ,@body)) + +(defmacro with-entry-text-validate ((parent &rest filters) &body body) + "filtrers -> '(entry-widget regex error-message)" + `(with-re-validate (,parent ,@(loop for filter in filters collect + `((text ,(elt filter 0)) + ,(elt filter 1) + ,(elt filter 2)))) + ,@body)) + +(defun attach-tooltip (widget text) + (let ((tooltip (make-instance 'nodgui.mw:tooltip + :borderwidth 1 + :relief :solid))) + (nodgui.mw:register-tooltip tooltip widget text))) + +(defmacro attach-tooltips (&rest widget-text) + `(progn + ,@(loop for i in widget-text collect + `(attach-tooltip ,(first i) ,(second i))))) + +(defmacro with-busy* ((root-widget) &body body) + `(progn + (with-busy (,root-widget) + (with-hourglass ,(list root-widget) + ,@body)))) diff --git a/src/gui/client/icons.lisp b/src/gui/client/icons.lisp index ae6fa62..a82cf88 100644 --- a/src/gui/client/icons.lisp +++ b/src/gui/client/icons.lisp @@ -1,6 +1,6 @@ (in-package :icons) -(a:define-constant +icon-dir+ "/icons/" :test #'string=) +(a:define-constant +icon-dir+ "/data/icons/" :test #'string=) (a:define-constant +search+ "fmw_search" :test #'string=) @@ -12,28 +12,28 @@ (a:define-constant +refresh+ "fmw_refresh" :test #'string=) -(defparameter *icon-search* nil) +(defparameter *search* nil) -(defparameter *icon-back* nil) +(defparameter *back* nil) -(defparameter *icon-go* nil) +(defparameter *open-iri* nil) -(defparameter *icon-open-tour* nil) +(defparameter *open-tour* nil) -(defparameter *icon-refresh* nil) +(defparameter *refresh* nil) (defun load-icon (filename) (let ((path (if (not (re:scan "(?i)png$" filename)) - (res:get-config-file (fs:cat-parent-dir +icon-dir+ + (res:get-data-file (fs:cat-parent-dir +icon-dir+ (strcat filename ".png"))) - (res:get-config-file (fs:cat-parent-dir +icon-dir+ filename))))) + (res:get-data-file (fs:cat-parent-dir +icon-dir+ filename))))) (with-open-file (stream path :element-type '(unsigned-byte 8)) (let ((data (gui-utils:read-into-array stream (file-length stream)))) (gui:make-image data))))) (defun load-icons () - (setf *icon-search* (load-icon +search+)) - (setf *icon-back* (load-icon +back+)) - (setf *icon-search* (load-icon +go+)) - (setf *icon-search* (load-icon +open-tour+)) - (setf *icon-search* (load-icon +refresh+))) + (setf *search* (load-icon +search+)) + (setf *back* (load-icon +back+)) + (setf *open-iri* (load-icon +go+)) + (setf *open-tour* (load-icon +open-tour+)) + (setf *refresh* (load-icon +refresh+))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 0d02f2d..e8bec7b 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -85,12 +85,88 @@ (defun initialize-menu (parent) (with-accessors ((main-window main-window)) parent (let* ((bar (gui:make-menubar)) - (file (gui:make-menu bar (_ "File"))) - (help (gui:make-menu bar (_ "Help")))) + (file (gui:make-menu bar (_ "File") :underline 0)) + (help (gui:make-menu bar (_ "Help") :underline 0))) (gui:make-menubutton file (_ "Quit") #'menu:quit :underline 0) (gui:make-menubutton help (_ "About") #'menu:help-about :underline 0)))) -(defclass main-frame (frame) +(defclass tool-bar (gui:frame) + ((iri-entry + :initform nil + :initarg :iri-entry + :accessor iri-entry) + (back-button + :initform nil + :initarg :back-button + :accessor back-button) + (reload-button + :initform nil + :initarg :reload-button + :accessor reload-button) + (go-button + :initform nil + :initarg :go-button + :accessor go-button))) + +(defun autocomplete-iri-clsr (toolbar) + (declare (ignore toolbar)) + (lambda (hint) + hint)) + +(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys) + (with-accessors ((iri-entry iri-entry) + (back-button back-button) + (reload-button reload-button) + (go-button go-button)) object + (gui:configure object :relief :raised) + (setf iri-entry + (make-instance 'gui-mw:autocomplete-entry + :master object + :autocomplete-function (autocomplete-iri-clsr object))) + (setf back-button (make-instance 'gui:button + :master object + :image icons:*back*)) + (setf reload-button (make-instance 'gui:button + :master object + :image icons:*refresh*)) + (setf go-button (make-instance 'gui:button + :master object + :image icons:*open-iri*)) + (gui-goodies:attach-tooltips (back-button (_ "go back")) + (go-button (_ "go to address")) + (reload-button (_ "reload address"))) + (gui:grid back-button 0 1 :sticky :nsw :padx +minimum-padding+) + (gui:grid iri-entry 0 2 :sticky :we :padx +minimum-padding+) + (gui:grid go-button 0 3 :sticky :e :padx +minimum-padding+) + (gui:grid reload-button 0 4 :sticky :e) + (gui:grid-columnconfigure object 2 :weight 2) + object)) + +(defclass toc-frame (gui:frame) + ((toc-listbox + :initform nil + :initarg :toc-listbox + :accessor toc-listbox) + (toc-data + :initform nil + :initarg :toc-data + :accessor toc-data))) + +(defmethod initialize-instance :after ((object toc-frame) &key &allow-other-keys) + (with-accessors ((toc-listbox toc-listbox) + (toc-data toc-data)) object + (setf toc-listbox (make-instance 'gui:scrolled-listbox + :master object + :name nil)) + (gui:grid toc-listbox 0 0 + :sticky :nswe + :ipadx +minimum-padding+ + :ipady +minimum-padding+) + (gui-goodies:gui-resize-grid-all object) + )) + + +(defclass main-frame (gui:frame) ((main-window :initform nil :initarg :main-window @@ -99,19 +175,33 @@ :initform nil :initarg :tool-bar :accessor tool-bar) - (toc-pane + (toc-frame :initform nil - :initarg :toc-pane - :accessor toc-pane) - (info-pane + :initarg :toc-frame + :accessor toc-frame) + (info-frame :initform nil - :initarg :info-pane - :accessor info-pane))) + :initarg :info-frame + :accessor info-frame))) -(defmethod initialize-instance :after ((object main-frame) &key &allow-other-keys)) - -;; (nodgui-utils:gui-resize-grid-all object)))) +(defmethod initialize-instance :after ((object main-frame) &key &allow-other-keys) + (with-accessors ((main-window main-window) + (tool-bar tool-bar) + (toc-frame toc-frame) + (info-frame info-frame)) object + (setf tool-bar (make-instance 'tool-bar :master object)) + (setf toc-frame (make-instance 'toc-frame :master object)) + (gui:grid tool-bar 0 0 :sticky :new) + (gui:grid toc-frame 1 0 :sticky :nsw) + (gui:grid-columnconfigure object :all :weight 1) + (gui:grid-rowconfigure object 1 :weight 1) + object)) (defun init-main-window () (let ((gui:*debug-tk* nil)) - (gui:with-nodgui (:title +program-name+)))) + (gui:with-nodgui (:title +program-name+) + (icons:load-icons) + (initialize-menu gui:*tk*) + (let ((main-frame (make-instance 'main-frame))) + (gui:grid main-frame 0 0 :sticky :nswe) + (gui-goodies:gui-resize-grid-all gui:*tk*))))) diff --git a/src/gui/client/menu-command.lisp b/src/gui/client/menu-command.lisp index 782b08b..8bfbf57 100644 --- a/src/gui/client/menu-command.lisp +++ b/src/gui/client/menu-command.lisp @@ -7,5 +7,5 @@ (gui:pack editor)))) (defun quit () - (serv:close-server) + ;;(serv:close-server) (gui:break-mainloop)) diff --git a/src/gui/client/validation.lisp b/src/gui/client/validation.lisp new file mode 100644 index 0000000..c5afbb3 --- /dev/null +++ b/src/gui/client/validation.lisp @@ -0,0 +1,31 @@ +(in-package :validation) + +(defgeneric validate (object datum)) + +(defclass validator () + ((error-message + :initform "" + :initarg :error-message + :accessor error-message) + (validation-function + :initform (lambda (datum) datum) + :initarg :validation-function + :accessor validation-function))) + +(defmethod validate ((object validator) datum) + (when (not (funcall (validation-function datum))) + (error-message object))) + +(defclass regexp-validator (validator) + ((regexp + :initform ".*" + :initarg :regexp + :accessor regexp) + (error-message + :initform ".*" + :initarg :error-message + :accessor error-message))) + +(defmethod regexp-validate ((object regexp-validator) datum) + (when (not (re:scan (regexp object) datum)) + (error-message object))) diff --git a/src/package.lisp b/src/package.lisp index a8073a4..340122d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -65,7 +65,10 @@ :+mention-prefix+ :+cache-tls-certificate-type+ :+standard-editor+ - :+octect-type+)) + :+octect-type+ + ;; GUI + :+minimum-padding+ + :+ps-file-dialog-filter+)) (defpackage :conditions (:use :cl @@ -3268,17 +3271,60 @@ (:gui-utils :nodgui.utils)) (:export :+icon-dir+ - :*icon-search* - :*icon-back* - :*icon-go* - :*icon-open-tour* - :*icon-refresh*)) + :load-icons + :*search* + :*back* + :*open-iri* + :*open-tour* + :*refresh*)) + +(defpackage :validation + (:use + :cl + :config + :constants) + (:local-nicknames (:serv :json-rpc-communication) + (:re :cl-ppcre) + (:a :alexandria) + (:gui :nodgui) + (:gui-utils :nodgui.utils)) + (:export + :validator + :regexp-validator + :validate)) + +(defpackage :gui-goodies + (:use :cl + :config + :constants + :misc + :text-utils) + (:local-nicknames (:serv :json-rpc-communication) + (:re :cl-ppcre) + (:a :alexandria) + (:gui :nodgui) + (:gui-mw :nodgui.mw) + (:gui-utils :nodgui.utils) + (:gui-shapes :nodgui.shapes)) + (:export + :gui-resize-grid-all + :confirm-deletion + :info-operation-completed + :info-dialog + :error-dialog + :re-validate + :with-re-validate + :with-entry-text-validate + :attach-tooltip + :attach-tooltips + :with-busy*)) (defpackage :client-menu-command (:use :cl :config :constants + :gui-goodies :text-utils :misc-utils) (:local-nicknames (:serv :json-rpc-communication) diff --git a/tinmop.asd b/tinmop.asd index 9189e75..fdd9361 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -157,9 +157,12 @@ (:file "json-rpc-communication"))) (:module gui-client :pathname "gui/client" - :components ((:file "client-configuration") + :components ((:file "constants") + (:file "client-configuration") (:file "program-events") (:file "json-rpc-communication") + (:file "validation") + (:file "gui-goodies") (:file "icons") (:file "menu-command") (:file "main-window")))