! Copyright (C) 2021 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: accessors arrays combinators.short-circuit
-command-line.loop formatting gemini gemini.private io
-io.directories io.encodings.string io.encodings.utf8 io.files
-io.files.temp io.launcher kernel math math.parser namespaces
-present sequences splitting system urls webbrowser ;
+USING: accessors arrays assocs combinators
+combinators.short-circuit command-loop formatting gemini
+gemini.private io io.directories io.encodings.string
+io.encodings.utf8 io.files io.files.temp io.launcher io.pipes
+kernel math math.parser namespaces present sequences splitting
+system urls webbrowser ;
IN: gemini.cli
CONSTANT: HISTORY V{ }
CONSTANT: LINKS V{ }
CONSTANT: STACK V{ }
+CONSTANT: PAGE V{ }
CONSTANT: URL V{ }
+: find-url ( url items -- i item )
+ [ dup array? [ first ] when = ] with find ;
+
+: nth-url ( i items -- url )
+ ?nth dup array? [ first ] when ;
+
+: stack-url ( delta -- url )
+ URL ?first STACK find-url drop
+ [ + STACK nth-url ] [ drop f ] if* ;
+
: add-stack ( args -- )
- URL ?first STACK index [
- 1 + dup STACK ?nth pick = [
- 2drop
+ dup dup array? [ first ] when
+ dup STACK find-url drop [
+ 2drop
+ ] [
+ URL ?first STACK find-url drop [
+ over PAGE find-url drop [
+ 1 + dup STACK nth-url rot = [
+ 2drop
+ ] [
+ STACK [ length ] [ delete-slice ] bi
+ STACK push
+ STACK length 10 > [
+ 0 STACK remove-nth! drop
+ ] when
+ ] if
+ ] [
+ 2drop
+ STACK push
+ ] if
] [
- STACK [ length ] [ delete-slice ] bi
+ drop
+ STACK delete-all
STACK push
- STACK length 10 > [
- 0 STACK remove-nth! drop
- ] when
- ] if
- ] [
- STACK push
- ] if* ;
+ ] if*
+ ] if ;
: add-history ( args -- )
HISTORY dup length 10 > [
0 swap remove-nth!
] when dupd remove! push ;
+: print-links ( links verbose? -- )
+ LINKS delete-all over LINKS push-all
+ '[
+ 1 + swap [ dup array? [ first ] when URL ?first = [ drop "*" ] when ] keep
+ _ [ dup array? [ dup second empty? not ] [ f ] if ] [ f ] if [
+ first2 swap "[%s] %s (%s)\n" printf
+ ] [
+ dup array? [ first2 ] [ f ] if
+ dup empty? -rot ? "[%s] %s\n" printf
+ ] if
+ ] each-index ;
+
: gemini-history ( -- )
- HISTORY [ 1 + swap "[%s] %s\n" printf ] each-index
- LINKS delete-all HISTORY LINKS push-all ;
+ HISTORY t print-links ;
: gemini-print ( url body meta -- )
f pre [
- LINKS delete-all
- gemini-charset decode string-lines [
+ PAGE delete-all
+ gemini-charset decode split-lines [
{ [ pre get not ] [ "=>" ?head ] } 0&& [
- swap gemini-link present LINKS push
- LINKS length swap "[%s] %s\n" printf
+ swap gemini-link present over 2array PAGE push
+ PAGE length swap "[%s] %s\n" printf
] [
gemini-line.
] if
] with each
+ LINKS delete-all PAGE LINKS push-all
] with-variable ;
: gemini-get ( args -- )
- dup 0 URL set-nth
+ dup URL set-first
>url dup gemini [ drop ] 2dip swap "text/" ?head [
"gemini.txt" temp-file
[ utf8 [ gemini-print ] with-file-writer ]
] if ;
: gemini-go ( args -- )
- [ DEFAULT-URL ] when-empty
- { [ "://" over subseq? ] [ "gemini://" head? ] } 1||
+ present [ DEFAULT-URL ] when-empty
+ { [ dup "://" subseq-of? ] [ "gemini://" head? ] } 1||
[ "gemini://" prepend ] unless
dup "gemini://" head? [
[ add-history ] [ add-stack ] [ gemini-get ] tri
] [ open-url ] if ;
: gemini-reload ( -- )
- HISTORY ?last gemini-go ;
+ URL ?first gemini-go ;
: gemini-back ( -- )
- URL ?first STACK index [
- 1 - STACK ?nth [ gemini-get ] when*
- ] when* ;
+ -1 stack-url [ gemini-get ] when* ;
: gemini-forward ( -- )
- URL ?first STACK index [
- 1 + STACK ?nth [ gemini-get ] when*
- ] when* ;
+ 1 stack-url [ gemini-get ] when* ;
: gemini-up ( -- )
URL ?first [
>url f >>query f >>anchor
- [ "/" ?tail drop "/" split1-last drop "/" append ] change-path
- present gemini-go
+ [ dup "/" tail? "./../" "./" ? url-append-path ] change-path
+ gemini-go
] when* ;
: gemini-less ( -- )
- "less" "gemini.txt" temp-file 2array try-process ;
+ "gemini.txt" temp-file dup file-exists? [
+ "less" swap 2array try-process
+ ] [ drop ] if ;
+
+ : gemini-ls ( args -- )
+ [ PAGE ] [ "-l" = ] bi* print-links ;
: gemini-quit ( -- )
"gemini.txt" temp-file ?delete-file 0 exit ;
+: gemini-url ( -- )
+ URL ?first [ print ] when* ;
+
+: gemini-root ( -- )
+ URL ?first [ >url "/" >>path gemini-go ] when* ;
+
+: gemini-shell ( args -- )
+ "|" split "gemini.txt" temp-file dup file-exists? [
+ "cat" swap 2array prefix run-pipeline drop
+ ] [ 2drop ] if ;
+
CONSTANT: COMMANDS {
T{ command
{ name "back" }
{ quot [ drop gemini-less ] }
{ help "View the most recent Gemini URL in a pager." }
{ abbrevs { "l" } } }
+ T{ command
+ { name "ls" }
+ { quot [ gemini-ls ] }
+ { help "List the currently available links." }
+ { abbrevs f } }
T{ command
{ name "go" }
{ quot [ gemini-go ] }
{ help "Go to a Gemini URL" }
{ abbrevs { "g" } } }
+ T{ command
+ { name "gus" }
+ { quot [ drop "gemini://gus.guru/search" gemini-go ] }
+ { help "Submit a query to the GUS search engine." }
+ { abbrevs f } }
T{ command
{ name "up" }
{ quot [ drop gemini-up ] }
{ help "Go up one directory from the recent Gemini URL." }
{ abbrevs { "u" } } }
+ T{ command
+ { name "url" }
+ { quot [ drop gemini-url ] }
+ { help "Print the most recent Gemini URL." }
+ { abbrevs f } }
T{ command
{ name "reload" }
{ quot [ drop gemini-reload ] }
{ help "Reload the most recent Gemini URL." }
{ abbrevs { "r" } } }
+ T{ command
+ { name "root" }
+ { quot [ drop gemini-root ] }
+ { help "Navigate to the most recent Gemini URL's root." }
+ { abbrevs f } }
+ T{ command
+ { name "shell" }
+ { quot [ gemini-shell ] }
+ { help "'cat' the most recent Gemini URL through a shell." }
+ { abbrevs { "!" } } }
T{ command
{ name "quit" }
{ quot [ drop gemini-quit ] }
{ help "Quit the program." }
- { abbrevs { "q" } } }
+ { abbrevs { "q" "exit" } } }
}
TUPLE: gemini-command-loop < command-loop ;
M: gemini-command-loop missing-command
over string>number [ 1 - LINKS ?nth ] [ f ] if* [
- gemini-go 3drop
+ [ add-history ]
+ [ add-stack ]
+ [ dup array? [ first ] when gemini-get 3drop ] tri
] [
call-next-method
] if* ;
projects / factor.git / blobdiff