mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-03 04:37:29 +01:00
- added link to the search results page that leads to the matching posts.
This commit is contained in:
cage
parent
32de4f5bd4
commit
6d07aacbe1
@ -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=)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 ""))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user