cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- added a window to show gempub file's library.

This commit is contained in:
cage 2021-08-25 18:15:57 +02:00
parent a8dca176f3
commit 2be45b4a25
9 changed files with 217 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
etc/default-theme.conf
View File

@ -566,6 +566,22 @@ gemini-certificates-window.creation-time.foreground = green
gemini-certificates-window.access-time.foreground = green
# window for managing gempub libray
gempub-library-window.background = black
gempub-library-window.foreground = cyan
gempub-library-window.input.selected.background = cyan
gempub-library-window.input.selected.foreground = black
gempub-library-window.link.foreground = yellow
gempub-library-window.creation-time.foreground = green
gempub-library-window.access-time.foreground = green
# chats
#chat list window

14
etc/init.lisp
View File

@ -157,6 +157,8 @@
(define-key "M-g c s" #'gemini-open-certificates-window)
(define-key "M-g g l" #'open-gempub-library)
(define-key "M-right" #'pass-focus-on-right)
(define-key "M-left" #'pass-focus-on-left)
@ -435,6 +437,18 @@
(define-key "l" #'open-message-link *gemlog-subscription-keymap*)
;; gempub library window keymap
(define-key "up" #'gempub-library-window-go-up *gempub-library-keymap*)
(define-key "down" #'gempub-library-window-go-down *gempub-library-keymap*)
(define-key "q" #'gempub-library-window-close *gempub-library-keymap*)
(define-key "C-J" #'gemini-delete-certificate *gemini-certificates-keymap*)
;; tags keymap
(define-key "up" #'tag-go-up *tags-keymap*)

2
src/db.lisp
View File

@ -1875,7 +1875,7 @@ row."
(gen-access-message-row charset :charset)
(gen-access-message-row publishedp :published)
(gen-access-message-row published :published)
(gen-access-message-row publish-date :publish-date)

130
src/gempub.lisp
View File

@ -118,3 +118,133 @@
(ui:notify (format nil (_ "Removed gempub ~s from library, missing file") removed)))
(loop for added in added-file do
(ui:notify (format nil (_ "Added gempub ~s into the library") added))))))
(defrule spaces (+ blank)
(:constant nil))
(defrule column (or "title"
"author"
"language"
"description"
"publish-date"
"revision-date"
"copyright")
(:text t))
(defrule column-value (and #\" (+ (not #\")) #\")
(:text t))
(defrule term (or and-where
or-where
like)
(:function (lambda (a) (join-with-strings a " "))))
(defrule like (and column spaces "like" spaces column-value)
(:function (lambda (a) (format nil
"~a like \"%~a%\""
(first a)
(string-trim '(#\") (fifth a))))))
(defrule and-where (and term spaces "and" spaces term))
(defrule or-where (and term spaces "or" spaces term))
(defrule where-clause (and "where" spaces (+ term))
(:function (lambda (a) (strcat "where " (join-with-strings (third a) " ")))))
(defun parse-search-gempub (query)
(let* ((where-clause (when (string-not-empty-p query)
(parse 'where-clause query)))
(sql-query (if where-clause
(strcat (format nil
"select * from \"~a\" ~a"
db::+table-gempub-metadata+
where-clause))
(format nil "select * from \"~a\"" db::+table-gempub-metadata+))))
(db-utils:query-low-level sql-query)))
(defclass gempub-library-window (focus-marked-window
simple-line-navigation-window
title-window
border-window)
((query-rows
:initform '()
:initarg :query-rows
:accessor query-rows)))
(defmethod refresh-config :after ((object gempub-library-window))
(open-attach-window:refresh-view-links-window-config object
swconf:+key-gempub-library-window+)
(refresh-config-sizes object swconf:+key-thread-window+)
(win-move object
(- (win-width *main-window*)
(win-width object))
0)
(win-move object
(- (win-width *main-window*)
(win-width object))
0)
object)
(defun row->list-item (row)
(join-with-strings* " "
(db:row-title row)
(db:row-author row)
(db:row-published row)))
(defun row->unselected-list-item (row)
(row->list-item row))
(defun row->selected-list-item (row)
(row->list-item row))
(defmethod resync-rows-db ((object gempub-library-window)
&key
(redraw t)
(suggested-message-index 0))
(with-accessors ((rows rows)
(selected-line-bg selected-line-bg)
(selected-line-fg selected-line-fg)
(query-rows query-rows)) object
(flet ((make-rows (rows bg fg)
(mapcar (lambda (row)
(make-instance 'line
:normal-text (row->unselected-list-item row)
:selected-text (row->selected-list-item row)
:fields row
:normal-bg fg
:normal-fg bg
:selected-bg bg
:selected-fg fg))
rows)))
(with-croatoan-window (croatoan-window object)
(line-oriented-window:update-all-rows object
(make-rows query-rows
selected-line-bg
selected-line-fg))
(when suggested-message-index
(handler-bind ((conditions:out-of-bounds
(lambda (e)
(invoke-restart 'ignore-selecting-action e))))
(select-row object suggested-message-index)))
(when redraw
(win-clear object)
(draw object))))))
(defun open-gempub-library-window (query)
(let* ((low-level-window (tui:make-croatoan-window :enable-function-keys t)))
(setf *gempub-library-window*
(make-instance 'gempub-library-window
:query-rows (parse-search-gempub query)
:top-row-padding 0
:title (_ "Gempub library")
:single-row-height 1
:uses-border-p t
:keybindings keybindings:*gempub-library-keymap*
:croatoan-window low-level-window))
(refresh-config *gempub-library-window*)
(resync-rows-db *gempub-library-window* :redraw nil)
(when (not (line-oriented-window:rows-empty-p *gempub-library-window*))
(line-oriented-window:select-row *gempub-library-window* 0))
(draw *gempub-library-window*)
*gempub-library-window*))

3
src/keybindings.lisp
View File

@ -270,6 +270,9 @@ produces a tree and graft the latter on `existing-tree'"
(defparameter *gemini-toc-keymap* (make-starting-comand-tree)
"The keymap for gemini table of contents window.")
(defparameter *gempub-library-keymap* (make-starting-comand-tree)
"The keymap for gempub library of publication.")
(defun define-key (key-sequence function &optional (existing-keymap *global-keymap*))
"Define a key sequence that trigger a function:

22
src/package.lisp
View File

@ -917,7 +917,7 @@
:row-author
:row-language
:row-charset
:row-publishedp
:row-published
:row-publish-date
:row-revision-date
:row-copyright
@ -1113,6 +1113,7 @@
:+key-error-dialog+
:+key-input-dialog+
:+key-notify-window+
:+key-gempub-library-window+
:+key-notification-life+
:+key-modeline+
:+key-date-format+
@ -1342,7 +1343,8 @@
:*gemini-certificates-window*
:*gemini-subscription-window*
:*gemini-toc-window*
:*chats-list-window*))
:*chats-list-window*
:*gempub-library-window*))
(defpackage :complete
(:use
@ -1643,6 +1645,7 @@
:*chat-message-keymap*
:*gemlog-subscription-keymap*
:*gemini-toc-keymap*
:*gempub-library-keymap*
:define-key
:init-keyboard-mapping
:find-keymap-node
@ -2440,12 +2443,16 @@
:constants
:text-utils
:misc
:specials)
:specials
:windows
:line-oriented-window)
(:shadowing-import-from :text-utils :split-lines)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:extract-metadata
:sync-library))
:sync-library
:parse-search-gempub
:open-gempub-library-window))
(defpackage :main-window
(:use
@ -2670,7 +2677,12 @@
:import-gemini-certificate
:bookmark-gemini-page
:display-bookmark
:delete-gemini-bookmark))
:delete-gemini-bookmark
:open-gempub-library
:gempub-library-window-move
:gempub-library-window-go-up
:gempub-library-window-go-down
:gempub-library-window-close))
(defpackage :scheduled-events
(:use

1
src/software-configuration.lisp
View File

@ -466,6 +466,7 @@
input-dialog
help-dialog
notify-window
gempub-library-window
notification-icon
life
quick-help

3
src/specials.lisp
View File

@ -66,3 +66,6 @@
(defparameter *chats-list-window* nil
"The window that shows all the chats.")
(defparameter *gempub-library-window* nil
"The window that shows the gempub library.")

32
src/ui-goodies.lisp
View File

@ -561,6 +561,11 @@ current has focus"
:documentation "Move focus on gemini page table of contents window"
:info-change-focus-message (_ "Focus passed on gemini toc window."))
(gen-focus-to-window gempub-library-window
*gempub-library-window*
:documentation "Move focus on gempub library window"
:info-change-focus-message (_ "Focus passed on gempub library window"))
(defun print-quick-help ()
"Print a quick help"
(keybindings:print-help *main-window*))
@ -2148,3 +2153,30 @@ gemini page the program is rendering."
:prompt (format nil (_ "Delete bookmark: "))
:complete-fn
(complete:bookmark-description-complete-clsr db:+bookmark-gemini-type-entry+))))
(defun open-gempub-library ()
"Open the personal library of gempub files."
(flet ((on-input-completed (query)
(push-event (make-instance 'function-event
:payload
(lambda ()
(db-utils:with-ready-database (:connect nil)
(gempub:open-gempub-library-window query)
(focus-to-gempub-library-window)))))))
(ui:ask-string-input #'on-input-completed
:prompt (format nil (_ "Search criteria: ")))))
(defun gempub-library-window-move (amount)
(ignore-errors
(line-oriented-window:unselect-all *gempub-library-window*)
(line-oriented-window:row-move *gempub-library-window* amount)
(draw *gempub-library-window*)))
(defun gempub-library-window-go-up ()
(gempub-library-window-move -1))
(defun gempub-library-window-go-down ()
(gempub-library-window-move 1))
(defun gempub-library-window-close ()
(close-window-and-return-to-message *gempub-library-window*))