diff --git a/data/icons/fmw_star-blue.png b/data/icons/fmw_star-blue.png new file mode 100644 index 0000000..3fec432 Binary files /dev/null and b/data/icons/fmw_star-blue.png differ diff --git a/data/icons/fmw_star-yellow.png b/data/icons/fmw_star-yellow.png new file mode 100644 index 0000000..92865b1 Binary files /dev/null and b/data/icons/fmw_star-yellow.png differ diff --git a/po/it.po b/po/it.po index 17c68b7..5c8b8d3 100644 --- a/po/it.po +++ b/po/it.po @@ -9,7 +9,7 @@ msgstr "" "Project-Id-Version: tinmop 0.0.1\n" "Report-Msgid-Bugs-To: https://notabug.org/cage/tinmop/\n" "POT-Creation-Date: 2023-02-19 16:21+0100\n" -"PO-Revision-Date: 2023-02-19 16:26+0100\n" +"PO-Revision-Date: 2023-04-07 20:15+0200\n" "Last-Translator: cage \n" "Language-Team: Italian\n" "Language: it\n" @@ -1710,7 +1710,7 @@ msgstr "Nessuna voce selezionata" #: src/ui-goodies.lisp:2887 msgid "Delete bookmark: " -msgstr "Canvella il segnalibro: " +msgstr "Cancella il segnalibro: " #: src/ui-goodies.lisp:2902 msgid "Search criteria: " diff --git a/src/db.lisp b/src/db.lisp index 941d271..7f9ea18 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -3238,15 +3238,27 @@ days in the past" (query (select :* (from +table-bookmark+) (where (:is-null :section)))) (query (select :* (from +table-bookmark+) (where (:= :section section)))))) +(defun bookmark-all () + (query (select :* (from +table-bookmark+)))) + +(defun bookmark-exists-p (iri) + (query (select :id (from +table-bookmark+) + (where (:like :value (prepare-for-sql-like iri)))))) + (defun bookmark-all-grouped-by-section () (let ((sections (sort (bookmark-all-sections) #'string<))) (loop for section in sections collect (cons section (bookmark-all-by-section section))))) -(defun bookmark-delete (id) +(defgeneric bookmark-delete (id)) + +(defmethod bookmark-delete ((id number)) (delete-by-id +table-bookmark+ id)) +(defmethod bookmark-delete ((id string)) + (query (delete-from +table-bookmark+ (where (:= :value id))))) + (defun gempub-metadata-add (local-uri &optional original-uri diff --git a/src/gui/client/bookmark-window.lisp b/src/gui/client/bookmark-window.lisp new file mode 100644 index 0000000..cf2cd13 --- /dev/null +++ b/src/gui/client/bookmark-window.lisp @@ -0,0 +1,48 @@ +(in-package :client-bookmark-window) + +(named-readtables:in-readtable nodgui.syntax:nodgui-syntax) + +(defun add-to-bookmark-clsr (toplevel iri-entry section-entry description-entry) + (lambda () + (let ((iri (gui:text iri-entry)) + (section (if (text-utils:string-empty-p (gui:text section-entry)) + (_ "Default") + (gui:text section-entry))) + (description (if (text-utils:string-empty-p (gui:text description-entry)) + iri-entry + (gui:text description-entry)))) + (if (gemini-parser:gemini-iri-p iri) + (ev:with-enqueued-process-and-unblock () + (comm:make-request :gemini-bookmark-add 1 iri section description) + (gui-goodies:info-dialog toplevel + (format nil (_ "The address ~a has been bookmarked") iri))) + (gui-goodies:error-dialog toplevel + (format nil (_ "~s is not a valid gemini address.") iri))) + (gui:exit-from-toplevel toplevel)))) + +(defun init-window (master iri) + (gui:with-toplevel (toplevel :master master :title (_ "Streams")) + (gui:transient toplevel master) + (let* ((iri-label (make-instance 'gui:label :master toplevel :text (_ "Address"))) + (section-label (make-instance 'gui:label :master toplevel :text (_ "Section"))) + (description-label (make-instance 'gui:label :master toplevel :text (_ "Description"))) + (iri-entry (make-instance 'gui:entry :master toplevel :text iri)) + (section-entry (make-instance 'gui:entry :master toplevel :text (_ "Default"))) + (description-entry (make-instance 'gui:entry :master toplevel)) + (buttons-frame (make-instance 'gui:frame :master toplevel)) + (add-button (make-instance 'gui:button + :master buttons-frame + :image icons:*document-add* + :command (add-to-bookmark-clsr toplevel + iri-entry + section-entry + description-entry)))) + (gui-goodies:attach-tooltips (add-button (_ "add address bookmarks page"))) + (gui:grid iri-label 0 0 :sticky :nwes) + (gui:grid iri-entry 1 0 :sticky :nwes) + (gui:grid section-label 2 0 :sticky :nwes) + (gui:grid section-entry 3 0 :sticky :nwes) + (gui:grid description-label 4 0 :sticky :nwes) + (gui:grid description-entry 5 0 :sticky :nwes) + (gui:grid buttons-frame 6 0 :sticky :s) + (gui:grid add-button 0 0 :sticky :s)))) diff --git a/src/gui/client/certificates-window.lisp b/src/gui/client/certificates-window.lisp index 0f51488..23249f5 100644 --- a/src/gui/client/certificates-window.lisp +++ b/src/gui/client/certificates-window.lisp @@ -192,7 +192,7 @@ (defun make-import-certificates-win-clsr (certificate-frame master) (lambda () - (gui:with-modal-toplevel (toplevel :master master :title (_ "Import certificates")) + (gui:with-toplevel (toplevel :master master :title (_ "Import certificates")) (gui:transient toplevel master) (let ((frame (make-instance 'import-window :certificate-frame certificate-frame @@ -200,7 +200,7 @@ (gui:grid frame 0 0 :sticky :news))))) (defun init-window (master) - (gui:with-modal-toplevel (toplevel :master master :title (_ "Certificates")) + (gui:with-toplevel (toplevel :master master :title (_ "Certificates")) (gui:transient toplevel master) (let* ((table (make-instance 'certificate-frame :master toplevel)) (buttons-frame (make-instance 'gui:frame :master toplevel)) diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp index aabb40c..0bcb033 100644 --- a/src/gui/client/gui-goodies.lisp +++ b/src/gui/client/gui-goodies.lisp @@ -75,9 +75,9 @@ (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)))) + `((gui:text ,(elt filter 0)) + ,(elt filter 1) + ,(elt filter 2)))) ,@body)) (defun attach-tooltip (widget tootltip-message) diff --git a/src/gui/client/icons.lisp b/src/gui/client/icons.lisp index 93b642e..ae82439 100644 --- a/src/gui/client/icons.lisp +++ b/src/gui/client/icons.lisp @@ -22,6 +22,10 @@ (a:define-constant +folder+ "fmw_folder" :test #'string=) +(a:define-constant +star-yellow+ "fmw_star-yellow.png" :test #'string=) + +(a:define-constant +star-blue+ "fmw_star-blue.png" :test #'string=) + (defparameter *search* nil) (defparameter *back* nil) @@ -42,6 +46,10 @@ (defparameter *folder* nil) +(defparameter *star-yellow* nil) + +(defparameter *star-blue* nil) + (defun load-icon (filename) (let ((path (if (not (re:scan "(?i)png$" filename)) (res:get-data-file (fs:cat-parent-dir +icon-dir+ @@ -61,4 +69,6 @@ (setf *document-delete* (load-icon +document-delete+)) (setf *document-add* (load-icon +document-add+)) (setf *document-accept* (load-icon +document-accept+)) - (setf *folder* (load-icon +folder+))) + (setf *folder* (load-icon +folder+)) + (setf *star-yellow* (load-icon +star-yellow+)) + (setf *star-blue* (load-icon +star-blue+))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index c930253..b7bfba8 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -154,7 +154,15 @@ next-start-fetching)))))))) (loop-fetch) (ev:with-enqueued-process-and-unblock () - (render-toc main-window iri)))) + (render-toc main-window iri)) + (if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p + 1 + ev:+standard-event-priority+ + iri) + (ev:with-enqueued-process-and-unblock () + (set-bookmark-button-true main-window)) + (ev:with-enqueued-process-and-unblock () + (set-bookmark-button-false main-window))))) (defun start-streaming-thread (main-window iri &key @@ -217,7 +225,11 @@ (go-button :initform nil :initarg :go-button - :accessor go-button))) + :accessor go-button) + (bookmark-button + :initform nil + :initarg :bookmark-button + :accessor bookmark-button))) (defun autocomplete-iri-clsr (toolbar) (declare (ignore toolbar)) @@ -706,16 +718,44 @@ (setf (gui:text iri-entry) iri-visited) (open-iri iri-visited main-window t))))))) +(defun set-bookmark-button-image (main-window image) + (with-accessors ((tool-bar tool-bar)) main-window + (with-accessors ((bookmark-button bookmark-button)) tool-bar + (gui:configure bookmark-button :image image)))) + +(defun set-bookmark-button-false (main-window) + (set-bookmark-button-image main-window icons:*star-yellow*)) + +(defun set-bookmark-button-true (main-window) + (set-bookmark-button-image main-window icons:*star-blue*)) + +(defun bookmark-iri-clsr (main-window) + (lambda () + (with-accessors ((tool-bar tool-bar)) main-window + (with-accessors ((iri-entry iri-entry)) tool-bar + (let* ((iri (gui:text iri-entry)) + (bookmarked-p (cev:enqueue-request-and-wait-results :gemini-bookmarked-p + 1 + ev:+standard-event-priority+ + iri))) + (if bookmarked-p + (ev:with-enqueued-process-and-unblock () + (comm:make-request :gemini-bookmark-delete 1 iri) + (set-bookmark-button-false main-window)) + (progn + (client-bookmark-window:init-window main-window (gui:text iri-entry))))))))) + (defun setup-main-window-events (main-window) (with-accessors ((tool-bar tool-bar) (toc-frame toc-frame) (gemtext-widget gemtext-widget) (ir-lines ir-lines)) main-window - (with-accessors ((iri-entry iri-entry) - (back-button back-button) - (reload-button reload-button) - (up-button up-button) - (go-button go-button)) tool-bar + (with-accessors ((iri-entry iri-entry) + (back-button back-button) + (reload-button reload-button) + (up-button up-button) + (go-button go-button) + (bookmark-button bookmark-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 @@ -727,34 +767,39 @@ (gui:bind toc-listbox #$<>$ (toc-callback-clsr main-window)) - (setf (gui:command go-button) (open-iri-clsr main-window t)) - (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 go-button) (open-iri-clsr main-window t)) + (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)))))) (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) - (up-button up-button) - (go-button go-button)) object + (with-accessors ((iri-entry iri-entry) + (back-button back-button) + (reload-button reload-button) + (up-button up-button) + (go-button go-button) + (bookmark-button bookmark-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*)) - (setf up-button (make-instance 'gui:button :master object :image icons:*up*)) - (gui-goodies:attach-tooltips (back-button (_ "go back")) - (reload-button (_ "reload address")) - (go-button (_ "go to address")) - (up-button (_ "one level up"))) - (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) + (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*)) + (setf up-button (make-instance 'gui:button :master object :image icons:*up*)) + (setf bookmark-button (make-instance 'gui:button :master object)) + (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"))) + (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-columnconfigure object 3 :weight 2) object)) @@ -839,6 +884,7 @@ (info-text info-text) (gemtext-widget gemtext-widget)) object (setf tool-bar (make-instance 'tool-bar :master object)) + (set-bookmark-button-false object) (setf toc-frame (make-instance 'toc-frame :master object)) (setf gemtext-widget (make-instance 'gui:scrolled-text :master object diff --git a/src/gui/client/menu-command.lisp b/src/gui/client/menu-command.lisp index f3ca46c..c33c571 100644 --- a/src/gui/client/menu-command.lisp +++ b/src/gui/client/menu-command.lisp @@ -2,7 +2,7 @@ (defun help-about () (let ((master gui-goodies:*toplevel*)) - (gui:with-modal-toplevel (toplevel :master master :title (_ "About")) + (gui:with-toplevel (toplevel :master master :title (_ "About")) (gui:transient toplevel master) (let* ((editor (make-instance 'gui:scrolled-text :master toplevel diff --git a/src/gui/client/stream-window.lisp b/src/gui/client/stream-window.lisp index 1ef1121..c7fe9a0 100644 --- a/src/gui/client/stream-window.lisp +++ b/src/gui/client/stream-window.lisp @@ -70,7 +70,7 @@ (client-main-window::open-iri url gui-goodies:*main-frame* t))))) (defun init-window (master) - (gui:with-modal-toplevel (toplevel :master master :title (_ "Streams")) + (gui:with-toplevel (toplevel :master master :title (_ "Streams")) (gui:transient toplevel master) (let* ((table (make-instance 'stream-frame :master toplevel)) (buttons-frame (make-instance 'gui:frame :master toplevel)) @@ -83,7 +83,7 @@ :image icons:*document-accept* :command (revive-stream-clsr table)))) (gui-goodies:attach-tooltips (delete-button (_ "delete selected stream")) - (delete-button (_ "show selected stream"))) + (revive-button (_ "show selected stream"))) (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-bookmark.lisp b/src/gui/server/public-api-gemini-bookmark.lisp new file mode 100644 index 0000000..8406a7f --- /dev/null +++ b/src/gui/server/public-api-gemini-bookmark.lisp @@ -0,0 +1,50 @@ +;; tinmop: an humble gemini and pleroma client +;; Copyright (C) 2022 cage + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. +;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]]. + +(in-package :json-rpc-communication) + +(defclass iri-complete-response (box) ()) + +(defun gemini-bookmark-add (iri section description) + (if (not (gemini-bookmarked-p iri)) + (progn + (db:bookmark-add db:+bookmark-gemini-type-entry+ + iri + :section section + :description description) + t) + nil)) + +(defun gemini-generate-bookmark-page () + (gemini-parse-string (ui::generate-bookmark-page))) + +(defun gemini-bookmark-delete (iri) + (db:bookmark-delete iri)) + +(defclass gemini-bookmark-table (box) ()) + +(defmethod yason:encode ((object gemini-bookmark-table) &optional (stream *standard-output*)) + (encode-flat-array-of-plists (unbox object) stream)) + +(defun gemini-bookmark-table () + (make-instance 'gemini-bookmark-table + :contents (db:bookmark-all))) + +(defun gemini-bookmarked-p (iri) + (if (db:bookmark-exists-p iri) + t + nil)) diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp index 0dbae2b..b4525d4 100644 --- a/src/gui/server/public-api.lisp +++ b/src/gui/server/public-api.lisp @@ -106,6 +106,14 @@ 'tour-delete-link "iri" 0) (gen-rpc "clear-tour" 'clear-tour) + (gen-rpc "gemini-generate-bookmark-page" 'gemini-generate-bookmark-page) + (gen-rpc "gemini-bookmark-add" 'gemini-bookmark-add + "iri" 0 + "section" 1 + "description" 2) + (gen-rpc "gemini-bookmark-delete" 'gemini-bookmark-delete "iri" 0) + (gen-rpc "gemini-bookmark-table" 'gemini-bookmark-table) + (gen-rpc "gemini-bookmarked-p" 'gemini-bookmarked-p "iri" 0) (gen-rpc "iri-to-parent-path" 'iri-to-parent-path "iri" 0) (gen-rpc "quit-program" 'quit-program) ,@body)) diff --git a/src/package.lisp b/src/package.lisp index ad872f3..8337b55 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1115,6 +1115,8 @@ :bookmark-description-for-complete :bookmark-all-sections :bookmark-all-grouped-by-section + :bookmark-all + :bookmark-exists-p :bookmark-delete :gempub-metadata-add :all-gempub-metadata @@ -3327,7 +3329,9 @@ :*document-delete* :*document-add* :*document-accept* - :*folder*)) + :*folder* + :*star-yellow* + :*star-blue*)) (defpackage :validation (:use @@ -3443,6 +3447,26 @@ (:export :init-window)) +(defpackage :client-bookmark-window + (:use + :cl + :config + :constants + :text-utils + :misc-utils) + (:local-nicknames (:cert-win :client-certificates-window) + (: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 + :init-window)) + (defpackage :client-main-window (:use :cl diff --git a/tinmop.asd b/tinmop.asd index d054bd4..6fbb990 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -153,6 +153,7 @@ (:file "public-api-gemini-stream") (:file "public-api-gemini-certificates") (:file "public-api-gemini-tour-links") + (:file "public-api-gemini-bookmark") (:file "public-api") (:file "json-rpc-communication"))) (:module gui-client @@ -167,6 +168,7 @@ (:file "icons") (:file "certificates-window") (:file "stream-window") + (:file "bookmark-window") (:file "menu-command") (:file "main-window"))) (:file "main")