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

Merge branch 'master' into add-gemini-gui

This commit is contained in:
cage 2023-01-12 20:17:53 +01:00
parent 0e71b7a48a 003a7a26ac
commit 8d60b063c8
4 changed files with 51 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
src/gemini-viewer.lisp
View File

@ -97,8 +97,9 @@
(ui:open-gemini-toc) (ui:open-gemini-toc)
(program-events:with-enqueued-process () (program-events:with-enqueued-process ()
(ui:open-gemini-message-link-window :give-focus nil))) (ui:open-gemini-message-link-window :give-focus nil)))
((gemini-client:text-file-stream-p meta) ((and (gemini-client:text-file-stream-p meta)
(ensure-just-one-stream-rendering) (os-utils:open-resource-with-tinmop-p iri))
(ensure-just-one-stream-rendering)
(force-rendering-of-cached-file stream-object) (force-rendering-of-cached-file stream-object)
(setf (stream-status stream-object) :completed)) (setf (stream-status stream-object) :completed))
(t (t
@ -370,25 +371,30 @@
(download-stream download-stream) (download-stream download-stream)
(octect-count octect-count) (octect-count octect-count)
(support-file support-file)) wrapper-object (support-file support-file)) wrapper-object
(labels ((maybe-render-line (line-event) (labels ((rendering-in-tinmop-p ()
(when (eq (stream-status wrapper-object) :rendering) (or gemini-format-p
(and (os-utils:open-resource-with-tinmop-p (download-iri wrapper-object))
(eq (stream-status wrapper-object) :rendering))))
(maybe-render-line (line-event)
(when (rendering-in-tinmop-p)
(program-events:push-event line-event))) (program-events:push-event line-event)))
(maybe-change-title (title-event) (maybe-change-title (title-event)
(when (eq (stream-status wrapper-object) :rendering) (when (rendering-in-tinmop-p)
(program-events:push-event title-event))) (program-events:push-event title-event)))
(maybe-render-toc () (maybe-render-toc ()
(when (eq (stream-status wrapper-object) :rendering) (when (rendering-in-tinmop-p)
(ui:open-gemini-toc))) (ui:open-gemini-toc)))
(maybe-render-focus-mark () (maybe-render-focus-mark ()
(when (eq (stream-status wrapper-object) :rendering) (when (rendering-in-tinmop-p)
(program-events:with-enqueued-process () (program-events:with-enqueued-process ()
(windows:draw-focus-mark *message-window*)))) (windows:draw-focus-mark *message-window*))))
(maybe-render-links () (maybe-render-links ()
(when (eq (stream-status wrapper-object) :rendering) (when (rendering-in-tinmop-p)
(program-events:with-enqueued-process () (program-events:with-enqueued-process ()
(ui:open-gemini-message-link-window :give-focus nil)))) (ui:open-gemini-message-link-window :give-focus nil))))
(maybe-render-preformat-wrapper (file-stream wrapper-object) (maybe-render-preformat-wrapper (file-stream wrapper-object)
(when (not gemini-format-p) (when (and (os-utils:open-resource-with-tinmop-p (download-iri wrapper-object))
(not gemini-format-p))
(let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+)) (let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+))
(parsed-line (gemini-parser:parse-gemini-file preformat-line))) (parsed-line (gemini-parser:parse-gemini-file preformat-line)))
(setf (parsed-lines wrapper-object) (setf (parsed-lines wrapper-object)
@ -472,24 +478,27 @@
(progn (progn
(return-from download-loop nil)))) (return-from download-loop nil))))
(maybe-render-preformat-wrapper file-stream wrapper-object) (maybe-render-preformat-wrapper file-stream wrapper-object)
(if (not (downloading-allowed-p wrapper-object)) (cond
(maybe-notify (_ "Gemini document downloading aborted")) ((not (downloading-allowed-p wrapper-object))
(progn (ui:notify (_ "Gemini document downloading aborted")))
(maybe-render-toc) ((rendering-in-tinmop-p)
(maybe-render-links) (maybe-render-toc)
(maybe-render-focus-mark) (maybe-render-links)
(maybe-notify (_ "Gemini document downloading completed")) (maybe-render-focus-mark)
(setf (stream-status wrapper-object) :completed) (ui:notify (_ "Gemini document downloading completed"))
(when (and fragment (setf (stream-status wrapper-object) :completed)
(swconf:config-gemini-fragment-as-regex-p)) (when (and fragment
(let* ((regex (if (text-utils:percent-encoded-p fragment) (swconf:config-gemini-fragment-as-regex-p))
(text-utils:percent-decode fragment) (let* ((regex (if (text-utils:percent-encoded-p fragment)
fragment)) (text-utils:percent-decode fragment)
(priority program-events:+standard-event-priority+) fragment))
(event (make-instance 'program-events:search-message-gemini-fragment-event (priority program-events:+standard-event-priority+)
:priority priority (event (make-instance 'program-events:search-message-gemini-fragment-event
:payload regex))) :priority priority
(program-events:push-event event))))) :payload regex)))
(program-events:push-event event))))
(t
(os-utils:open-resource-with-external-program support-file nil)))
;; (allow-downloading wrapper-object) ;; (allow-downloading wrapper-object)
(gemini-client:close-ssl-socket download-socket)))))))) (gemini-client:close-ssl-socket download-socket))))))))
;; (fs:delete-file-if-exists support-file))))) ;; (fs:delete-file-if-exists support-file)))))

