do uri handling without uri-common - holymoly - A tor enabled gopher client written in CHICKEN scheme
 (HTM) git clone git://vernunftzentrum.de/holymoly.git
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) README
 (DIR) LICENSE
       ---
 (DIR) commit a9f5e6402e1e1de7edc549f54980f2ebc4e91ce5
 (DIR) parent bef86b5fc6c6f72808291feaf6bc2797537177bc
 (HTM) Author: Christian Kellermann <ckeen@pestilenz.org>
       Date:   Wed, 15 Aug 2018 16:24:17 +0200
       
       do uri handling without uri-common
       
       Diffstat:
         holymoly.egg                        |       2 +-
         holymoly.scm                        |      33 ++++++++++++++++++++-----------
       
       2 files changed, 22 insertions(+), 13 deletions(-)
       ---
 (DIR) diff --git a/holymoly.egg b/holymoly.egg
       @@ -1,5 +1,5 @@
        ((author "Christian Kellermann")
         (license BSD)
         (synopsis "A gopher client using ncurses and supporting SOCKS proxies")
       - (dependencies miscmacros uri-common srfi-1 srfi-4 srfi-71 srfi-13 bitstring)
       + (dependencies miscmacros srfi-1 srfi-4 srfi-71 srfi-13 bitstring)
         (components (program holymoly (linkage static) (files "holymoly.scm" "proxy.scm" "cursor.scm") (link-options "-Wl,-lncursesw"))))
        \ No newline at end of file
 (DIR) diff --git a/holymoly.scm b/holymoly.scm
       @@ -25,8 +25,7 @@
            srfi-1
            srfi-13
            srfi-4
       -    srfi-71
       -    uri-common)
       +    srfi-71)
        
        (foreign-declare "#include <locale.h>")
        (foreign-code "setlocale(LC_ALL, \"en_US.UTF-8\");")
       @@ -128,7 +127,7 @@
                                           (prev-cursor! cursor)
                                           (adjust-cursor!)))))) ; backspace
                           ((113) (k 'quit)) ; q
       -                   ((#x47 #x67) (k (uri->entry (get-user-input "New uri:" (entry->string (current-page))))) pos) ; G
       +                   ((#x47 #x67) (k (uristring->entry (get-user-input "New uri:" (entry->string (current-page))))) pos) ; G
                           (else pos)))))))))
        
        (define (get-user-input #!optional (prompt "Enter query:") (suggestion ""))
       @@ -330,14 +329,24 @@
                 ((equal? next 'back) (select-entry (previous-page)))
                 (else (select-entry next)))))
        
       -(define (uri->entry uri-string)
       -  (let* ((u (uri-reference uri-string))
       -         (server (or (uri-host u) (car (uri-path u))))
       -         (port (or (uri-port u) 70))
       -         (path (or (and (uri-host u) (uri-path u)) '("/" "1")))
       -         (type (string->type (second path) 'directory))
       -         (selector (string-intersperse (drop path 2) "/")))
       -      (make-entry type "" selector server port '())))
       +(define (uristring->entry uri-string)
       +    (let* ((selector (if (string-prefix? "gopher://" uri-string)
       +                         (string-drop uri-string 9)
       +                         uri-string))
       +           (split-selectors (string-split selector "/"))
       +           (host/port (string-split (car split-selectors) ":"))
       +           (host (car host/port)) ; always the first list entry
       +           (port (if (> (length host/port) 1)
       +                     (string->number (second host/port))
       +                     70))
       +           (selector (string-join (cdr split-selectors) "/")) ;; without the host part
       +           (type (string->type (if (> (string-length selector) 1)
       +                                    (string-take selector 1)
       +                                    "1")))
       +           (final-selector (if (> (string-length selector) 1)
       +                                    (string-drop selector 1)
       +                                    selector)))
       +    (make-entry type "" final-selector host port '())))
        
        (define (entry->string e)
           (sprintf "gopher://~a:~a/~a"
       @@ -360,7 +369,7 @@
            (main-win (newwin (sub1 l) c 0 0))
            (status-win (newwin 1 c (sub1 l) 0))
            (new-status "Starting up!")
       -    (select-entry (uri->entry (car args)))
       +    (select-entry (uristring->entry (car args)))
            (exit 0)))
        
        ) ;;; end of module definition