cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-24 09:17:37 +01:00
Code Issues

- started with gemini link bookmark.

Browse Source
This commit is contained in:
cage 2021-08-16 14:22:47 +02:00
parent 0a3d7baa9d
commit 377d95af51
9 changed files with 166 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/init.lisp
View File

@ -359,6 +359,10 @@
(define-key "b" #'gemini-history-back *gemini-message-keymap*)
(define-key "C-b a" #'bookmark-gemini-page *gemini-message-keymap*)
(define-key "C-b s" #'display-bookmark *gemini-message-keymap*)
(define-key "U" #'gemini-view-source *gemini-message-keymap*)
(define-key "d" #'gemini-open-streams-window *gemini-message-keymap*)

3
src/complete.lisp
View File

@ -261,3 +261,6 @@ list af all possible candidtae for completion."
(defun complete-always-empty (hint)
(declare (ignore hint))
nil)
(with-simple-complete bookmark-section-complete
(lambda () (remove-if #'null (db:bookmark-all-sections))))

57
src/db.lisp
View File

@ -128,6 +128,12 @@
(define-constant +table-gemlog-entries+ :gemlog-entries
:test #'eq)
(define-constant +table-bookmark+ :bookmark
:test #'eq)
(define-constant +bookmark-gemini-type-entry+ "gemini"
:test #'string=)
(define-constant +federated-timeline+ "federated"
:test #'string=)
@ -252,6 +258,18 @@
" REFERENCES ~a (~a) ON DELETE ~a ON UPDATE ~a ~:[ ~;,~]"
(quote-symbol table) (quote-symbol column) on-delete on-update add-comma))
(defun make-bookmark ()
(query-low-level (strcat (prepare-table +table-bookmark+
:autogenerated-id-p t
:autoincrementp t)
"type TEXT NOT NULL,"
"value TEXT NOT NULL,"
"section TEXT,"
"description TEXT,"
;; timestamp
" \"created-at\" TEXT NOT NULL"
+make-close+)))
(defun make-cache ()
(query-low-level (strcat (prepare-table +table-cache+
:autogenerated-id-p t
@ -577,7 +595,9 @@
(create-table-index +table-cache+ '(:id :key))
(create-table-index +table-gemini-tofu-cert+ '(:host))
(create-table-index +table-gemini-subscription+ '(:url))
(create-table-index +table-gemlog-entries+ '(:url)))
(create-table-index +table-gemlog-entries+ '(:url))
(create-table-index +table-bookmark+ '(:type :section :value)))
(defmacro gen-delete (suffix &rest names)
`(progn
@ -604,7 +624,8 @@
+table-chat+
+table-gemini-tofu-cert+
+table-gemini-subscription+
+table-gemlog-entries+))
+table-gemlog-entries+
+table-bookmark+))
(defun build-views ())
@ -638,6 +659,7 @@
(make-tofu-certs)
(make-gemini-subscription)
(make-gemlog-entries)
(make-bookmark)
(build-all-indices)
(fs:set-file-permissions (db-path) (logior fs:+s-irusr+ fs:+s-iwusr+))))
@ -1806,6 +1828,10 @@ row."
(gen-access-message-row seenp :seenp)
(gen-access-message-row description :description)
(gen-access-message-row value :value)
(defun row-votes-count (row)
(and row (db-getf row :votes-count :default 0)))
@ -3077,3 +3103,30 @@ days in the past"
((prepare-for-db t :to-integer 1))
(:and (:= :seenp (prepare-for-db t :to-integer 1))
(:< :date (prepare-for-db treshold)))))))
(defun bookmark-add (type value &key (section nil) (description (_ "no description")))
(with-db-current-timestamp (now)
(query (make-insert +table-bookmark+
(:type :value :section :description :created-at)
(type value section description now)))))
(defun bookmark-delete (type value)
(query (make-delete +table-bookmark+
(:and (:= :type type)
(:= :value value)))))
(defun bookmark-all-sections ()
(let ((rows (query (select :section (from +table-bookmark+)))))
(mapcar #'second rows)))
(defun bookmark-all-by-section (section)
(if (null section)
(query (select :* (from +table-bookmark+) (where (:is-null :section))))
(query (select :* (from +table-bookmark+) (where (:= :section section))))))
(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)))))

9
src/gemini/gemini-parser.lisp
View File

@ -670,3 +670,12 @@
(string-equal +gemini-scheme+
(uri:scheme parsed))
(uri:host parsed)))))
(defgeneric gemini-first-h1 (data))
(defmethod gemini-first-h1 ((data cons))
(first (html-utils:children (html-utils:find-tag :h1 data))))
(defmethod gemini-first-h1 ((data string))
(when-let ((parsed (parse-gemini-file data)))
(gemini-first-h1 parsed)))

3
src/gemini/package.lisp
View File

@ -88,7 +88,8 @@
:sexp->text-rows
:sexp->text
:parse-gemini-response-header
:gemini-iri-p))
:gemini-iri-p
:gemini-first-h1))
(defpackage :gemini-client
(:use

3
src/gemini/subscription.lisp
View File

@ -54,8 +54,7 @@ This function return the 'post-title' substring."
(page (babel:octets-to-string data))
(parsed (parse-gemini-file page))
(iri (iri:iri-parse url))
(title (first (html-utils:children (html-utils:find-tag :h1
parsed)))))
(title (gemini-first-h1 parsed)))
(let* ((maybe-subtitle-pos (html-utils:position-tag :h2 parsed))
(subtitle (when (subtitle-p parsed maybe-subtitle-pos)
(first (html-utils:children (elt parsed

18
src/package.lisp
View File

@ -779,6 +779,8 @@
:+table-saved-status+
:+table-crypto-data+
:+table-gemini-subscription+
:+table-bookmark+
:+bookmark-gemini-type-entry+
:+federated-timeline+
:+local-timeline+
:+home-timeline+
@ -885,6 +887,8 @@
:row-cache-accessed-at
:row-cache-created-at
:row-seenp
:row-description
:row-value
:next-status-tree
:previous-status-tree
:message-tree-root-equal
@ -1010,7 +1014,11 @@
:row-post-seenp
:gemlog-entries
:delete-gemlog-entry
:purge-seen-gemlog-entries))
:purge-seen-gemlog-entries
:bookmark-add
:bookmark-delete
:bookmark-all-sections
:bookmark-all-grouped-by-section))
(defpackage :date-formatter
(:use
@ -1316,7 +1324,8 @@
:conversation-folder
:make-complete-gemini-iri-fn
:complete-chat-message
:complete-always-empty))
:complete-always-empty
:bookmark-section-complete))
(defpackage :program-events
(:use
@ -1408,6 +1417,7 @@
:report-status-event
:add-crypto-data-event
:poll-vote-event
:gemini-display-data-page
:gemini-request-event
:gemini-back-event
:gemini-got-line-event
@ -2597,7 +2607,9 @@
:pass-focus-on-bottom
:pass-focus-on-top
:ask-input-on-tofu-error
:import-gemini-certificate))
:import-gemini-certificate
:bookmark-gemini-page
:display-bookmark))
(defpackage :scheduled-events
(:use

28
src/program-events.lisp
View File

@ -1016,6 +1016,34 @@
(tui:with-notify-errors
(api-client:poll-vote poll-id choices))))
(defclass gemini-display-data-page (program-event)
((window
:initform nil
:initarg :window
:accessor window)
(local-path
:initform ""
:initarg :local-path
:accessor local-path)))
(defmethod process-event ((object gemini-display-data-page))
(with-accessors ((page-data payload)
(window window)
(local-path local-path)) object
(tui:with-notify-errors
(let* ((parsed (gemini-parser:parse-gemini-file page-data))
(local-path-p (text-utils:string-not-empty-p local-path))
(links (gemini-parser:sexp->links parsed
nil
nil
local-path
:comes-from-local-file local-path-p))
(ir-text (gemini-parser:sexp->text-rows parsed
gemini-client:*gemini-page-theme*)))
(gemini-viewer:maybe-initialize-metadata window)
(refresh-gemini-message-window links page-data ir-text nil)
(windows:draw window)))))
(defclass gemini-request-event (program-event)
((url
:initform nil

49
src/ui-goodies.lisp
View File

@ -2078,3 +2078,52 @@ gemini page the program is rendering."
(ui:ask-string-input #'on-cert-path-input-complete
:prompt (format nil (_ "Insert certificate file: "))
:complete-fn #'complete:directory-complete))))
(defun bookmark-gemini-page ()
(if (message-window:gemini-window-p)
(let* ((link (gemini-viewer:current-gemini-url))
(metadata (message-window:metadata *message-window*))
(source (gemini-viewer:gemini-metadata-source-file metadata))
(description (gemini-parser:gemini-first-h1 source)))
(labels ((on-description-completed (new-description)
(setf description new-description)
(ui:ask-string-input #'on-section-completed
:prompt (format nil (_ "Insert bookmark section: "))
:complete-fn #'complete:bookmark-section-complete))
(on-section-completed (section)
(db-utils:with-ready-database (:connect nil)
(db:bookmark-add db:+bookmark-gemini-type-entry+
link
:section section
:description description))
(notify (format nil (_ "Added ~s in bookmark") link))))
(ui:ask-string-input #'on-description-completed
:prompt (format nil (_ "Insert bookmark description: "))
:initial-value description)))
(error-message (_ "The window is not displaying a gemini document"))))
(defun generate-bookmark-page ()
(let ((bookmarks-sections (db:bookmark-all-grouped-by-section)))
(with-output-to-string (stream)
(loop for section in bookmarks-sections do
(let ((header (car section))
(bookmarks (cdr section)))
(when (string-empty-p header)
(setf header (_ "Uncategorized")))
(write-string (gemini-parser:geminize-h1 header) stream)
(write-char #\Newline stream)
(write-char #\Newline stream)
(loop for bookmark in bookmarks do
(let ((link (join-with-strings* " "
(db:row-value bookmark)
(db:row-description bookmark))))
(write-string (gemini-parser:geminize-link link) stream)
(write-char #\Newline stream)))
(write-char #\Newline stream))))))
(defun display-bookmark ()
(let* ((bookmark-page (generate-bookmark-page))
(event (make-instance 'gemini-display-data-page
:window *message-window*
:payload bookmark-page)))
(push-event event)))