4
src/os-utils.lisp
View File

@ -203,6 +203,10 @@
(error (_ "No program defined in configuration file to edit this kind of files.")) (error (_ "No program defined in configuration file to edit this kind of files."))
(os-utils:xdg-open resource)))))) (os-utils:xdg-open resource))))))
(defun open-resource-with-tinmop-p (resource)
(alexandria:when-let ((program (swconf:link-regex->program-to-use resource)))
(swconf:use-tinmop-as-external-program-p program)))
(defun unzip-file (zip-file destination-dir) (defun unzip-file (zip-file destination-dir)
(cond (cond
((not (fs:file-exists-p zip-file)) ((not (fs:file-exists-p zip-file))

1
src/package.lisp
View File

@ -379,6 +379,7 @@
:send-to-pipe :send-to-pipe
:open-link-with-program :open-link-with-program
:open-resource-with-external-program :open-resource-with-external-program
:open-resource-with-tinmop-p
:unzip-file :unzip-file
:unzip-single-file :unzip-single-file
:copy-to-clipboard)) :copy-to-clipboard))

14
src/ui-goodies.lisp
View File

@ -2377,7 +2377,8 @@ Currently the only recognized protocols are gemini and kami."
(gopher-window::make-request host port type selector)) (gopher-window::make-request host port type selector))
(error () (error-message (_ "Invalid gopher address.")))))) (error () (error-message (_ "Invalid gopher address."))))))
(t (t
(open-gemini-address trimmed-url)))))) (db-utils:with-ready-database (:connect nil)
(open-gemini-address trimmed-url)))))))
(if (null address) (if (null address)
(let ((prompt (open-url-prompt))) (let ((prompt (open-url-prompt)))
(ask-string-input #'on-input-complete (ask-string-input #'on-input-complete
@ -2386,9 +2387,14 @@ Currently the only recognized protocols are gemini and kami."
(on-input-complete address)))) (on-input-complete address))))
(defun open-gemini-address (url) (defun open-gemini-address (url)
(gemini-viewer:load-gemini-url url (with-enqueued-process ()
:use-cached-file-if-exists t (cond
:priority program-events:+maximum-event-priority+)) ((string-empty-p url)
(error-message (_ "Empty address.")))
((iri:iri-parse url :null-on-error t)
(open-message-link-window:open-message-link url nil))
(t
(error-message (_ "Invalid or unknown address."))))))
(defun net-address-history-back () (defun net-address-history-back ()
"Reopen a previous visited net address" "Reopen a previous visited net address"