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

- added link to the search results page that leads to the matching posts.

This commit is contained in:
cage 2024-05-11 12:45:02 +02:00
parent 32de4f5bd4
commit 6d07aacbe1
6 changed files with 109 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/constants.lisp
View File

@ -169,17 +169,19 @@ General Public License for more details."
(define-constant +octect-type+ '(unsigned-byte 8) :test #'equalp)
(define-constant +gemini-file-extension+ "gmi" :test #'string=)
(define-constant +gemini-file-extension+ "gmi" :test #'string=)
(define-constant +file-scheme+ "file" :test #'string=)
(define-constant +file-scheme+ "file" :test #'string=)
(define-constant +internal-scheme+ "about" :test #'string=)
(define-constant +internal-scheme+ "about" :test #'string=)
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)
(define-constant +internal-scheme-view-source+ "view-source" :test #'string=)
(define-constant +internal-scheme-view-source+ "view-source" :test #'string=)
(define-constant +internal-scheme-local-posts+ "fediverse-virtual-path" :test #'string=)
(define-constant +fediverse-account-name-server-separator+ "@" :test #'string=)

135
src/open-message-link-window.lisp
View File

@ -77,64 +77,87 @@
(draw *open-message-link-window*)
*open-message-link-window*))
(defun parse-fediverse-virtual-iri (iri)
(let ((parsed-iri (iri:iri-parse iri)))
(if (string= (uri:scheme parsed-iri)
+internal-scheme-local-posts+)
(values (uri:host parsed-iri)
(text-utils:trim-blanks (uri:path parsed-iri)
'(#\/)))
(error (_ "address ~a ias not a valid virtual path for fediverse folders")
iri))))
(defun fediverse-virtual-iri-p (iri)
(let ((parsed-iri (iri:iri-parse iri)))
(string= (uri:scheme parsed-iri)
+internal-scheme-local-posts+)))
(defun open-message-link (url enqueue)
(tui-utils:with-notify-errors
(if (text-utils:string-starts-with-p gopher-parser:+gopher-scheme+ url)
(multiple-value-bind (host port type selector)
(gopher-parser:parse-iri url)
(gopher-window::make-request host port type selector))
(let ((decoded-path (if (percent-encoded-p url)
(percent-decode url)
url)))
(when (and (not enqueue)
(swconf:close-link-window-after-select-p))
(ui:close-open-message-link-window))
(cond
((gemini-client:absolute-gemini-or-titan-url-p url)
(db:insert-in-history (ui:open-url-prompt) url)
(db:gemlog-mark-as-seen url)
(gemini-viewer:ensure-just-one-stream-rendering)
(if (gemini-client:absolute-titan-url-p url)
(let ((upload-file-or-string nil))
(labels ((on-token-input-complete (token)
(when (string-not-empty-p token)
(db-utils:with-ready-database (:connect nil)
(db:save-titan-token url token)
(let* ((pathname (fs:namestring->pathname upload-file-or-string))
(file-exists-p (fs:file-exists-p pathname))
(size (if file-exists-p
(fs:file-size pathname)
(length upload-file-or-string)))
(mime (if file-exists-p
(os-utils:file->mime-type pathname)
constants:+mime-type-text+))
(upload-data (if file-exists-p
pathname
upload-file-or-string)))
(gemini-viewer::post-titan-url url
upload-data
size
mime
token)))))
(on-input-complete (data)
(db-utils:with-ready-database (:connect nil)
(let ((cached-token (db:saved-titan-token url)))
(setf upload-file-or-string data)
(ui:ask-string-input #'on-token-input-complete
:initial-value cached-token
:prompt
(_ "type access token: "))))))
(ui:ask-string-input #'on-input-complete
:prompt (_ "Upload: ")
:complete-fn #'complete:directory-complete)))
(gemini-viewer:load-gemini-url url
:give-focus-to-message-window t
:enqueue enqueue
:use-cached-file-if-exists t)))
((fs:dirp decoded-path)
(ui:open-file-explorer decoded-path))
(t
(os-utils:open-resource-with-external-program decoded-path nil)))))))
(cond
((text-utils:string-starts-with-p gopher-parser:+gopher-scheme+ url)
(multiple-value-bind (host port type selector)
(gopher-parser:parse-iri url)
(gopher-window::make-request host port type selector)))
((fediverse-virtual-iri-p url)
(multiple-value-bind (timeline folder)
(parse-fediverse-virtual-iri url)
(program-events:push-event (make-instance 'program-events:refresh-thread-windows-event
:new-timeline timeline
:new-folder folder))))
(t
(let ((decoded-path (if (percent-encoded-p url)
(percent-decode url)
url)))
(when (and (not enqueue)
(swconf:close-link-window-after-select-p))
(ui:close-open-message-link-window))
(cond
((gemini-client:absolute-gemini-or-titan-url-p url)
(db:insert-in-history (ui:open-url-prompt) url)
(db:gemlog-mark-as-seen url)
(gemini-viewer:ensure-just-one-stream-rendering)
(if (gemini-client:absolute-titan-url-p url)
(let ((upload-file-or-string nil))
(labels ((on-token-input-complete (token)
(when (string-not-empty-p token)
(db-utils:with-ready-database (:connect nil)
(db:save-titan-token url token)
(let* ((pathname (fs:namestring->pathname upload-file-or-string))
(file-exists-p (fs:file-exists-p pathname))
(size (if file-exists-p
(fs:file-size pathname)
(length upload-file-or-string)))
(mime (if file-exists-p
(os-utils:file->mime-type pathname)
constants:+mime-type-text+))
(upload-data (if file-exists-p
pathname
upload-file-or-string)))
(gemini-viewer::post-titan-url url
upload-data
size
mime
token)))))
(on-input-complete (data)
(db-utils:with-ready-database (:connect nil)
(let ((cached-token (db:saved-titan-token url)))
(setf upload-file-or-string data)
(ui:ask-string-input #'on-token-input-complete
:initial-value cached-token
:prompt
(_ "type access token: "))))))
(ui:ask-string-input #'on-input-complete
:prompt (_ "Upload: ")
:complete-fn #'complete:directory-complete)))
(gemini-viewer:load-gemini-url url
:give-focus-to-message-window t
:enqueue enqueue
:use-cached-file-if-exists t)))
((fs:dirp decoded-path)
(ui:open-file-explorer decoded-path))
(t
(os-utils:open-resource-with-external-program decoded-path nil))))))))
(defclass open-links-window ()
((links

1
src/package.lisp
View File

@ -78,6 +78,7 @@
:+internal-path-bookmark+
:+internal-path-gemlogs+
:+internal-scheme-view-source+
:+internal-scheme-local-posts+
:+fediverse-account-name-server-separator+
:+language-codes+
;; GUI

17
src/program-events.lisp
View File

@ -1978,11 +1978,18 @@
(let ((line (text-utils:join-with-strings* " "
(tooter:url result)
(funcall name-fn result))))
(format str "~a~%" (gemini-parser:geminize-link line))))))))
(format str "~a~%" (gemini-parser:geminize-link line)))))))
(link-to-search-results (folder)
(format nil
"~a://~a/~a"
+internal-scheme-local-posts+
db:+home-timeline+
folder)))
(with-accessors ((payload payload)) object
(let* ((found-statuses (api-client:find-results payload))
(found-hashtags (get-results-info payload "hashtags" 2 #'tooter:name))
(found-accounts (get-results-info payload "accounts" 1 #'tooter:username))
(let* ((found-statuses (api-client:find-results payload))
(found-hashtags (get-results-info payload "hashtags" 2 #'tooter:name))
(found-accounts (get-results-info payload "accounts" 1 #'tooter:username))
(link-to-results (gemini-parser:geminize-link (link-to-search-results (query-results-folder-name))))
(query-page (text-utils:strcat (gemini-parser:geminize-h1 (format nil
(_ "Query results~2%")))
(format nil
@ -1991,6 +1998,8 @@
(length found-statuses))
(length found-statuses)
(query-results-folder-name))
link-to-results
(format nil "~%")
(gemini-parser:geminize-h2 (format nil
(_ "Query: ~a~2%")
payload))

4
src/scheduled-events.lisp
View File

@ -17,7 +17,7 @@
(in-package :scheduled-events)
(define-constant +refresh-all-chats-data-frequency+ 10000 :test #'=)
(define-constant +refresh-all-chats-data-frequency+ 50000 :test #'=)
(define-constant +refresh-all-chats-messages-frequency+ 50 :test #'=)
@ -25,7 +25,7 @@
(define-constant +purge-gemlog-entries-frequency+ 30000 :test #'=)
(define-constant +announcements-check-frequency+ 10000 :test #'=)
(define-constant +announcements-check-frequency+ 50000 :test #'=)
(defun triggedp (ticks frequency)
(= (rem ticks frequency)

7
src/text-utils.lisp
View File

@ -715,7 +715,12 @@ printed in the box column by column; in the example above the results are:
(defmethod lines->uri ((object null))
object)
(defun collect-links (text &optional (schemes '("http" "https" "ftp" "gemini" "gopher")))
(defun collect-links (text &optional (schemes (list "http"
"https"
"ftp"
"gemini"
"gopher"
constants:+internal-scheme-local-posts+)))
"Collect all hyperlinks in a text marked from a list of valid `schemes'"
(flet ((build-re-scheme ()
(let ((res ""))