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

- [RPC] fixed 'code' argument of 'make-gemini-response' (passed a struct but an integer was expected instead); 

- [GUI] implemented redirect;

- [GUI] implemented opening of local directory.
This commit is contained in:
cage 2023-03-08 16:16:55 +01:00
parent 24b0b07bb3
commit 3d59696059
2 changed files with 47 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/gui/client/main-window.lisp
View File

@ -232,6 +232,17 @@
(lambda ()
(open-iri link-value main-window use-cache)))
(defun absolutize-link (request-iri link-value)
(let ((parsed-request-iri (iri:iri-parse request-iri)))
(multiple-value-bind (x host path query port y w z)
(gemini-client:displace-iri parsed-request-iri)
(declare (ignore x y w z))
(gemini-parser:absolutize-link link-value
host
port
path
query))))
(defun collect-ir-lines (request-iri main-window lines)
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)
@ -291,24 +302,12 @@
(gui-conf:gemini-quote-justification))
(:pre
(gui-conf:gemini-preformatted-text-justification))))
(absolutize-link (link-value)
(if (iri:absolute-url-p link-value)
link-value
(let ((parsed-request-iri (iri:iri-parse request-iri)))
(multiple-value-bind (x host path query port y w z)
(gemini-client:displace-iri parsed-request-iri)
(declare (ignore x y w z))
(gemini-parser:absolutize-link link-value
host
port
path
query)))))
(linkify (line line-number)
(multiple-value-bind (link-bg link-fg)
(gui-conf:gemini-link-colors)
(let* ((link-font (gui-conf:gemini-link-font-configuration))
(link-value (ir-href line))
(target-iri (absolutize-link link-value))
(target-iri (absolutize-link request-iri link-value))
(link-name (or (ir-line line)
link-value))
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
@ -444,8 +443,8 @@
(ev:with-enqueued-process-and-unblock ()
(clean-gemtext main-window)
(set-text-gemtext main-window lines)))))
((fs:directory-exists-p path))))
((fs:directory-exists-p path)
(gui:choose-directory :initial-dir path :parent main-window :mustexist t))))
(defun open-iri (iri main-window use-cache)
(handler-case
@ -472,6 +471,14 @@
original-iri)
(displace-gemini-response connecting-response)
(cond
((gemini-client:header-redirect-p status-code)
(when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
:title (_ "Redirection")
:parent main-window)
(let ((redirect-iri (if (iri:absolute-url-p meta)
meta
(absolutize-link iri meta))))
(start-stream-iri redirect-iri main-window use-cache status))))
((gemini-client:header-success-p status-code)
(cond
((eq status +stream-status-streaming+)
@ -480,8 +487,7 @@
(start-streaming-thread iri
:use-cache nil
:process-function (lambda (lines)
(collect-ir-lines iri main-window lines)
(misc:dbg "lines ~a" lines))
(collect-ir-lines iri main-window lines))
:status status))
((eq status +stream-status-downloading+)
(when (not (find-db-stream-url iri))

37
src/gui/server/public-api-gemini-stream.lisp
View File

@ -84,11 +84,17 @@
(gemini-client:debug-gemini "response is a gemini document stream")
(gemini-viewer:push-url-to-history *gemini-window* actual-iri)
(make-text-based-stream t)
(make-gemini-response gemini-client:+success+ meta actual-iri))
(make-gemini-response (gemini-client:code gemini-client:+success+)
(gemini-client:description gemini-client:+success+)
meta
actual-iri))
((gemini-client:text-file-stream-p meta)
(gemini-client:debug-gemini "response is a text stream")
(make-text-based-stream nil)
(make-gemini-response gemini-client:+success+ meta actual-iri))
(make-gemini-response (gemini-client:code gemini-client:+success+)
(gemini-client:description gemini-client:+success+)
meta
actual-iri))
(t
(let* ((starting-status :streaming)
(gemini-stream (make-instance 'gemini-others-data-stream
@ -113,11 +119,14 @@
path
query
fragment)
(make-gemini-response gemini-client:+success+ meta actual-iri)))))))
(make-gemini-response (gemini-client:code gemini-client:+success+)
(gemini-client:description gemini-client:+success+)
meta
actual-iri)))))))
(defun make-gemini-response (code meta iri &key (cached nil))
(list (cons "status" (gemini-client:code code))
(cons "status-description" (gemini-client:description code))
(defun make-gemini-response (status-code status-code-description meta iri &key (cached nil))
(list (cons "status" status-code)
(cons "status-description" status-code-description)
(cons "meta" meta)
(cons "cached" cached)
(cons "iri" iri)))
@ -128,18 +137,18 @@
(use-cached-file-if-exists nil)
(do-nothing-if-exists-in-db nil))
(labels ((redirect-dispatch (status code-description meta response socket iri parsed-iri)
(declare (ignore parsed-iri code-description response socket))
(declare (ignore parsed-iri response socket))
(gemini-client:debug-gemini "response redirect to: ~s" meta)
(make-gemini-response status meta iri))
(make-gemini-response status code-description meta iri))
(input-dispatch (status code-description meta response socket iri parsed-iri)
(declare (ignore code-description response socket parsed-iri))
(declare (ignore response socket parsed-iri))
(gemini-client:debug-gemini "response requested input: ~s" meta)
(make-gemini-response status meta iri))
(make-gemini-response status code-description meta iri))
(sensitive-input-dispatch (status code-description meta response socket iri parsed-iri)
(declare (ignore code-description response socket parsed-iri))
(declare (ignore response socket parsed-iri))
(gemini-client:debug-gemini "response requested sensitive input: ~s"
meta)
(make-gemini-response status meta iri))
(make-gemini-response status code-description meta iri))
(certificate-request-dispatch (status
code-description
meta
@ -175,7 +184,9 @@
(progn
(gemini-client:debug-gemini "caching found for ~a" actual-iri)
(gemini-viewer:push-url-to-history *gemini-window* actual-iri)
(make-gemini-response gemini-client:+success+ nil
(make-gemini-response (gemini-client:code gemini-client:+success+)
(gemini-client:description gemini-client:+success+)
nil
actual-iri
:cached t))
(progn