Compare commits
2 Commits
37e19cb279
...
bd3f048595
Author | SHA1 | Date | |
---|---|---|---|
bd3f048595 | |||
6789074d4f |
89
gem300.rkt
89
gem300.rkt
@@ -1,87 +1,8 @@
|
|||||||
#lang racket
|
#lang racket
|
||||||
|
|
||||||
(require (prefix-in net: "net.rkt")
|
(require (prefix-in client: "client.rkt"))
|
||||||
(prefix-in gmi: "gmi.rkt"))
|
|
||||||
|
|
||||||
(require net/url-string)
|
(define client (new client:client%))
|
||||||
|
|
||||||
;; global state variable which will be an input port containing the
|
|
||||||
;; rendered out gemtext document as it shall be shown to the user
|
|
||||||
(define document-buffer null)
|
|
||||||
|
|
||||||
;; global state which will be the document structure, before rendering
|
|
||||||
(define document null)
|
|
||||||
|
|
||||||
;; global state for the url of the currently visited document
|
|
||||||
(define current-url null)
|
|
||||||
|
|
||||||
(define (get url-str)
|
|
||||||
(define (iter url-str depth)
|
|
||||||
(let-values ([(status header c-in) (net:request url-str)])
|
|
||||||
;; TODO there are bunch of other status codes to deal with for
|
|
||||||
;; compliance
|
|
||||||
(cond
|
|
||||||
;; clients MUST reject status codes outside of the 10-69 range
|
|
||||||
[(or (< status 10)
|
|
||||||
(> status 69))
|
|
||||||
(error "server returned invalid status code")]
|
|
||||||
|
|
||||||
;; 30-39 redirection
|
|
||||||
[(and (>= status 30)
|
|
||||||
(<= status 39))
|
|
||||||
(if (> depth 5)
|
|
||||||
(error "maximum redirection depth exceeded")
|
|
||||||
(iter header (sub1 depth)))]
|
|
||||||
|
|
||||||
[else
|
|
||||||
(values status header c-in)])))
|
|
||||||
|
|
||||||
(iter url-str 5))
|
|
||||||
|
|
||||||
(define (go-cmd url)
|
|
||||||
(if (non-empty-string? url)
|
|
||||||
(let ()
|
|
||||||
(when (not (string-contains? url "://"))
|
|
||||||
(set! url (string-append "gemini://" url)))
|
|
||||||
|
|
||||||
(let-values ([(status meta c-in) (get url)])
|
|
||||||
(let-values ([(doc) (gmi:parse (port->lines c-in))]
|
|
||||||
[(db-in db-out) (make-pipe #f)])
|
|
||||||
|
|
||||||
(set! document doc)
|
|
||||||
|
|
||||||
(set! document-buffer db-in)
|
|
||||||
(parameterize ([current-output-port db-out])
|
|
||||||
(gmi:render doc))
|
|
||||||
|
|
||||||
(set! current-url url)
|
|
||||||
|
|
||||||
(let ([remaining (pipe-content-length db-in)])
|
|
||||||
(printf "document retrieved. ~a bytes\n" remaining))
|
|
||||||
|
|
||||||
(next-cmd))))
|
|
||||||
|
|
||||||
(displayln "go where?")))
|
|
||||||
|
|
||||||
(define (next-cmd)
|
|
||||||
(define (iter depth)
|
|
||||||
(when (and (> depth 0)
|
|
||||||
(> (pipe-content-length document-buffer) 0))
|
|
||||||
(let ()
|
|
||||||
(displayln (read-line document-buffer))
|
|
||||||
(iter (sub1 depth)))))
|
|
||||||
|
|
||||||
(iter 10)
|
|
||||||
(newline)
|
|
||||||
(let ([remaining (pipe-content-length document-buffer)])
|
|
||||||
(printf "~a bytes remaining\n" remaining)))
|
|
||||||
|
|
||||||
(define (visit-cmd line)
|
|
||||||
(define url (gmi:match-link document (string->number line)))
|
|
||||||
(set! url
|
|
||||||
(url->string (combine-url/relative (string->url current-url)
|
|
||||||
url)))
|
|
||||||
(go-cmd url))
|
|
||||||
|
|
||||||
(define (repl)
|
(define (repl)
|
||||||
(display "G-300 > ")
|
(display "G-300 > ")
|
||||||
@@ -92,15 +13,15 @@
|
|||||||
[(or (not matches)
|
[(or (not matches)
|
||||||
(string=? (cadr matches) "next")
|
(string=? (cadr matches) "next")
|
||||||
(string=? (cadr matches) "n"))
|
(string=? (cadr matches) "n"))
|
||||||
(next-cmd)]
|
(send client next-cmd)]
|
||||||
|
|
||||||
;; go command
|
;; go command
|
||||||
[(or (string=? (cadr matches) "go")
|
[(or (string=? (cadr matches) "go")
|
||||||
(string=? (cadr matches) "g"))
|
(string=? (cadr matches) "g"))
|
||||||
(go-cmd (caddr matches))]
|
(send client go-cmd (caddr matches))]
|
||||||
|
|
||||||
;; visit link command
|
;; visit link command
|
||||||
[(andmap char-numeric? (string->list (cadr matches)))
|
[(andmap char-numeric? (string->list (cadr matches)))
|
||||||
(visit-cmd (cadr matches))]))
|
(send client visit-cmd (cadr matches))]))
|
||||||
|
|
||||||
(repl))
|
(repl))
|
||||||
|
Reference in New Issue
Block a user