- added rc1 version.

configure

@@ -1,6 +1,6 @@
 #! /bin/sh
 # Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.71 for tinmop 0.9.9.1414213562-rc1.
+# Generated by GNU Autoconf 2.71 for tinmop 0.9.9.14142135623-rc1.
 #
 # Report bugs to <https://codeberg.org/cage/tinmop/>.
 #
@@ -611,8 +611,8 @@ MAKEFLAGS=
 # Identity of this package.
 PACKAGE_NAME='tinmop'
 PACKAGE_TARNAME='tinmop'
-PACKAGE_VERSION='0.9.9.1414213562-rc1'
-PACKAGE_STRING='tinmop 0.9.9.1414213562-rc1'
+PACKAGE_VERSION='0.9.9.14142135623-rc1'
+PACKAGE_STRING='tinmop 0.9.9.14142135623-rc1'
 PACKAGE_BUGREPORT='https://codeberg.org/cage/tinmop/'
 PACKAGE_URL='https://www.autistici.org/interzona/tinmop.html'
 
@@ -1355,7 +1355,7 @@ if test "$ac_init_help" = "long"; then
   # Omit some internal or obsolete options to make the list less imposing.
   # This message is too long to be a string in the A/UX 3.1 sh.
   cat <<_ACEOF
-\`configure' configures tinmop 0.9.9.1414213562-rc1 to adapt to many kinds of systems.
+\`configure' configures tinmop 0.9.9.14142135623-rc1 to adapt to many kinds of systems.
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 
@@ -1426,7 +1426,7 @@ fi
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
-     short | recursive ) echo "Configuration of tinmop 0.9.9.1414213562-rc1:";;
+     short | recursive ) echo "Configuration of tinmop 0.9.9.14142135623-rc1:";;
    esac
   cat <<\_ACEOF
 
@@ -1531,7 +1531,7 @@ fi
 test -n "$ac_init_help" && exit $ac_status
 if $ac_init_version; then
   cat <<\_ACEOF
-tinmop configure 0.9.9.1414213562-rc1
+tinmop configure 0.9.9.14142135623-rc1
 generated by GNU Autoconf 2.71
 
 Copyright (C) 2021 Free Software Foundation, Inc.
@@ -1768,7 +1768,7 @@ cat >config.log <<_ACEOF
 This file contains any messages produced by compilers while
 running configure, to aid debugging if configure makes a mistake.
 
-It was created by tinmop $as_me 0.9.9.1414213562-rc1, which was
+It was created by tinmop $as_me 0.9.9.14142135623-rc1, which was
 generated by GNU Autoconf 2.71.  Invocation command line was
 
   $ $0$ac_configure_args_raw
@@ -3039,7 +3039,7 @@ fi
 
 # Define the identity of the package.
  PACKAGE='tinmop'
- VERSION='0.9.9.1414213562-rc1'
+ VERSION='0.9.9.14142135623-rc1'
 
 
 printf "%s\n" "#define PACKAGE \"$PACKAGE\"" >>confdefs.h
@@ -8736,7 +8736,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
 # report actual input values of CONFIG_FILES etc. instead of their
 # values after options handling.
 ac_log="
-This file was extended by tinmop $as_me 0.9.9.1414213562-rc1, which was
+This file was extended by tinmop $as_me 0.9.9.14142135623-rc1, which was
 generated by GNU Autoconf 2.71.  Invocation command line was
 
   CONFIG_FILES    = $CONFIG_FILES
@@ -8796,7 +8796,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\
 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 ac_cs_config='$ac_cs_config_escaped'
 ac_cs_version="\\
-tinmop config.status 0.9.9.1414213562-rc1
+tinmop config.status 0.9.9.14142135623-rc1
 configured by $0, generated by GNU Autoconf 2.71,
   with options \\"\$ac_cs_config\\"
 

configure.ac

@@ -15,7 +15,7 @@ dnl You should have received a copy of the GNU General Public License
 dnl along with this program.
 dnl If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
 
-AC_INIT([tinmop],[0.9.9.1414213562-rc1],[https://codeberg.org/cage/tinmop/],[tinmop],[https://www.autistici.org/interzona/tinmop.html])
+AC_INIT([tinmop],[0.9.9.14142135623-rc1],[https://codeberg.org/cage/tinmop/],[tinmop],[https://www.autistici.org/interzona/tinmop.html])
 
 AM_INIT_AUTOMAKE([-Wall foreign])
 

src/complete.lisp

@@ -220,11 +220,11 @@ list af all possible candidates for completion."
 (defun maybe-remove-file-scheme (maybe-file-scheme-iri)
   (let ((parsed-as-iri (iri:iri-parse maybe-file-scheme-iri :null-on-error t)))
     (if (and parsed-as-iri
-             (string= (uri:scheme parsed-as-iri) constants:+file-scheme+)
+             (string= (iri:scheme parsed-as-iri) constants:+file-scheme+)
              (and (text-utils:string-starts-with-p (text-utils:strcat constants:+file-scheme+
                                                                       "://")
                                                    maybe-file-scheme-iri)))
-        (uri:path parsed-as-iri)
+        (iri:path parsed-as-iri)
         maybe-file-scheme-iri)))
 
 (defun expand-iri-as-local-path-p (hint)

src/constants.lisp

@@ -175,7 +175,7 @@ General Public License for more details."
 
 (define-constant +http-scheme+                     "http"                   :test #'string=)
 
-(define-constant +about-scheme+                    "about"                  :test #'string=)
+(define-constant +internal-about-scheme+           "about"                  :test #'string=)
 
 (define-constant +internal-scheme-bookmark+        "bookmark"               :test #'string=)
 

src/gemini-viewer.lisp

@@ -789,7 +789,7 @@
                                     :prompt  error-message)))))))
            (titan-upload-dispatch (url)
              (let ((parsed (iri:iri-parse url)))
-               (values (gemini-client::remove-titan-parameters-from-path (uri:path parsed))
+               (values (gemini-client::remove-titan-parameters-from-path (iri:path parsed))
                        titan-data
                        titan-size
                        titan-mime

src/gemini/client.lisp

@@ -392,14 +392,14 @@
   (maybe-percent-encode fragment))
 
 (defun displace-iri (iri)
-  (let* ((host       (uri:host     iri))
-         (path       (uri:path     iri))
-         (query      (uri:query    iri))
-         (fragment   (uri:fragment iri))
-         (port       (or (uri:port iri)
+  (let* ((host       (iri:host     iri))
+         (path       (iri:path     iri))
+         (query      (iri:query    iri))
+         (fragment   (iri:fragment iri))
+         (port       (or (iri:port iri)
                          +gemini-default-port+))
-         (scheme     (uri:scheme   iri))
-         (user-info  (uri:user-info iri))
+         (scheme     (iri:scheme   iri))
+         (user-info  (iri:user-info iri))
          (actual-iri (gemini-parser:make-gemini-iri host
                                                     path
                                                     :user-info user-info
@@ -726,16 +726,16 @@
     (when meta-url
       (if (absolute-gemini-url-p meta)
           meta
-          (let* ((meta-query      (uri:query     meta-url))
-                 (meta-path       (uri:path      meta-url))
+          (let* ((meta-query      (iri:query     meta-url))
+                 (meta-path       (iri:path      meta-url))
                  (meta-path-query (if meta-query
                                       (strcat meta-path "?" meta-query)
                                       meta-path))
                  (new-url    (gemini-parser:absolutize-link meta-path-query
-                                                            (uri:host  iri-from)
-                                                            (uri:port  iri-from)
-                                                            (uri:path  iri-from)
-                                                            (uri:query iri-from))))
+                                                            (iri:host  iri-from)
+                                                            (iri:port  iri-from)
+                                                            (iri:path  iri-from)
+                                                            (iri:query iri-from))))
             new-url)))))
 
 (defmethod build-redirect-iri (meta (iri-from string))
@@ -774,5 +774,5 @@ TODO: Add client certificate."
 
 (defun url-needs-proxy-p (url)
   (and (swconf:config-gemini-proxy)
-       (string= (uri:scheme (iri:iri-parse url))
+       (string= (iri:scheme (iri:iri-parse url))
                 +http-scheme+)))

src/gemini/gemini-parser.lisp

@@ -293,31 +293,31 @@
              (normalize-path (strcat path-to-last-dir
                                      fs:*directory-sep*
                                      link-value)))))
-      ((null (uri:host parsed))
+      ((null (iri:host parsed))
        (let* ((absolute-path-p  (string-starts-with-p "/" link-value))
-              (query-path-p     (uri:query parsed))
+              (query-path-p     (iri:query parsed))
               (path            (cond
                                  (absolute-path-p
-                                  (uri:path parsed))
+                                  (iri:path parsed))
                                  ((and query-path-p
                                        original-query)
                                   (strcat (safe-all-but-last-elt original-path)
-                                          (uri:path parsed)))
+                                          (iri:path parsed)))
                                  ((or query-path-p
                                       original-query)
                                   (strcat original-path
-                                          (uri:path parsed)))
+                                          (iri:path parsed)))
                                  (t
                                   (strcat (if original-path
                                               (path-last-dir original-path)
                                               "/")
-                                          (uri:path parsed))))))
+                                          (iri:path parsed))))))
          (make-gemini-iri original-host
                           (fs:normalize-path path)
-                          :query    (uri:query parsed)
+                          :query    (iri:query parsed)
                           :port     original-port
-                          :fragment (uri:fragment parsed))))
-      ((null (uri:scheme parsed))
+                          :fragment (iri:fragment parsed))))
+      ((null (iri:scheme parsed))
        (strcat +gemini-scheme+ ":"
                (to-s (fs:normalize-path parsed))))
       (t
@@ -393,7 +393,7 @@
 (defun gemini-link-iri-p (iri)
   (conditions:with-default-on-error (nil)
     (or (text-utils:string-starts-with-p +gemini-scheme+ iri)
-        (null (uri:scheme (iri:iri-parse iri))))))
+        (null (iri:scheme (iri:iri-parse iri))))))
 
 (defclass gemini-page-theme ()
   ((link-prefix-gemini
@@ -908,8 +908,8 @@
     (let ((parsed (iri:iri-parse maybe-iri)))
       (and parsed
            (string-equal +gemini-scheme+
-                         (uri:scheme parsed))
-           (uri:host parsed)))))
+                         (iri:scheme parsed))
+           (iri:host parsed)))))
 
 (defgeneric gemini-first-h1 (data))
 

src/gemini/subscription.lisp

@@ -70,10 +70,10 @@ This function return the 'post-title' substring."
               (gemlog-iri (iri:iri-parse url)))
     (let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a)))
                                 (sexp->links parsed
-                                             (uri:host  gemlog-iri)
-                                             (uri:port  gemlog-iri)
-                                             (uri:path  gemlog-iri)
-                                             (uri:query gemlog-iri))))
+                                             (iri:host  gemlog-iri)
+                                             (iri:port  gemlog-iri)
+                                             (iri:path  gemlog-iri)
+                                             (iri:query gemlog-iri))))
           (new-posts-count 0))
       (loop for link in links do
         (when (not (db:find-gemlog-entry (to-s (target link))))

src/gui/client/internal-paths.lisp

@@ -1,7 +1,7 @@
 (in-package :client-main-window)
 
 (defun make-internal-iri (path &optional (query nil) (fragment nil))
-  (iri:make-iri +about-scheme+ nil nil nil path query fragment))
+  (iri:make-iri +internal-about-scheme+ nil nil nil path query fragment))
 
 (defun internal-iri-bookmark ()
   (make-internal-iri +internal-scheme-bookmark+))

src/gui/client/main-window.lisp

@@ -147,7 +147,7 @@
              (print-info-message (_ "Stream finished"))
              (gui:configure-mouse-pointer (gemtext-widget main-window) :xterm)
              (render-toc main-window iri)
-             (a:when-let* ((fragment (uri:fragment (iri:iri-parse iri)))
+             (a:when-let* ((fragment (iri:fragment (iri:iri-parse iri)))
                            (regexp   (gemini-viewer::fragment->regex fragment)))
                (setf (gui:text (client-search-frame::entry (search-frame main-window)))
                      regexp)
@@ -381,11 +381,11 @@
 
 (defun remove-standard-port (iri)
   (let ((copy (iri:copy-iri (iri:iri-parse iri))))
-    (when (and (uri:port copy)
-               (uri:host copy)
-               (= (uri:port copy)
+    (when (and (iri:port copy)
+               (iri:host copy)
+               (= (iri:port copy)
                   gemini-constants:+gemini-default-port+))
-      (setf (uri:port copy) nil))
+      (setf (iri:port copy) nil))
     (to-s copy)))
 
 (defun absolutize-link (request-iri link-value)
@@ -475,7 +475,7 @@
 
 (defun inline-image-p (link-value)
   (a:when-let* ((parsed (iri:iri-parse link-value :null-on-error t))
-                (path   (uri:path parsed)))
+                (path   (iri:path parsed)))
     (and (or (gemini-client:absolute-gemini-url-p link-value)
              (not (iri:absolute-url-p link-value)))
          (or (re:scan "(?i)jpg$"  path)
@@ -595,7 +595,7 @@ local file paths."
                      when (not (iri:absolute-url-p link-value))
                        do
                           (let ((parsed (iri:iri-parse (get-address-bar-text main-window))))
-                            (setf (uri:path parsed)
+                            (setf (iri:path parsed)
                                   (fs:normalize-path link-value))
                             (enqueue-add-link-to-tour (with-output-to-string (stream)
                                                         (iri:render-iri parsed stream))
@@ -1013,7 +1013,7 @@ local file paths."
 (defun iri-ensure-path (iri)
   (let ((parsed (iri:iri-parse iri :null-on-error t)))
     (if (and parsed
-             (null (uri:path parsed)))
+             (null (iri:path parsed)))
         (strcat iri "/")
         iri)))
 
@@ -1075,7 +1075,7 @@ local file paths."
 
 (defun open-search-iri (criteria main-window)
   (let ((parsed-iri-search-capsule (iri:iri-parse (swconf:config-gemini-search-engine-iri))))
-    (setf (uri:query parsed-iri-search-capsule)
+    (setf (iri:query parsed-iri-search-capsule)
           (text-utils:maybe-percent-encode criteria))
     (let ((search-iri (with-output-to-string (stream)
                         (iri:render-iri parsed-iri-search-capsule stream))))
@@ -1090,8 +1090,8 @@ local file paths."
                                                                 ev:+maximum-event-priority+
                                                                 actual-iri)))
         (cond
-          ((string= (uri:scheme parsed-iri) +internal-scheme-view-source+)
-           (setf (uri:scheme parsed-iri) gemini-constants:+gemini-scheme+)
+          ((string= (iri:scheme parsed-iri) +internal-scheme-view-source+)
+           (setf (iri:scheme parsed-iri) gemini-constants:+gemini-scheme+)
            (start-stream-iri (iri-ensure-path (to-s parsed-iri))
                              main-window
                              use-cache
@@ -1113,11 +1113,11 @@ local file paths."
                                :status status)
              (client-stream-frame::refresh-all-streams
               (client-stream-frame::table stream-frame))))
-          ((or (null (uri:scheme parsed-iri))
-               (string= (uri:scheme parsed-iri)
+          ((or (null (iri:scheme parsed-iri))
+               (string= (iri:scheme parsed-iri)
                         constants:+file-scheme+))
            (initialize-ir-lines main-window)
-           (open-local-path (uri:path parsed-iri) main-window))
+           (open-local-path (iri:path parsed-iri) main-window))
           (t
            (client-os-utils:open-resource-with-external-program main-window actual-iri))))
     (esrap:esrap-parse-error (e)

src/gui/client/menu-command.lisp

@@ -144,6 +144,6 @@
   (lambda ()
     (a:when-let ((iri (iri:iri-parse (client-main-window::get-address-bar-text main-window)
                                      :null-on-error t)))
-      (setf (uri:scheme iri) +internal-scheme-view-source+)
+      (setf (iri:scheme iri) +internal-scheme-view-source+)
       (client-main-window::set-address-bar-text main-window (to-s iri))
       (client-main-window::open-iri (to-s iri) main-window nil))))

src/gui/client/titan-window.lisp

@@ -77,7 +77,7 @@
                       titan-data trimmed-data-text)))
         (when (not has-error-p)
           (let ((parameters (gemini-client:make-titan-parameters mime size (gui:text token-entry))))
-            (setf (uri:path url) (strcat (uri:path url) parameters))
+            (setf (iri:path url) (strcat (iri:path url) parameters))
             (gui-goodies:with-notify-errors
               (ev:with-enqueued-process-and-unblock ()
                 (comm:make-request :titan-save-token
@@ -121,7 +121,7 @@
                      (let* ((certificate-path meta)
                             (message  (format nil
                                               (_ "Provide the password to unlock certificate for ~a")
-                                              (uri:path url)))
+                                              (iri:path url)))
                             (password (gui-goodies::password-dialog (gui:root-toplevel)
                                                                     (_ "Unlock certificate")
                                                                     message))

src/gui/server/public-api-gemini-certificates.lisp

@@ -55,7 +55,7 @@
     (declare (ignore x))
     (if proxy-host
         (db:tofu-delete proxy-host)
-        (let ((host (uri:host (iri:iri-parse iri))))
+        (let ((host (iri:host (iri:iri-parse iri))))
           (db:tofu-delete host)))))
 
 (defun gemini-import-certificate (uri cert-file key-file)

src/gui/server/public-api-gemini-stream.lisp

@@ -247,7 +247,7 @@
                                           iri))))))
            (titan-upload-dispatch (url)
              (multiple-value-bind (no-parameters-path mime size token)
-                 (gemini-client::parse-titan-parameters (uri:path (iri:iri-parse url)))
+                 (gemini-client::parse-titan-parameters (iri:path (iri:iri-parse url)))
                (let ((actual-data (if (fs:file-exists-p titan-data)
                                       (fs:namestring->pathname titan-data)
                                       titan-data)))

src/html-utils.lisp

@@ -40,7 +40,7 @@
 (defun http-link-iri-p (iri)
   (conditions:with-default-on-error (nil)
     (or (text-utils:string-starts-with-p +http-scheme+ iri)
-        (null (uri:scheme (iri:iri-parse iri))))))
+        (null (iri:scheme (iri:iri-parse iri))))))
 
 (defun make-tag-node (tag attributes value)
   "create a node"

src/iri-parser.lisp

@@ -252,19 +252,55 @@
 
 (defrule iri-iri-reference (or iri-iri iri-irelative-ref))
 
-(defclass iri (uri:uri) ())
+(defclass iri ()
+  ((scheme
+    :initform nil
+    :initarg  :scheme
+    :accessor scheme)
+   (user-info
+    :initform nil
+    :initarg  :user-info
+    :accessor user-info)
+   (host
+    :initform nil
+    :initarg  :host
+    :writer   (setf host))
+   (port
+    :initform nil
+    :initarg  :port
+    :accessor port)
+   (path
+    :initform nil
+    :initarg  :path
+    :accessor path)
+   (query
+    :initform nil
+    :initarg  :query
+    :accessor query)
+   (fragment
+    :initform nil
+    :initarg  :fragment
+    :accessor fragment)))
+
+(defgeneric host (object))
+
+(defmethod host ((object iri))
+  (let ((host (slot-value object 'host)))
+    (if (text-utils:string-starts-with-p "[" host)
+        (subseq host 1 (1- (length host)))
+        host)))
 
 (defmethod print-object ((object iri) stream)
   (print-unreadable-object (object stream)
     (format stream
             "~s ~s ~s ~s ~s ~s ~s"
-            (uri:scheme    object)
-            (uri:user-info object)
-            (uri:host      object)
-            (uri:port      object)
-            (uri:path      object)
-            (uri:query     object)
-            (uri:fragment  object))))
+            (iri:scheme    object)
+            (iri:user-info object)
+            (iri:host      object)
+            (iri:port      object)
+            (iri:path      object)
+            (iri:query     object)
+            (iri:fragment  object))))
 
 (defun make-iri (&optional scheme user-info host port path query fragment)
   (make-instance 'iri
@@ -300,13 +336,13 @@
           (error e)))))
 
 (defun copy-iri (from)
-  (let ((scheme    (uri:scheme    from))
-        (user-info (uri:user-info from))
-        (host      (slot-value from 'uri:host))
-        (port      (uri:port      from))
-        (path      (uri:path      from))
-        (query     (uri:query     from))
-        (fragment  (uri:fragment  from)))
+  (let ((scheme    (iri:scheme    from))
+        (user-info (iri:user-info from))
+        (host      (slot-value from 'iri:host))
+        (port      (iri:port      from))
+        (path      (iri:path      from))
+        (query     (iri:query     from))
+        (fragment  (iri:fragment  from)))
     (make-iri scheme
               user-info
               host
@@ -319,33 +355,26 @@
 
 (defmethod remove-fragment ((object iri))
   (let ((copied (copy-iri object)))
-    (setf (uri:fragment copied) nil)
+    (setf (iri:fragment copied) nil)
     copied))
 
 (defmethod normalize-path ((object iri))
-  (let ((clean-path (fs:normalize-path (uri:path object)))
+  (let ((clean-path (fs:normalize-path (iri:path object)))
         (copy       (copy-iri  object)))
     (when clean-path
-      (setf (uri:path copy) clean-path))
-    copy))
-
-(defmethod normalize-path ((object uri:uri))
-  (let ((clean-path (fs:normalize-path (uri:path object)))
-        (copy       (uri:copy-uri  object)))
-    (when clean-path
-      (setf (uri:path copy) clean-path))
+      (setf (iri:path copy) clean-path))
     copy))
 
 (defun render-iri (iri &optional (stream *standard-output*))
   (flet ((render ()
            (with-output-to-string (string-stream)
-             (let ((scheme    (uri:scheme    iri))
-                   (user-info (uri:user-info iri))
-                   (host      (slot-value    iri 'uri:host))
-                   (port      (uri:port      iri))
-                   (path      (uri:path      iri))
-                   (query     (uri:query     iri))
-                   (fragment  (uri:fragment  iri)))
+             (let ((scheme    (iri:scheme    iri))
+                   (user-info (iri:user-info iri))
+                   (host      (slot-value    iri 'iri:host))
+                   (port      (iri:port      iri))
+                   (path      (iri:path      iri))
+                   (query     (iri:query     iri))
+                   (fragment  (iri:fragment  iri)))
                (when scheme
                  (format string-stream "~a:" scheme))
                (when host
@@ -372,13 +401,13 @@
 
 (defun absolute-url-p (url)
   (when-let ((iri (iri:iri-parse url :null-on-error t)))
-    (not (or (null (uri:scheme iri))
-             (null (uri:host   iri))))))
+    (not (or (null (iri:scheme iri))
+             (null (iri:host   iri))))))
 
 (defun absolute-url-scheme-p (url expected-scheme)
   (when-let ((parsed-iri (iri:iri-parse url :null-on-error t)))
     (and (absolute-url-p url)
-         (string= (uri:scheme parsed-iri) expected-scheme))))
+         (string= (iri:scheme parsed-iri) expected-scheme))))
 
 (defun ipv4-address-p (string)
   (ignore-errors
@@ -394,32 +423,32 @@
 
 (defun iri-to-parent-path (iri)
   (let* ((parsed-iri  (iri:iri-parse iri))
-         (parent-path (fs:parent-dir-path (uri:path parsed-iri)))
+         (parent-path (fs:parent-dir-path (iri:path parsed-iri)))
          (new-iri     (to-s (make-instance 'iri:iri
-                                           :scheme    (uri:scheme    parsed-iri)
-                                           :host      (uri:host      parsed-iri)
-                                           :user-info (uri:user-info parsed-iri)
-                                           :port      (uri:port      parsed-iri)
+                                           :scheme    (iri:scheme    parsed-iri)
+                                           :host      (iri:host      parsed-iri)
+                                           :user-info (iri:user-info parsed-iri)
+                                           :port      (iri:port      parsed-iri)
                                            :path      parent-path))))
     new-iri))
 
 (defgeneric iri= (a b))
 
 (defmethod iri= ((a iri) (b iri))
-  (let ((scheme-a    (uri:scheme    a))
-        (user-info-a (uri:user-info a))
-        (host-a      (uri:host      a))
-        (port-a      (uri:port      a))
-        (path-a      (uri:path      a))
-        (query-a     (uri:query     a))
-        (fragment-a  (uri:fragment  a))
-        (scheme-b    (uri:scheme    b))
-        (user-info-b (uri:user-info b))
-        (host-b      (uri:host      b))
-        (port-b      (uri:port      b))
-        (path-b      (uri:path      b))
-        (query-b     (uri:query     b))
-        (fragment-b  (uri:fragment  b)))
+  (let ((scheme-a    (iri:scheme    a))
+        (user-info-a (iri:user-info a))
+        (host-a      (iri:host      a))
+        (port-a      (iri:port      a))
+        (path-a      (iri:path      a))
+        (query-a     (iri:query     a))
+        (fragment-a  (iri:fragment  a))
+        (scheme-b    (iri:scheme    b))
+        (user-info-b (iri:user-info b))
+        (host-b      (iri:host      b))
+        (port-b      (iri:port      b))
+        (path-b      (iri:path      b))
+        (query-b     (iri:query     b))
+        (fragment-b  (iri:fragment  b)))
     (and (string= scheme-a    scheme-b)
          (string= user-info-a user-info-b)
          (string= host-a      host-b)

src/open-message-link-window.lisp

@@ -79,17 +79,17 @@
 
 (defun parse-fediverse-virtual-iri (iri)
   (let ((parsed-iri (iri:iri-parse iri)))
-    (if (string= (uri:scheme parsed-iri)
+    (if (string= (iri:scheme parsed-iri)
                  +internal-scheme-local-posts+)
-        (values (uri:host parsed-iri)
-                (text-utils:trim-blanks (uri:path parsed-iri)
+        (values (iri:host parsed-iri)
+                (text-utils:trim-blanks (iri:path parsed-iri)
                                         '(#\/)))
         (error (_ "address ~a is not a valid virtual path for posts (timeline/folder)")
                iri))))
 
 (defun fediverse-virtual-iri-p (iri)
   (let ((parsed-iri (iri:iri-parse iri)))
-    (string= (uri:scheme parsed-iri)
+    (string= (iri:scheme parsed-iri)
              +internal-scheme-local-posts+)))
 
 (defun open-message-link (url enqueue)

src/package.lisp

@@ -75,7 +75,7 @@
    :+gemini-file-extension+
    :+file-scheme+
    :+http-scheme+
-   :+about-scheme+
+   :+internal-about-scheme+
    :+internal-scheme-bookmark+
    :+internal-scheme-gemlogs+
    :+internal-scheme-view-source+
@@ -799,6 +799,13 @@
   (:export
    :+segment-separator+
    :iri
+   :scheme
+   :user-info
+   :host
+   :port
+   :path
+   :query
+   :fragment
    :copy-iri
    :render-iri
    :make-iri

src/program-events.lisp

@@ -574,7 +574,11 @@
       (let ((dump (with-output-to-string (stream)
                     (tooter::present status stream))))
         (dbg "fetch single status ~a" dump))
-      (db:update-db status :folder folder :timeline timeline))))
+      (db:update-db status :folder folder :timeline timeline)
+      (when (tooter:parent status)
+        (db:update-db (tooter:parent status)
+                      :folder folder
+                      :timeline timeline)))))
 
 (defparameter *search-next-saved-event* nil)
 
@@ -1405,7 +1409,7 @@
                   (local-links (remove-if (lambda (link)
                                             (let ((target      (gemini-parser:target link)))
                                               (if target
-                                                  (uri:scheme (iri:iri-parse target))
+                                                  (iri:scheme (iri:iri-parse target))
                                                   t)))
                                           links))
                   (event       (make-instance 'gemini-display-data-page
@@ -1640,10 +1644,10 @@
            (url         (iri:iri-parse gemlog-url))
            (parsed      (gemini-parser:parse-gemini-file gemini-page :initialize-parser t))
            (links       (gemini-parser:sexp->links parsed
-                                                   (uri:host  url)
-                                                   (uri:port  url)
-                                                   (uri:path  url)
-                                                   (uri:query url)))
+                                                   (iri:host  url)
+                                                   (iri:port  url)
+                                                   (iri:path  url)
+                                                   (iri:query url)))
            (theme       gemini-client:*gemini-page-theme*))
       (gemini-viewer:maybe-initialize-metadata specials:*message-window*)
       (refresh-gemini-message-window links

src/software-configuration.lisp

@@ -109,40 +109,40 @@
 
 (define-constant +false-values+          '("no" "false")         :test #'equalp)
 
-(defrule blank (or #\space #\Newline #\Tab)
+(defrule conf-blank (or #\space #\Newline #\Tab)
   (:constant nil))
 
-(defrule blanks (* blank)
+(defrule conf-blanks (* conf-blank)
   (:constant nil))
 
-(defrule assign #\=
+(defrule conf-assign #\=
   (:constant nil))
 
-(defrule comment (and blanks #\# (* (not #\Newline)) blanks)
+(defrule conf-comment (and conf-blanks #\# (* (not #\Newline)) conf-blanks)
   (:constant nil))
 
-(defrule hexcolor-prefix #\#)
+(defrule conf-hexcolor-prefix #\#)
 
-(defrule digit (character-ranges (#\0 #\9))
+(defrule conf-digit (character-ranges (#\0 #\9))
   (:text t))
 
-(defrule hex-digit
+(defrule conf-hex-digit
     (or (character-ranges (#\0 #\9))
         (character-ranges (#\a #\f))
         (character-ranges (#\A #\F))))
 
-(defrule hexcolor
-    (and hexcolor-prefix
-         hex-digit hex-digit  ; r
-         hex-digit hex-digit  ; g
-         hex-digit hex-digit) ; b
+(defrule conf-hexcolor
+    (and conf-hexcolor-prefix
+         conf-hex-digit conf-hex-digit  ; r
+         conf-hex-digit conf-hex-digit  ; g
+         conf-hex-digit conf-hex-digit) ; b
   (:text t)
   (:function (lambda (a) (parse-integer a :start 1 :radix 16))))
 
 (defun keywordize (a)
   (make-keyword (string-upcase a)))
 
-(defrule colorname
+(defrule conf-colorname
     (or "black"
         "red"
         "green"
@@ -153,25 +153,25 @@
         "white")
   (:function keywordize))
 
-(defrule escaped-character (and #\\ character)
+(defrule conf-escaped-character (and #\\ character)
   (:function (lambda (a) (list (second a)))))
 
-(defrule field-separator #\.)
+(defrule conf-field-separator #\.)
 
-(defrule field
-    (* (or escaped-character
-           (not (or #\# assign field-separator blank))))
+(defrule conf-field
+    (* (or conf-escaped-character
+           (not (or #\# conf-assign conf-field-separator conf-blank))))
 
   (:text t))
 
 ;; this rule is not actually part of the grammar but jus a convenience
 ;; function to remove duplicated code (see rules: key and value)
-(defrule fields
-    (and field
-         (? (and field-separator fields)))
+(defrule conf-fields
+    (and conf-field
+         (? (and conf-field-separator conf-fields)))
   (:function flatten))
 
-(defrule key fields
+(defrule conf-key conf-fields
   (:function (lambda (a)
                (mapcar (lambda (element)
                          (if (string= +field-separator-value+ element)
@@ -180,25 +180,25 @@
                        a)))
   (:function remove-if-null))
 
-(defrule generic-value fields
+(defrule conf-generic-value conf-fields
   (:text t))
 
-(defrule generic-assign
-    (and key blanks assign blanks
-         (or quoted-string
-             hexcolor
-             colorname
-             generic-value) ; the order in this list *is* important
-         blanks)
+(defrule conf-generic-assign
+    (and conf-key conf-blanks conf-assign conf-blanks
+         (or conf-quoted-string
+             conf-hexcolor
+             conf-colorname
+             conf-generic-value) ; the order in this list *is* important
+         conf-blanks)
   (:function remove-if-null))
 
-(defrule quoted-string (and #\" (* (not #\")) #\")
+(defrule conf-quoted-string (and #\" (* (not #\")) #\")
   (:function (lambda (a) (second a)))
   (:text t))
 
-(defrule regexp quoted-string)
+(defrule conf-regexp conf-quoted-string)
 
-(defrule color-re-key "color-regexp"
+(defrule conf-color-re-key "color-regexp"
   (:constant :color-re))
 
 (defclass color-re-assign ()
@@ -253,61 +253,83 @@
                                 (and (not color-name-p) color)
                                 attributes))))
 
-(defrule attribute-value (or "bold"
-                             "italic"
-                             "underline"
-                             "blink")
+(defrule conf-attribute-value (or "bold"
+                                  "italic"
+                                  "underline"
+                                  "blink")
   (:text t)
   (:function (lambda (a) (tui-utils:text->tui-attribute a))))
 
-(defrule color-re-assign
-    (and color-re-key blanks
-         assign blanks regexp blanks
-         (or hexcolor colorname) blanks
-         (? (and attribute-value blanks)))
+(defrule conf-color-re-assign
+    (and conf-color-re-key
+         conf-blanks
+         conf-assign
+         conf-blanks
+         conf-regexp
+         conf-blanks
+         (or conf-hexcolor conf-colorname) conf-blanks
+         (? (and conf-attribute-value conf-blanks)))
   (:function remove-if-null)
   (:function build-color-re-assign))
 
-(defrule ignore-user-re-key "ignore-user-regexp"
+(defrule conf-ignore-user-re-key "ignore-user-regexp"
   (:constant :ignore-user-re))
 
-(defrule ignore-user-boost-re-key "ignore-user-boost-regexp"
+(defrule conf-ignore-user-boost-re-key "ignore-user-boost-regexp"
   (:constant :ignore-user-boost-re))
 
-(defrule ignore-tag-re-assign "ignore-tag-regexp"
+(defrule conf-ignore-tag-re-assign "ignore-tag-regexp"
   (:constant :ignore-tag-re))
 
-(defrule ignore-user-re-assign
-    (and ignore-user-re-key blanks
-         assign blanks regexp blanks)
+(defrule conf-ignore-user-re-assign
+    (and conf-ignore-user-re-key
+         conf-blanks
+         conf-assign
+         conf-blanks
+         conf-regexp
+         conf-blanks)
   (:function (lambda (a) (list (first a) (fifth a)))))
 
-(defrule ignore-user-boost-re-assign
-    (and ignore-user-boost-re-key blanks
-         assign blanks regexp blanks)
+(defrule conf-ignore-user-boost-re-assign
+    (and conf-ignore-user-boost-re-key
+         conf-blanks
+         conf-assign
+         conf-blanks
+         conf-regexp
+         conf-blanks)
   (:function (lambda (a) (list (first a) (fifth a)))))
 
-(defrule server-key "server"
+(defrule conf-server-key "server"
   (:constant :server))
 
-(defrule username-key "username"
+(defrule conf-username-key "username"
   (:constant :username))
 
-(defrule open "open"
+(defrule conf-open "open"
   (:constant :open))
 
-(defrule open-link-helper-key open)
+(defrule conf-open-link-helper-key conf-open)
 
-(defrule with "with"
+(defrule conf-with "with"
   (:constant :with))
 
-(defrule server-assign
-    (and server-key blanks assign blanks generic-value blanks)
+(defrule conf-server-assign
+    (and conf-server-key
+         conf-blanks
+         conf-assign
+         conf-blanks
+         conf-generic-value
+         conf-blanks)
   (:function (lambda (a)
                (list (first a) (fifth a)))))
 
-(defrule username-assign
-    (and username-key blanks assign blanks generic-value blanks)
+(defrule conf-username-assign
+    (and conf-username-key
+         conf-blanks
+         conf-assign
+         conf-blanks
+         conf-generic-value
+         conf-blanks)
   (:function (lambda (a)
                (list (first a) (fifth a)))))
 
@@ -366,42 +388,44 @@
                  :wait         wait
                  :buffer-size  buffer-size))
 
-(defrule use "use"
+(defrule conf-use "use"
   (:text t))
 
-(defrule cache "cache"
+(defrule conf-cache "cache"
   (:text t))
 
-(defrule no "no"
+(defrule conf-no "no"
   (:text t))
 
-(defrule wait "wait"
+(defrule conf-wait "wait"
   (:text t))
 
-(defrule buffer-label "buffer"
+(defrule conf-buffer-label "buffer"
   (:text t))
 
-(defrule use-cache (and use blanks cache)
+(defrule conf-use-cache (and conf-use conf-blanks conf-cache)
   (:constant t))
 
-(defrule no-wait (and no blanks wait)
+(defrule conf-no-wait (and conf-no conf-blanks conf-wait)
   (:constant t))
 
-(defrule open-link-helper
-    (and open-link-helper-key
-         blanks
-         regexp ; 2 link-pattern
-         blanks
-         with
-         blanks
-         regexp ; 6 program to use
-         blanks
-         (? (and use-cache ; 8 use cache?
-                 blanks))
-         (? (and no-wait ; 9 wait download? Buffer size?
-                 blanks
-                 (? (and buffer-label blanks (+ digit)))
-                 blanks)))
+(defrule conf-open-link-helper
+    (and conf-open-link-helper-key
+         conf-blanks
+         conf-regexp ; 2 link-pattern
+         conf-blanks
+         conf-with
+         conf-blanks
+         conf-regexp ; 6 program to use
+         conf-blanks
+         (? (and conf-use-cache ; 8 use cache?
+                 conf-blanks))
+         (? (and conf-no-wait ; 9 wait download? Buffer size?
+                 conf-blanks
+                 (? (and conf-buffer-label
+                         conf-blanks
+                         (+ conf-digit)))
+                 conf-blanks)))
   (:function (lambda (args)
                (let* ((use-cache       (elt args 8))
                       (wait-parameters (elt args 9))
@@ -423,14 +447,20 @@
                                               :wait        waitp
                                               :buffer-size buffer-size))))))
 
-(defrule post-allowed-language (and "post-allowed-language" blanks assign regexp)
+(defrule conf-post-allowed-language (and "post-allowed-language"
+                                         conf-blanks
+                                         conf-assign
+                                         conf-regexp)
   (:function remove-if-null))
 
-(defrule filepath quoted-string)
+(defrule conf-filepath conf-quoted-string)
 
 (defparameter *already-included-files* ())
 
-(defrule use-file (and use blanks filepath blanks)
+(defrule conf-use-file (and conf-use
+                            conf-blanks
+                            conf-filepath
+                            conf-blanks)
   (:function (lambda (a)
                (let ((file (third a)))
                  (if (find file *already-included-files* :test #'string=)
@@ -440,28 +470,28 @@
                        (load-config-file (third a) nil)))
                  nil))))
 
-(defrule entries
-    (and (* comment)
-         (or use-file
-             color-re-assign
-             ignore-user-re-assign
-             ignore-user-boost-re-assign
-             ignore-tag-re-assign
-             server-assign
-             username-assign
-             open-link-helper
-             post-allowed-language
-             generic-assign)
-         (* comment))
+(defrule conf-entries
+    (and (* conf-comment)
+         (or conf-use-file
+             conf-color-re-assign
+             conf-ignore-user-re-assign
+             conf-ignore-user-boost-re-assign
+             conf-ignore-tag-re-assign
+             conf-server-assign
+             conf-username-assign
+             conf-open-link-helper
+             conf-post-allowed-language
+             conf-generic-assign)
+         (* conf-comment))
   (:function second))
 
-(defrule config (* entries)
+(defrule conf-config (* conf-entries)
   (:function remove-if-null))
 
 (defgeneric parse-config (object))
 
 (defmethod parse-config ((object string))
-  (parse 'config object))
+  (parse 'conf-config object))
 
 (defmethod parse-config ((object pathname))
   (parse-config (fs:slurp-file object)))
@@ -727,13 +757,13 @@
 
 (defun suggestion-window-selected-item-colors ()
   (values (access-non-null-conf-value *software-configuration*
-                                               +key-suggestions-window+
-                                               +key-selected+
-                                               +key-background+)
+                                      +key-suggestions-window+
+                                      +key-selected+
+                                      +key-background+)
           (access-non-null-conf-value *software-configuration*
-                                               +key-suggestions-window+
-                                               +key-selected+
-                                               +key-foreground+)))
+                                      +key-suggestions-window+
+                                      +key-selected+
+                                      +key-foreground+)))
 (defun gemini-downloading-animation ()
   (let ((animation (access-non-null-conf-value *software-configuration*
                                                +key-gemini+
@@ -1023,25 +1053,25 @@
 
 (gen-simple-access (delete-fetched-mentions-p
                     :transform-value-fn db-utils:db-not-nil-p)
-                    +key-delete+
-                    +key-fetched+
-                    +key-mentions+)
+                   +key-delete+
+                   +key-fetched+
+                   +key-mentions+)
 
 (gen-simple-access (gemini-fullscreen-toc-width
                     :transform-value-fn main-window:parse-subwin-w)
-                    +key-gemini+
-                    +key-exclusive+
-                    +key-mode+
-                    +key-toc+
-                    +key-width+)
+                   +key-gemini+
+                   +key-exclusive+
+                   +key-mode+
+                   +key-toc+
+                   +key-width+)
 
 (gen-simple-access (gemini-fullscreen-links-height
                     :transform-value-fn main-window:parse-subwin-h)
-                    +key-gemini+
-                    +key-exclusive+
-                    +key-mode+
-                    +key-links+
-                    +key-height+)
+                   +key-gemini+
+                   +key-exclusive+
+                   +key-mode+
+                   +key-links+
+                   +key-height+)
 
 (gen-simple-access (post-allowed-language
                     :transform-value-fn
@@ -1651,39 +1681,39 @@
                    :background           bg
                    :foreground           fg
                    :selected-background  (access:accesses *software-configuration*
-                                                         window-key
-                                                         +key-input+
-                                                         +key-selected+
-                                                         +key-background+)
+                                                          window-key
+                                                          +key-input+
+                                                          +key-selected+
+                                                          +key-background+)
                    :selected-foreground   (access:accesses *software-configuration*
-                                                         window-key
-                                                         +key-input+
-                                                         +key-selected+
-                                                         +key-foreground+)
+                                                           window-key
+                                                           +key-input+
+                                                           +key-selected+
+                                                           +key-foreground+)
 
                    :unselected-background unselected-bg
                    :unselected-foreground unselected-fg
                    :input-background      (access:accesses *software-configuration*
-                                                         window-key
-                                                         +key-input+
-                                                         +key-background+)
+                                                           window-key
+                                                           +key-input+
+                                                           +key-background+)
                    :input-foreground      (access:accesses *software-configuration*
-                                                         window-key
-                                                         +key-input+
-                                                         +key-foreground+))))
+                                                           window-key
+                                                           +key-input+
+                                                           +key-foreground+))))
 
 (gen-simple-access (default-post-language)
-                    +key-default+
-                    +key-post+
-                    +key-language+)
+                   +key-default+
+                   +key-post+
+                   +key-language+)
 
 (gen-simple-access (announcements-separator)
-                    +key-announcements+
-                    +key-separator+)
+                   +key-announcements+
+                   +key-separator+)
 
 (gen-simple-access (announcements-icon)
-                    +key-announcements+
-                    +key-icon+)
+                   +key-announcements+
+                   +key-icon+)
 
 (defun config-gemini-proxy ()
   (when-let* ((iri (access:accesses *software-configuration*
@@ -1691,8 +1721,8 @@
                                     +key-proxy+
                                     +key-uri+))
               (parsed-iri (iri:iri-parse iri :null-on-error t)))
-    (values (uri:host parsed-iri)
-            (uri:port parsed-iri))))
+    (values (iri:host parsed-iri)
+            (iri:port parsed-iri))))
 
 (defun config-gemini-search-engine-iri ()
   (let ((iri (access:accesses *software-configuration*

src/tests/package.lisp

@@ -39,14 +39,6 @@
         :all-tests)
   (:export))
 
-(defpackage :uri-tests
-  (:use :cl
-        :alexandria
-        :clunit
-        :uri
-        :all-tests)
-  (:export))
-
 (defpackage :iri-tests
   (:use :cl
         :alexandria

src/tests/uri-tests.lisp

@@ -1,77 +0,0 @@
-;; tinmop: a multiprotocol client
-;; Copyright © cage
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program.
-;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
-
-(in-package :uri-tests)
-
-(defsuite uri-suite (all-suite))
-
-(defun test-uri (uri results)
-  (multiple-value-bind (x parsed)
-      (uri-parse uri)
-    (declare (ignore x))
-    (tree-equal (mapcar #'text-utils:to-s parsed) results :test #'string=)))
-
-(defparameter *test-cases*
-  '(("file:///tmp/junk.txt" .
-     ("file" nil nil nil "/tmp/junk.txt" nil nil))
-    ("imap://mail.common-lisp.net/mbox1" .
-     ("imap" nil "mail.common-lisp.net" nil "/mbox1" nil nil))
-    ("mms://wms.sys.hinet.net/cts/Drama/09006251100.asf" .
-     ("mms" nil "wms.sys.hinet.net" nil "/cts/Drama/09006251100.asf" nil nil))
-    ("nfs://server/path/to/file.txt" .
-     ("nfs" nil "server" nil "/path/to/file.txt" nil nil))
-    ("svn+ssh://svn.zope.org/repos/main/ZConfig/trunk/" .
-     ("svn+ssh" nil "svn.zope.org" nil "/repos/main/ZConfig/trunk/" nil nil))
-    ("git+ssh://git@github.com/user/project.git" .
-     ("git+ssh" "git" "github.com" nil "/user/project.git" nil nil))
-    ("http://common-lisp.net" .
-     ("http" nil "common-lisp.net" nil nil nil nil))
-    ("http://common-lisp.net#abc" .
-     ("http" nil "common-lisp.net" nil nil nil "abc"))
-    ("http://common-lisp.net?q=abc" .
-     ("http" nil "common-lisp.net" nil nil "q=abc" nil))
-    ("http://common-lisp.net/#abc" .
-     ("http" nil "common-lisp.net" nil "/" nil "abc"))
-    ("http://a/b/c/d;p?q#f" .
-     ("http" nil "a" nil "/b/c/d;p" "q" "f"))
-    ("http" .
-     (nil nil nil nil "http" nil nil))
-    ("http://" .
-     ("http" nil nil nil nil nil nil))
-    ;; ("http:" .
-    ;;  ("http" nil nil nil nil nil))
-    ("ldap://[2001:db8::7]/c=GB?objectClass?one" .
-     ("ldap" nil "[2001:db8::7]" nil "/c=GB" "objectClass?one" nil))
-    ("http://[dead:beef::]:111/foo/" .
-     ("http" nil "[dead:beef::]" "111" "/foo/" nil nil))
-    ("//foo.bar:198/".
-     (NIL NIL "foo.bar" "198" "/" NIL NIL))))
-
-(deftest test-parsing (uri-suite)
-  (loop for (a . b) in *test-cases* do
-    (assert-true (test-uri a b) a)))
-
-(defun normalize (path expected)
-  (string= (fs:normalize-path path)
-           expected))
-
-(deftest test-normalize-path (uri-suite)
-  (assert-true (normalize "/a/x" "/a/x"))
-  (assert-true (normalize "/a/../b/x" "/b/x"))
-  (assert-true (normalize "/a/../b/x/.." "/b/"))
-  (assert-true (normalize "/a/../b/x/." "/b/x/"))
-  (assert-true (normalize "/a/b/c/./../../g" "/a/g")))

src/ui-goodies.lisp

@@ -1584,7 +1584,7 @@ displayed using  the standard image  viewer installed on  the system."
                                   (or (gemini-parser:name uri)
                                       (when-let* ((parsed (iri:iri-parse (gemini-parser:target uri)
                                                                          :null-on-error t))
-                                                  (path   (and parsed (uri:path parsed))))
+                                                  (path   (and parsed (iri:path parsed))))
                                         (fs:path-last-element path)))))
               (files        (loop for ct from 0 below images-count
                                   collect
@@ -1673,10 +1673,10 @@ Browse and optionally open the links the text of the message window contains."
                                    (iri:absolute-url-p uri))
                                uri
                                (gemini-parser:absolutize-link uri
-                                                              (uri:host  current-url)
-                                                              (uri:port  current-url)
-                                                              (uri:path  current-url)
-                                                              (uri:query current-url)))))
+                                                              (iri:host  current-url)
+                                                              (iri:port  current-url)
+                                                              (iri:path  current-url)
+                                                              (iri:query current-url)))))
         (open-message-link-window:open-message-link absolute-uri nil)))))
 
 (defun open-previous-link ()
@@ -3096,7 +3096,7 @@ printed, on the main window."
 
 (defun init-kami-window (url handlers)
   (if handlers
-      (let* ((path          (uri:path (iri:iri-parse url)))
+      (let* ((path          (iri:path (iri:iri-parse url)))
              (path-to-dir-p (fs:path-referencing-dir-p path))
              (init-path (if path-to-dir-p
                             path

src/uri-parser.lisp

@@ -1,330 +0,0 @@
-;; tinmop: a multiprotocol client
-;; Copyright © cage
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program.
-;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
-
-(in-package :uri-parser)
-
-;; NOTE: the parser is broken, use :iri-parser, instead
-
-(define-constant +segment-separator+ "/" :test #'string=)
-
-(defrule alpha (character-ranges (#\a #\z) (#\A #\Z))
-  (:text t))
-
-(defrule digit (character-ranges (#\0 #\9))
-  (:text t))
-
-(defrule scheme-delim #\:
-  (:constant :scheme-delim))
-
-(defrule query-delim #\?
-  (:constant :query-delim))
-
-(defrule fragment-delim #\#
-  (:constant :fragment-delim))
-
-(defrule port-delim #\:
-  (:constant :port-delim))
-
-(defrule credential-delim #\@
-  (:constant :credential-delim))
-
-(defrule authority-start "//"
-  (:constant :authority-start))
-
-(defrule sub-delims  (or #\!  #\$  #\&  #\'  #\(  #\) #\*  #\+  #\,  #\;  #\=)
-  (:text t))
-
-(defrule gen-delims (or ":" "?"  "#"  "["  "]"  "@" "")
-  (:text t))
-
-(defrule unreserved-chars (or alpha digit  #\-  #\.  #\_  #\~)
-  (:text t))
-
-(defrule reserved-chars (or gen-delims sub-delims)
-  (:text t))
-
-(defrule scheme (and alpha (* (or alpha  digit  "+"  "-"  "." )))
-  (:text t))
-
-(defrule hier-part  (and authority-start authority)
-  (:function second))
-
-(defrule user-credentials (and userinfo credential-delim)
-  (:function first))
-
-(defrule port-block (and port-delim port)
-  (:function second)
-  (:function parse-integer))
-
-(defrule authority (and (? user-credentials)
-                        host
-                        (? port-block)))
-
-(defrule reg-name (* (or unreserved-chars pct-encoded sub-delims ))
-  (:text t))
-
-(defrule host (or ipv4-address ip-literal reg-name)
-  (:text t))
-
-(defrule port (+ digit)
-  (:text t))
-
-(defrule userinfo (* (or unreserved-chars  pct-encoded  sub-delims  ":" ))
-  (:text t))
-
-(defrule pct-encoded (and "%" hexdig hexdig)
-  (:text t))
-
-(defrule hexdig (or (character-ranges #\a #\f) digit)
-  (:text t))
-
-(defrule ipv4-address (and dec-octet "." dec-octet "." dec-octet "." dec-octet)
-  (:text t))
-
-(defrule ip-literal  (and "["
-                          (+ (not (or "[" "]")))
-                          "]")
-  (:text t))
-
-(defrule pchar (or unreserved-chars pct-encoded  sub-delims  ":"  "@")
-  (:text t))
-
-(defrule segment (* pchar)
-  (:text t))
-
-(defrule segment-non-zero (+ pchar)
-  (:text t))
-
-(defrule segment-nz-nc (+ (or unreserved-chars  pct-encoded  sub-delims  "@" ))
-  (:text t))
-
-(defrule path-abempty (* (and "/" segment))
-  (:text t))
-
-(defrule path  (or path-abempty
-                   path-absolute
-                   path-noscheme
-                   path-rootless
-                   path-empty)
-  (:text t))
-
-(defrule path-absolute (and "/" (? (and segment-nz (* (and "/" segment )))))
-  (:text t))
-
-(defrule path-rootless (and segment-non-zero (* (and "/" segment )))
-  (:text t))
-
-(defrule path-noscheme (and segment-nz-nc (* (and  "/" segment )))
-  (:text t))
-
-(defrule path-empty ""
-  (:constant nil))
-
-(defun octect-p (maybe-octect)
-  (ignore-errors
-   (let ((number (parse-integer (text-utils:strcat* maybe-octect))))
-     (when (<= 0 number 255)
-       number))))
-
-(defrule dec-octet (octect-p (+ digit))
-  (:text t))
-
-(defun extract-fields-from-absolute-uri (parsed)
-  (let ((authority (third parsed)))
-    (list (first  parsed)    ; scheme
-          (first  authority) ; user-credentials
-          (second authority) ; host
-          (third  authority) ; port
-          (fourth parsed)    ; path
-          (fifth  parsed)    ; query
-          (sixth  parsed)))) ; fragment
-
-(defrule uri (and scheme ":"
-                  hier-part
-                  (or path-abempty
-                      path-absolute
-                      path-noscheme
-                      path-empty)
-                  (? query)
-                  (? fragment))
-  (:function extract-fields-from-absolute-uri))
-
-(defrule relative-part (or (and authority-start
-                                authority
-                                path-abempty)
-                           path-absolute
-                           path-noscheme
-                           path-empty))
-
-(defun extract-fields-from-relative-uri-w-authority (parsed)
-  ;; ((:IAUTHORITY-START (NIL "bar.baz" NIL) "/foo.gmi") "a=b" "afrag")
-  (let ((authority (second (first parsed)))
-        (path      (third  (first parsed))))
-    (list nil                ; scheme
-          (first  authority) ; user-credentials
-          (second authority) ; host
-          (third  authority) ; port
-          path
-          (second parsed)    ; iquery
-          (third  parsed)))) ; fragment
-
-(defun extract-fields-from-relative-uri-w/o-authority (parsed)
-  (list nil                ; scheme
-        nil                ; user-credentials
-        nil                ; host
-        nil                ; port
-        (first parsed)     ; path
-        (second parsed)    ; iquery
-        (third  parsed)))  ; fragment
-
-(defun extract-fields-from-relative-uri (parsed)
-  (if (consp (first parsed))
-      (extract-fields-from-relative-uri-w-authority   parsed)
-      (extract-fields-from-relative-uri-w/o-authority parsed)))
-
-(defrule relative-ref (and relative-part (? query) (? fragment))
-  (:function extract-fields-from-relative-uri))
-
-(defrule query (and query-delim (* (or pchar "/" "?")))
-  (:function second)
-  (:text t))
-
-(defrule fragment (and fragment-delim (* (or pchar "/" "?")))
-  (:function second)
-  (:text t))
-
-(defrule uri-reference (or uri relative-ref))
-
-(defclass uri ()
-  ((scheme
-    :initform nil
-    :initarg  :scheme
-    :accessor scheme)
-   (user-info
-    :initform nil
-    :initarg  :user-info
-    :accessor user-info)
-   (host
-    :initform nil
-    :initarg  :host
-    :writer   (setf host))
-   (port
-    :initform nil
-    :initarg  :port
-    :accessor port)
-   (path
-    :initform nil
-    :initarg  :path
-    :accessor path)
-   (query
-    :initform nil
-    :initarg  :query
-    :accessor query)
-   (fragment
-    :initform nil
-    :initarg  :fragment
-    :accessor fragment)))
-
-(defgeneric host (object))
-
-(defmethod host ((object uri))
-  (let ((host (slot-value object 'host)))
-    (if (text-utils:string-starts-with-p "[" host)
-        (subseq host 1 (1- (length host)))
-        host)))
-
-(defun make-uri (&optional scheme user-info host port path query fragment)
-  (make-instance 'uri
-                 :scheme    scheme
-                 :user-info user-info
-                 :host      host
-                 :port      port
-                 :path      path
-                 :query     query
-                 :fragment  fragment))
-
-(defun uri-parse (uri)
-  (let* ((parsed (parse 'uri-reference uri :junk-allowed nil))
-         (res    (mapcar (lambda (a) (cond
-                                       ((typep a 'string)
-                                        (if (text-utils:string-empty-p a)
-                                            nil
-                                            a))
-                                       (t a)))
-                         (list (first   parsed)       ; scheme
-                               (second  parsed)       ; user-credentials
-                               (third   parsed)       ; host
-                               (fourth  parsed)       ; port
-                               (fifth   parsed)       ; path
-                               (sixth   parsed)       ; query
-                               (seventh parsed)))))   ; fragment
-    (values (apply #'make-uri res)
-            res)))
-
-(defun copy-uri (from)
-  (let ((scheme    (scheme    from))
-        (user-info (user-info from))
-        (host      (slot-value    from 'host))
-        (port      (port      from))
-        (path      (path      from))
-        (query     (query     from))
-        (fragment  (fragment  from)))
-    (make-uri scheme
-              user-info
-              host
-              port
-              path
-              query
-              fragment)))
-
-(defun render-uri (uri &optional (stream *standard-output*))
-  (flet ((render ()
-           (with-output-to-string (string-stream)
-             (let ((scheme    (scheme    uri))
-                   (user-info (user-info uri))
-                   (host      (slot-value    uri 'host))
-                   (port      (port      uri))
-                   (path      (path      uri))
-                   (query     (query     uri))
-                   (fragment  (fragment  uri)))
-               (when scheme
-                 (format string-stream "~a:" scheme))
-               (write-string "//" string-stream)
-               (when user-info
-                 (format string-stream "~a@" user-info))
-               (when host
-                 (format string-stream "~a" host))
-               (when port
-                 (format string-stream ":~a" port))
-               (when path
-                 (format string-stream "~a" path))
-               (when query
-                 (format string-stream "?~a" query))
-               (when fragment
-                 (format string-stream "#~a" fragment))))))
-    (write-string (render) stream)))
-
-(defmethod normalize-path ((object uri:uri))
-  (let ((clean-path (normalize-path (uri:path object)))
-        (copy       (uri:copy-uri  object)))
-    (when clean-path
-      (setf (uri:path copy) clean-path))
-    copy))
-
-(defmethod to-s ((object uri:uri) &key &allow-other-keys)
-  (with-output-to-string (stream)
-    (uri:render-uri object stream)))

tinmop.asd

@@ -17,8 +17,8 @@
 
 (defsystem :tinmop
   :author      "cage"
-  :license     "GPLv3"
-  :version     "0.9.9.1414213562"
+  :license     "GPLv3+"
+  :version     "0.9.9.14142135623-rc1"
   :pathname    "src"
   :serial      t
   :bug-tracker "https://codeberg.org/cage/tinmop/issues"
@@ -82,7 +82,6 @@
                (:file "priority-queue")
                (:file "queue")
                (:file "stack")
-               (:file "uri-parser")
                (:file "iri-parser")
                (:file "tour-mode-parser")
                (:file "x509-ffi")
@@ -187,7 +186,6 @@
                              (:file "all-tests")
                              (:file "misc-tests")
                              (:file "box-tests")
-                             (:file "uri-tests")
                              (:file "iri-tests")
                              (:file "numeric-tests")
                              (:file "text-utils-tests")