cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-03-16 12:00:04 +01:00
Code Issues

- [GUI] added command to bookmark and delete a gemini address.

Browse Source
This commit is contained in:
cage 2023-04-09 10:05:59 +02:00
parent 4ee09ae301
commit 6e6106e996
15 changed files with 242 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
data/icons/fmw_star-blue.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.5 KiB

BIN
data/icons/fmw_star-yellow.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.5 KiB

4
po/it.po
View File

@ -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 <cage@invalid.org>\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: "

14
src/db.lisp
View File

@ -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

48
src/gui/client/bookmark-window.lisp Normal file
View File

@ -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))))

4
src/gui/client/certificates-window.lisp
View File

@ -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))

6
src/gui/client/gui-goodies.lisp
View File

@ -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)

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

@ -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+)))

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

@ -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
#$<<ListboxSelect>>$
(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

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

@ -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

4
src/gui/client/stream-window.lisp
View File

@ -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)

50
src/gui/server/public-api-gemini-bookmark.lisp Normal file
View File

@ -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))

8
src/gui/server/public-api.lisp
View File

@ -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))

26
src/package.lisp
View File

@ -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

2
tinmop.asd
View File

@ -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")