mirror of
https://codeberg.org/cage/tinmop/
synced 2025-03-12 11:20:05 +01:00
- added missing files for gempub managements.
This commit is contained in:
parent
b76f6bda1b
commit
c3ed76a3ff
92
src/gui/client/gempub-window.lisp
Normal file
92
src/gui/client/gempub-window.lisp
Normal file
@ -0,0 +1,92 @@
|
||||
(in-package :client-gempub-window)
|
||||
|
||||
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
|
||||
|
||||
(defclass gempub-frame (gui-goodies:table-frame) ())
|
||||
|
||||
(defun build-column-values (title
|
||||
author
|
||||
year
|
||||
description)
|
||||
(list title
|
||||
author
|
||||
year
|
||||
description))
|
||||
|
||||
(defmacro build-column-value-accessor (name index)
|
||||
(assert (>= index 0))
|
||||
(assert (symbolp name))
|
||||
`(defun ,(format-fn-symbol t "column-~a" name) (fields)
|
||||
(elt fields ,index)))
|
||||
|
||||
(build-column-value-accessor title 1)
|
||||
|
||||
(build-column-value-accessor author 2)
|
||||
|
||||
(build-column-value-accessor year 3)
|
||||
|
||||
(build-column-value-accessor description 4)
|
||||
|
||||
(db::gen-access-message-row description :description)
|
||||
|
||||
(db::gen-access-message-row year :published)
|
||||
|
||||
(defun resync-rows (gempub-frame new-rows)
|
||||
(with-accessors ((tree gui-goodies:tree)
|
||||
(rows gui-goodies:rows)) gempub-frame
|
||||
(gui:treeview-delete-all tree)
|
||||
(setf rows new-rows)
|
||||
(loop for row in rows
|
||||
for index-count from 0 do
|
||||
(let* ((id (text-utils:to-s (db:row-id row)))
|
||||
(author (db:row-author row))
|
||||
(title (db:row-title row))
|
||||
(year (row-year row))
|
||||
(description (text-utils:ellipsize (row-description row)
|
||||
50))
|
||||
(tree-row (make-instance 'gui:tree-item
|
||||
:id id
|
||||
:text id
|
||||
:column-values (build-column-values title
|
||||
author
|
||||
year
|
||||
description)
|
||||
:index gui:+treeview-last-index+)))
|
||||
(gui:treeview-insert-item tree :item tree-row)))
|
||||
(gui:treeview-refit-columns-width (gui-goodies:tree gempub-frame))
|
||||
gempub-frame))
|
||||
|
||||
(defmethod initialize-instance :after ((object gempub-frame) &key &allow-other-keys)
|
||||
(with-accessors ((tree gui-goodies:tree)
|
||||
(rows gui-goodies:rows)) object
|
||||
(let ((treeview (make-instance 'gui:scrolled-treeview
|
||||
:master object
|
||||
:pack '(:side :top :expand t :fill :both)
|
||||
:columns (list (_ "Title")
|
||||
(_ "Author")
|
||||
(_ "Year")
|
||||
(_ "Description")))))
|
||||
(setf tree treeview)
|
||||
(gui:treeview-heading tree
|
||||
gui:+treeview-first-column-id+
|
||||
:text (_ "ID"))
|
||||
(resync-rows object rows)
|
||||
object)))
|
||||
|
||||
(defun open-gempub-clsr (main-window treeview-gempubs)
|
||||
(declare (ignore main-window treeview-gempubs))
|
||||
(lambda (e)
|
||||
(declare (ignore e))))
|
||||
|
||||
(defun init-window (master main-window query-results)
|
||||
(client-main-window:hide-autocomplete-candidates main-window)
|
||||
(gui:with-toplevel (toplevel :master master :title (_ "Query results"))
|
||||
(let* ((table (make-instance 'gempub-frame
|
||||
:master toplevel
|
||||
:rows query-results)))
|
||||
(gui:grid table 0 0 :sticky :nwe)
|
||||
(gui:bind (gui:treeview (gui-goodies:tree table))
|
||||
#$<<TreeviewSelect>>$
|
||||
(open-gempub-clsr main-window table))
|
||||
(gui:focus (gui:treeview (gui-goodies:tree table)))
|
||||
(gui:transient toplevel master))))
|
@ -247,6 +247,7 @@
|
||||
(tour (gui:make-menu bar (_ "Tour")))
|
||||
(bookmarks (gui:make-menu bar (_ "Bookmarks")))
|
||||
(gemlogs (gui:make-menu bar (_ "Gemlogs")))
|
||||
(gempub (gui:make-menu bar (_ "Books")))
|
||||
(help (gui:make-menu bar (_ "Help"))))
|
||||
(gui:make-menubutton tools
|
||||
(_ "Certificates")
|
||||
@ -264,7 +265,7 @@
|
||||
(_ "View source")
|
||||
(menu:show-page-source-clsr main-window)
|
||||
:accelerator (client-configuration:get-keybinding :view-source))
|
||||
(gui:make-menubutton file
|
||||
(gui:make-menubutton gempub
|
||||
(_ "Search gempub library")
|
||||
(menu:search-gempub-library-clrs main-window)
|
||||
:accelerator (client-configuration:get-keybinding :search-gempub-library))
|
||||
|
46
src/gui/server/public-api-gemini-gempub.lisp
Normal file
46
src/gui/server/public-api-gemini-gempub.lisp
Normal file
@ -0,0 +1,46 @@
|
||||
;; tinmop: a multiprotocol client
|
||||
;; Copyright © 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 gemini-gempub-search-results (box) ())
|
||||
|
||||
(defmethod yason:encode ((object gemini-gempub-search-results)
|
||||
&optional (stream *standard-output*))
|
||||
(let ((table (unbox object)))
|
||||
(encode-flat-array-of-plists table stream)))
|
||||
|
||||
(defun gempub-search (query)
|
||||
(make-instance 'gemini-gempub-search-results
|
||||
:contents (gempub:parse-search-gempub query)))
|
||||
|
||||
(defun gempub-synchronize-library ()
|
||||
(gempub:sync-library :notify nil)
|
||||
t)
|
||||
|
||||
(defun gempub-file-p (path)
|
||||
(gempub:gempub-file-p path :ignore-errors t))
|
||||
|
||||
(defun gempub-index-path (gempub-filepath)
|
||||
(when (gempub-file-p gempub-filepath)
|
||||
(let ((temp-directory (fs:temporary-directory)))
|
||||
(os-utils:unzip-file gempub-filepath temp-directory)
|
||||
(let* ((library-entry (db:gempub-metadata-find gempub-filepath))
|
||||
(index-file (db:row-index-file library-entry)))
|
||||
(if index-file
|
||||
(fs:cat-parent-dir temp-directory index-file)
|
||||
temp-directory)))))
|
Loading…
x
Reference in New Issue
Block a user