mirror of https://codeberg.org/cage/tinmop/
- fixed 'iri:absolute-url-p';
- fixed 'gemini-parser:absolutize-link'.
This commit is contained in:
parent
1da16a2fe1
commit
02a0225773
|
@ -285,6 +285,8 @@
|
||||||
(let ((parsed (or (ignore-errors (iri:iri-parse link-value))
|
(let ((parsed (or (ignore-errors (iri:iri-parse link-value))
|
||||||
(iri:make-iri nil nil nil nil link-value nil nil))))
|
(iri:make-iri nil nil nil nil link-value nil nil))))
|
||||||
(cond
|
(cond
|
||||||
|
((iri:absolute-url-p link-value)
|
||||||
|
link-value)
|
||||||
((null original-host)
|
((null original-host)
|
||||||
(if (fs:extension-dir-p original-path)
|
(if (fs:extension-dir-p original-path)
|
||||||
(normalize-path (strcat original-path
|
(normalize-path (strcat original-path
|
||||||
|
@ -293,7 +295,7 @@
|
||||||
(normalize-path (strcat path-to-last-dir
|
(normalize-path (strcat path-to-last-dir
|
||||||
fs:*directory-sep*
|
fs:*directory-sep*
|
||||||
link-value)))))
|
link-value)))))
|
||||||
((null (iri:host parsed))
|
((iri:relative-url-p link-value)
|
||||||
(let* ((absolute-path-p (string-starts-with-p "/" link-value))
|
(let* ((absolute-path-p (string-starts-with-p "/" link-value))
|
||||||
(query-path-p (iri:query parsed))
|
(query-path-p (iri:query parsed))
|
||||||
(path (cond
|
(path (cond
|
||||||
|
@ -317,9 +319,16 @@
|
||||||
:query (iri:query parsed)
|
:query (iri:query parsed)
|
||||||
:port original-port
|
:port original-port
|
||||||
:fragment (iri:fragment parsed))))
|
:fragment (iri:fragment parsed))))
|
||||||
|
((and (null (iri:host parsed))
|
||||||
|
(not (null (iri:scheme parsed))))
|
||||||
|
link-value)
|
||||||
((null (iri:scheme parsed))
|
((null (iri:scheme parsed))
|
||||||
(strcat +gemini-scheme+ ":"
|
(make-gemini-iri (iri:host parsed)
|
||||||
(to-s (fs:normalize-path parsed))))
|
(fs:normalize-path (iri:path parsed))
|
||||||
|
:scheme gemini-constants:+gemini-scheme+
|
||||||
|
:query (iri:query parsed)
|
||||||
|
:port (iri:port parsed)
|
||||||
|
:fragment (iri:fragment parsed)))
|
||||||
(t
|
(t
|
||||||
(to-s (fs:normalize-path parsed))))))
|
(to-s (fs:normalize-path parsed))))))
|
||||||
|
|
||||||
|
|
|
@ -399,10 +399,13 @@
|
||||||
(with-output-to-string (stream)
|
(with-output-to-string (stream)
|
||||||
(render-iri object stream)))
|
(render-iri object stream)))
|
||||||
|
|
||||||
(defun absolute-url-p (url)
|
(defun relative-url-p (url)
|
||||||
(when-let ((iri (iri:iri-parse url :null-on-error t)))
|
(when-let ((iri (iri:iri-parse url :null-on-error t)))
|
||||||
(not (or (null (iri:scheme iri))
|
(and (null (iri:scheme iri))
|
||||||
(null (iri:host iri))))))
|
(null (iri:host iri)))))
|
||||||
|
|
||||||
|
(defun absolute-url-p (url)
|
||||||
|
(not (relative-url-p url)))
|
||||||
|
|
||||||
(defun absolute-url-scheme-p (url expected-scheme)
|
(defun absolute-url-scheme-p (url expected-scheme)
|
||||||
(when-let ((parsed-iri (iri:iri-parse url :null-on-error t)))
|
(when-let ((parsed-iri (iri:iri-parse url :null-on-error t)))
|
||||||
|
|
|
@ -813,6 +813,7 @@
|
||||||
:iri=
|
:iri=
|
||||||
:remove-fragment
|
:remove-fragment
|
||||||
:normalize-path
|
:normalize-path
|
||||||
|
:relative-url-p
|
||||||
:absolute-url-p
|
:absolute-url-p
|
||||||
:absolute-url-scheme-p
|
:absolute-url-scheme-p
|
||||||
:ipv4-address-p
|
:ipv4-address-p
|
||||||
|
|
Loading…
Reference in New Issue