From 1979077055cd28e041b8adac6f4df790ed1dbe57 Mon Sep 17 00:00:00 2001
From: Andre Alves Garzia <andre@andregarzia.com>
Date: Wed, 16 Feb 2022 18:19:46 +0000
Subject: [PATCH] fixed link line bug, added web proxy

---
 CHANGELOG.md                    |  6 +++++-
 multi-transport.rkt             |  2 +-
 persist.rkt                     | 11 -----------
 preferences.rkt                 | 17 ++++++++++++++++-
 protocols/gemini-protocol.rkt   |  6 +++---
 transports/gemini-transport.rkt |  8 +++++++-
 6 files changed, 32 insertions(+), 18 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index b06f6d7..616369a 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,7 +1,11 @@
 # Version 0.12
 
-* Mercury support
+* Mercury support.
 * Added generic error handler for exceptions in network code.
+* Text protocol support.
+* Fixed: output port was not UTF-8.
+* Added preference to use "web-to-gemini" proxy for HTTP URLs.
+* Fixed: link lines in gemini were broken if `=>` was not followed by a space.
 
 
 # Version 0.11
diff --git a/multi-transport.rkt b/multi-transport.rkt
index 62672b8..1496a70 100644
--- a/multi-transport.rkt
+++ b/multi-transport.rkt
@@ -21,7 +21,7 @@
     (define transports
       (list
        ;; Gemini transport can handle gemini protocol.
-       ;; Schemas: gemini://
+       ;; Schemas: gemini:// and http:// if web-to-gemini proxy usage is marked under preferences.
        (new gemini-transport%
             [on-status-change on-status-change]
             [on-error on-error]
diff --git a/persist.rkt b/persist.rkt
index 0baccc8..37d70d5 100644
--- a/persist.rkt
+++ b/persist.rkt
@@ -53,17 +53,6 @@
 
 (define bookmarks (make-parameter (make-hash)))
 
-;(serializable-struct bookmark
-;                     (url
-;                      title
-;                      subscribe
-;                      favourite
-;                      last-checksum
-;                      tags
-;                      notes)
-;                     #:mutable
-;                     #:transparent)
-
 (serializable-struct/versions bookmark 1
                               (url
                                title
diff --git a/preferences.rkt b/preferences.rkt
index 68cf740..e837494 100644
--- a/preferences.rkt
+++ b/preferences.rkt
@@ -33,6 +33,18 @@
        [parent panel]
        [value (get-pref 'new-tab-section/favourites)]))
 
+(define open-http-using-proxy-checkbox
+  (new check-box%
+       [label "Open HTTP URLs using http-to-gemini proxy service"]
+       [parent panel]
+       [value (get-pref 'http/use-proxy)]))
+
+(define web-proxy-field
+  (new text-field%
+       [label "Web Proxy"]
+       [parent panel]
+       [init-value (get-pref 'http/proxy-address "gemini://drewdevault.com/cgi-bin/web.sh?")]))
+
 (define footer
   (new horizontal-panel%
        [parent preferences-window]
@@ -51,6 +63,8 @@
   (set-pref 'homepage (send homepage-field get-value))
   (set-pref 'new-tab-section/aggregators (send new-tab-section/aggregators-checkbox get-value))
   (set-pref 'new-tab-section/favourites (send new-tab-section/favourites-checkbox get-value))
+  (set-pref 'http/use-proxy (send open-http-using-proxy-checkbox get-value))
+  (set-pref 'http/proxy-address (send web-proxy-field get-value))
   (send preferences-window show #f))
 
 (define save-button
@@ -61,7 +75,8 @@
 
 
 (define (fetch-values)
-  (send homepage-field set-value (get-pref 'homepage)))
+  (send homepage-field set-value (get-pref 'homepage))
+  (send web-proxy-field set-value (get-pref 'http/proxy-address "gemini://drewdevault.com/cgi-bin/web.sh?")))
 
 (define (show-preferences-window)
   (fetch-values)
diff --git a/protocols/gemini-protocol.rkt b/protocols/gemini-protocol.rkt
index 83b2547..a61cf27 100644
--- a/protocols/gemini-protocol.rkt
+++ b/protocols/gemini-protocol.rkt
@@ -121,13 +121,13 @@
 
 (define (gemini-process-line line)
   (define first-word (car (regexp-split #rx" " line)))
-  (define (link? w) (equal? w "=>"))
+  (define (link? w) (string-prefix? w "=>"))
   (define (heading? w) (and (> (string-length w) 0) (equal? (substring w 0 1) "#")))
   (define (list? w) (equal? w "*"))
   (define (toggle? w) (equal? w "```"))
   (define (make-link line)
-    (define lst (string-split line))
-    `(link ,(cadr lst) ,(string-join (cddr lst))))
+    (define lst (string-split (string-replace line "=>" "")))
+    `(link ,(car lst) ,(string-join (cdr lst))))
   (define (make-heading line)
     (define lst (string-split line))
     `(heading ,(string-length (car lst)) ,(string-join (cdr lst))))
diff --git a/transports/gemini-transport.rkt b/transports/gemini-transport.rkt
index 92084dc..d094e56 100644
--- a/transports/gemini-transport.rkt
+++ b/transports/gemini-transport.rkt
@@ -2,7 +2,9 @@
 
 (require
   net/url
+  net/uri-codec
   "../protocols/gemini-protocol.rkt"
+  "../persist.rkt"
   "../utils.rkt")
 
     
@@ -18,12 +20,16 @@
 
     (define/public (can-handle-url? url)
       (define u (string->url url))
-      (equal? (url-scheme u) "gemini"))
+      (or 
+        (equal? (url-scheme u) "gemini")
+        (and (get-pref 'http/use-proxy #f) (string-contains? (url-scheme u) "http"))))
 
     (define/public (fetch new-url [current-url #f])
       (begin
         (when (not (non-empty-string? new-url))
           (error 'set-url "Can't load empty URL"))
+        (when (and (get-pref 'http/use-proxy #f) (string-contains? (url-scheme (string->url new-url)) "http"))
+          (set! new-url (string-append (get-pref 'http/proxy-address "gemini://drewdevault.com/cgi-bin/web.sh?") (uri-encode new-url))))
         (when (not (false? current-url))
           (define new-url-url (string->url new-url))
           (set! new-url (url->string
-- 
2.45.2