diff --git a/etc/init.lisp b/etc/init.lisp index ba31e11..0e7cb34 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -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*) diff --git a/src/complete.lisp b/src/complete.lisp index 7daa266..4f467f4 100644 --- a/src/complete.lisp +++ b/src/complete.lisp @@ -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)))) diff --git a/src/db.lisp b/src/db.lisp index 4735a61..233c17d 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -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))))) diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index b3c56a4..cf8a4af 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -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))) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index d78c787..256a78f 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -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 diff --git a/src/gemini/subscription.lisp b/src/gemini/subscription.lisp index 7561269..a6d5b21 100644 --- a/src/gemini/subscription.lisp +++ b/src/gemini/subscription.lisp @@ -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 diff --git a/src/package.lisp b/src/package.lisp index 3d12715..3c2e453 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/program-events.lisp b/src/program-events.lisp index b972f36..afbece7 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -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 diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 13dd029..f15ed1b 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -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)))