cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-16 08:00:35 +01:00
Code Issues

- [GUI] added UI to generate a gempub;

Browse Source 
- fixed parser for gempub metadata;
- fixed typo: "clrs" instead of "clsr";
- added dependency to "zip" binary.
This commit is contained in:
cage 2024-09-18 17:03:00 +02:00
parent 24bfe596b6
commit 2dfdf804a4
14 changed files with 933 additions and 532 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.in
View File

@ -343,6 +343,7 @@ XDG_OPEN = @XDG_OPEN@
XGETTEXT = @XGETTEXT@
XGETTEXT_015 = @XGETTEXT_015@
XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@
ZIP = @ZIP@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@

4
aclocal.m4 vendored
View File

@ -14,8 +14,8 @@
m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.71],,
[m4_warning([this file was generated for autoconf 2.71.
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.72],,
[m4_warning([this file was generated for autoconf 2.72.
You have another version of autoconf. It may work, but is not guaranteed to.
If you have problems, you may need to regenerate the build system entirely.
To do so, use the procedure documented by the package, typically 'autoreconf'.])])

1211
configure vendored
View File

File diff suppressed because it is too large Load Diff

6
configure.ac
View File

@ -76,6 +76,12 @@ if test "$UNZIP" = "no" ; then
AC_MSG_WARN([Can not find unzip, genpub support will be disabled.])
fi
AC_PATH_PROG([ZIP],[zip],[no])
if test "$UNZIP" = "no" ; then
AC_MSG_WARN([Can not find zip, genpub generation support will be disabled.])
fi
AC_PATH_PROG([MAN],[man],[no])
if test "$MAN" = "no" ; then

4
src/config.lisp.in.in
View File

@ -30,6 +30,8 @@
(alexandria:define-constant +unzip-bin+ "@UNZIP@" :test #'string=)
(alexandria:define-constant +zip-bin+ "@ZIP@" :test #'string=)
(alexandria:define-constant +man-bin+ "@MAN@" :test #'string=)
(alexandria:define-constant +montage-bin+ "@MONTAGE@" :test #'string=)
@ -45,6 +47,8 @@
(allow-features +unzip-bin+ :gempub-support)
(allow-features +zip-bin+ :gempub-generation-support)
(allow-features +man-bin+ :man-bin)
(allow-features +montage-bin+ :montage-bin))

14
src/gempub.lisp
View File

@ -31,7 +31,7 @@
(defrule gempub-version "version" (:constant :version))
(defrule gempub-cover "cover" (:constant :cover))
(defrule gempub-blank (or #\space #\Newline #\Tab)
(defrule gempub-blank (or #\space #\Tab)
(:constant nil))
(defrule gempub-blanks (* gempub-blank)
@ -39,7 +39,7 @@
(defrule gempub-key-value-separator #\:)
(defrule gempub-value (+ (not #\Newline))
(defrule gempub-value (* (not #\Newline))
(:text t))
(defrule gempub-key (or gempub-title
@ -58,7 +58,7 @@
gempub-cover))
(defrule gempub-entry (and gempub-key (? gempub-blanks) gempub-key-value-separator
(? gempub-blanks) gempub-value gempub-blanks)
(? gempub-blanks) gempub-value #\NewLine)
(:function (lambda (a) (list (first a) (fifth a)))))
(defrule gempub-metadata (* gempub-entry)
@ -67,16 +67,16 @@
(defgeneric parse-metadata (object))
(defmethod parse-metadata ((object string))
(parse 'metadata object))
(parse 'gempub-metadata object))
(define-constant +metadata-entry-name "metadata.txt" :test #'string=)
(define-constant +metadata-entry-name+ "metadata.txt" :test #'string=)
(defun extract-metadata (zip-file)
(when (gempub:gempub-file-p zip-file :ignore-errors t)
(let ((entries (zip-info:list-entries zip-file)))
(when (find +metadata-entry-name entries :test #'String=)
(when (find +metadata-entry-name+ entries :test #'String=)
(when-let ((metadata-raw (os-utils:unzip-single-file zip-file
+metadata-entry-name)))
+metadata-entry-name+)))
(parse 'gempub-metadata metadata-raw))))))
(defun save-metadata (zip-file)

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

@ -55,7 +55,7 @@
(let ((new-rows (all-rows)))
(resync-rows certificate-frame new-rows))))))))
(defun contextual-menu-clrs (treeview-widget)
(defun contextual-menu-clsr (treeview-widget)
(labels ((row-values ()
(a:when-let* ((item (first (gui:treeview-get-selection treeview-widget))))
(gui:column-values item)))
@ -279,4 +279,4 @@
(gui:grid import-button 0 1 :sticky :s)
(gui:bind (gui:treeview (gui-goodies:tree table))
#$<3>$
(contextual-menu-clrs (gui:treeview (gui-goodies:tree table)))))))
(contextual-menu-clsr (gui:treeview (gui-goodies:tree table)))))))

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

@ -160,7 +160,7 @@
ev:+standard-event-priority+
gemlog-url))
(defun contextual-menu-clrs (gemlog-frame treeview-widget)
(defun contextual-menu-clsr (gemlog-frame treeview-widget)
(labels ((copy-uri ()
(a:when-let* ((selections (gui:treeview-get-selection treeview-widget))
(links (with-output-to-string (stream)
@ -232,7 +232,7 @@
(open-gemlog-clsr main-window table))
(gui:bind (gui:treeview (gui-goodies:tree table))
#$<3>$
(contextual-menu-clrs table (gui:treeview (gui-goodies:tree table))))
(contextual-menu-clsr table (gui:treeview (gui-goodies:tree table))))
(gui:bind (gui:treeview (gui-goodies:tree table))
#$<KeyPress>$
(lambda (e)

168
src/gui/client/gempub-window.lisp
View File

@ -159,3 +159,171 @@
(open-gempub-clsr main-window table))
(gui:focus (gui:treeview (gui-goodies:tree table)))
(gui:transient toplevel master))))
(defun %make-gempub (gemtext-directory title index-file author language description published-date license copyright cover-file)
(let ((index-filename (fs:path-last-element index-file))
(cover-filename (fs:path-last-element cover-file)))
(fs:copy-a-file index-file (fs:cat-parent-dir gemtext-directory index-filename) :overwrite t)
(fs:copy-a-file cover-file (fs:cat-parent-dir gemtext-directory cover-filename) :overwrite t)
(with-open-file (stream
(fs:cat-parent-dir gemtext-directory gempub:+metadata-entry-name+)
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(format stream
"title: ~a~%index: ~a~%author: ~a~%language: ~a~%description: ~a~%published: ~a~%license: ~a~%copyright: ~a~%cover: ~a~%"
title
index-filename
author
language
description
published-date
license
copyright
cover-filename))
(os-utils:zip-directory gemtext-directory :flat t)))
(defun create-gempub (gemtext-dir)
(gui:with-modal-toplevel (toplevel :title (_ "Add Metadata"))
(let* ((toplevel-widget (gui:modal-toplevel-root-widget toplevel))
(summary (make-instance 'gui:label
:master toplevel-widget
:text (_ "Provide the information as metadata for your book then presso OK button: fields marched with \"*\" are mandatory")
:grid '(0 0)))
(frame (make-instance 'gui:frame
:master toplevel-widget
:grid '(1 0 :sticky :news)))
(title-label (make-instance 'gui:label
:master frame
:text (_ "Title*")
:grid '(0 0)))
(title-entry (make-instance 'gui:entry
:master frame
:grid '(1 0)))
(index-label (make-instance 'gui:label
:master frame
:text ""
:grid '(2 1)))
(index-button (make-instance 'gui:button
:master frame
:text (_ "Choose index file")
:grid '(2 0)
:command
(lambda ()
(let* ((file-types `((,(_ "Gempub") "*.gmi")))
(file (gui:get-open-file :file-types
file-types
:initial-dir
gemtext-dir
:parent
toplevel-widget)))
(setf (gui:text index-label) file)))))
(author-label (make-instance 'gui:label
:master frame
:text (_ "Author")
:grid '(3 0)))
(author-entry (make-instance 'gui:entry
:master frame
:grid '(4 0)))
(language-label (make-instance 'gui:label
:master frame
:text (_ "Language")
:grid '(5 0)))
(language-entry (make-instance 'gui:entry
:master frame
:grid '(6 0)))
(description-label (make-instance 'gui:label
:master frame
:text (_ "Description")
:grid '(7 0)))
(description-entry (make-instance 'gui:entry
:master frame
:grid '(8 0)))
(published-label (make-instance 'gui:label
:master frame
:text (_ "Published* (format: YYYY-MM-DD)")
:grid '(9 0)))
(published-entry (make-instance 'gui:entry
:master frame
:grid '(10 0)))
(license-label (make-instance 'gui:label
:master frame
:text (_ "License")
:grid '(11 0)))
(license-entry (make-instance 'gui:entry
:master frame
:grid '(12 0)))
(copyright-label (make-instance 'gui:label
:master frame
:text (_ "Copyright")
:grid '(13 0)))
(copyright-entry (make-instance 'gui:entry
:text "©…"
:master frame
:grid '(14 0)))
(cover-label (make-instance 'gui:label
:master frame
:text (_ "")
:grid '(15 1)))
(cover-button (make-instance 'gui:button
:master frame
:text (_ "Choose a cover file")
:grid '(15 0)
:command
(lambda ()
(let* ((file-types `((,(_ "Jpeg files") "*.jpeg")
(,(_ "Jpeg files") "*.jpg")
(,(_ "PNG files") "*.png")))
(file (gui:get-open-file :file-types
file-types
:initial-dir
gemtext-dir
:parent
toplevel-widget)))
(setf (gui:text cover-label) file)))))
(ok-button-cb (lambda ()
(cond
((not (ignore-errors (misc:parse-timestring (gui:text published-entry))))
(gui-goodies:error-dialog toplevel-widget (_ "The format of the puiblished data is invalid")))
((text-utils:string-empty-p (gui:text title-entry))
(gui-goodies:error-dialog toplevel-widget
(_ "The title is mandatory")))
(t
(gui-goodies:with-busy* (toplevel-widget)
(%make-gempub gemtext-dir
(gui:text title-entry)
(gui:text index-label)
(gui:text author-entry)
(gui:text language-entry)
(gui:text description-entry)
(gui:text published-entry)
(gui:text license-entry)
(gui:text copyright-entry)
(gui:text cover-label))
(gui:exit-from-modal-toplevel toplevel))))))
(ok-button (make-instance 'gui:button
:grid '(2 0)
:master toplevel-widget
:text (_ "OK")
:command ok-button-cb))
(cancel-button (make-instance 'gui:button
:grid '(2 1)
:master toplevel-widget
:text (_ "Cancel")
:command
(lambda ()
(gui:exit-from-modal-toplevel toplevel)))))
(declare (ignore summary
title-label
index-button
author-label
language-label
description-label
published-label
license-label
copyright-label
cover-button
ok-button
cancel-button)))))

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

@ -267,8 +267,12 @@
:accelerator (client-configuration:get-keybinding :view-source))
(gui:make-menubutton gempub
(_ "Search gempub library")
(menu:search-gempub-library-clrs main-window)
(menu:search-gempub-library-clsr main-window)
:accelerator (client-configuration:get-keybinding :search-gempub-library))
#+:gempub-generation-support
(gui:make-menubutton gempub
(_ "Make gempub file")
(menu:make-gempub-clsr main-window))
(gui:make-menubutton file
(_ "Quit")
#'menu:quit
@ -640,7 +644,7 @@ local file paths."
(gui:make-menubutton popup-menu (_ "Add all links to tour") #'add-to-tour-callback)
(gui:popup popup-menu x y)))))
(defun contextual-menu-link-clrs (link-name link-value main-window)
(defun contextual-menu-link-clsr (link-name link-value main-window)
(labels ((add-to-tour-callback ()
(enqueue-add-link-to-tour link-value link-name))
(download-background-callback ()
@ -863,7 +867,7 @@ local file paths."
:cursor-outside
(gui:find-cursor :xterm)
:button-3-callback
(contextual-menu-link-clrs link-name
(contextual-menu-link-clsr link-name
target-iri
main-window)
:button-2-callback
@ -1960,7 +1964,7 @@ local file paths."
(client-configuration:get-keybinding :search-gempub-library)
(lambda (e)
(declare (ignore e))
(funcall (menu:search-gempub-library-clrs main-window))))
(funcall (menu:search-gempub-library-clsr main-window))))
(gui:bind target
(client-configuration:get-keybinding :quit)
(lambda (e)

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

@ -148,7 +148,7 @@
(client-main-window::set-address-bar-text main-window (to-s iri))
(client-main-window::open-iri (to-s iri) main-window nil))))
(defun search-gempub-library-clrs (main-window)
(defun search-gempub-library-clsr (main-window)
(lambda ()
(gui-goodies:with-notify-errors
(let* ((query (gui-mw:text-input-dialog main-window
@ -161,3 +161,10 @@
ev:+standard-event-priority+
query)))
(client-gempub-window:init-window main-window main-window table-results)))))
(defun make-gempub-clsr (main-window)
(declare (ignore main-window))
(lambda ()
(let ((directory (gui:choose-directory :title (_ "Choose directory with the gempub sources"))))
(when (text-utils:string-not-empty-p directory)
(client-gempub-window:create-gempub directory)))))

3
src/misc-utils.lisp
View File

@ -955,6 +955,9 @@ to the array"
;; unix timestamp is seconds from 1970-01-01T00:00:00Z
(+ unix-timestamp +unix-epoch+))
(defun parse-timestring (string)
(local-time:parse-timestring string))
(defmacro gen-time-access (name pos)
`(defun ,(format-fn-symbol t "time-~a-of" name) (time-list)
(elt time-list ,pos)))

15
src/os-utils.lisp
View File

@ -319,5 +319,20 @@ numerical user ID, as an assoc-list."
(when (not (process-exit-success-p process))
(error (format nil (_ "File ~s extraction from ~s failed") file-entry zip-file))))))
(defun zip-directory (dir &key (flat nil))
(with-output-to-string (stream)
(let* ((process (run-external-program +zip-bin+
(append (when flat
(list "-j"))
(list "-r"
dir
dir))
:search t
:wait t
:output stream
:error :output)))
(when (not (process-exit-success-p process))
(error (format nil (_ "Compressing directory ~s failed") dir))))))
(defun copy-to-clipboard (text)
(trivial-clipboard:text text))

10
src/package.lisp
View File

@ -36,6 +36,7 @@
:+openssl-bin+
:+xdg-open-bin+
:+unzip-bin+
:+zip-bin+
:+man-bin+
:+montage-bin+
:+file-bin+
@ -253,6 +254,7 @@
:null-pointer-p
:with-load-forms-in-var
:time-unix->universal
:parse-timestring
:time-seconds-of
:time-minutes-of
:time-hour-of
@ -432,6 +434,7 @@
:file->mime-type
:unzip-file
:unzip-single-file
:zip-directory
:copy-to-clipboard
:user-info
:user-info-name
@ -2942,6 +2945,7 @@
(:shadowing-import-from :text-utils :split-lines)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:+metadata-entry-name+
:gempub-file-p
:extract-metadata
:sync-library
@ -3610,7 +3614,8 @@
:show-tour-clsr
:manage-gemlogs
:show-page-source-clsr
:search-gempub-library-clrs))
:search-gempub-library-clsr
:make-gempub-clsr))
(defpackage :client-certificates-window
(:use
@ -3753,7 +3758,8 @@
(:gui-shapes :nodgui.shapes)
(:menu :client-menu-command))
(:export
:init-window))
:init-window
:create-gempub))
(defpackage :client-search-frame
(:use