implement an "up" command
This commit is contained in:
15
client.rkt
15
client.rkt
@@ -29,6 +29,21 @@
|
|||||||
|
|
||||||
(super-new)
|
(super-new)
|
||||||
|
|
||||||
|
(define/public (up-cmd)
|
||||||
|
(if (string=? (path->string
|
||||||
|
(simplify-path
|
||||||
|
(url->path current-url)))
|
||||||
|
"/")
|
||||||
|
|
||||||
|
(displayln "already at root!")
|
||||||
|
|
||||||
|
(let ([parent
|
||||||
|
(simplify-path
|
||||||
|
(build-path (url->path current-url) 'up)
|
||||||
|
#f)])
|
||||||
|
(get (struct-copy url current-url
|
||||||
|
[path (url-path (path->url parent))])))))
|
||||||
|
|
||||||
(define/public (go-cmd url-string)
|
(define/public (go-cmd url-string)
|
||||||
(if (non-empty-string? url-string)
|
(if (non-empty-string? url-string)
|
||||||
(let ()
|
(let ()
|
||||||
|
Reference in New Issue
Block a user