diff --git a/src/constants.lisp b/src/constants.lisp index a599bc2..c5fedcc 100644 --- a/src/constants.lisp +++ b/src/constants.lisp @@ -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=) diff --git a/src/open-message-link-window.lisp b/src/open-message-link-window.lisp index 933092e..bd25a54 100644 --- a/src/open-message-link-window.lisp +++ b/src/open-message-link-window.lisp @@ -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 diff --git a/src/package.lisp b/src/package.lisp index 7cffa97..0732df3 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/program-events.lisp b/src/program-events.lisp index d83b45f..f7c5ecf 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -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)) diff --git a/src/scheduled-events.lisp b/src/scheduled-events.lisp index 9868d3d..cd0ff76 100644 --- a/src/scheduled-events.lisp +++ b/src/scheduled-events.lisp @@ -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) diff --git a/src/text-utils.lisp b/src/text-utils.lisp index e86b1c6..36973e2 100644 --- a/src/text-utils.lisp +++ b/src/text-utils.lisp @@ -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 ""))