1 ! Copyright (C) 2021 John Benediktsson
2 ! See https://factorcode.org/license.txt for BSD license
4 USING: accessors arrays combinators.short-circuit command-loop
5 environment formatting gopher gopher.private io io.directories
6 io.encodings.utf8 io.files io.files.temp io.launcher io.pipes
7 kernel literals math math.parser namespaces present sequences
8 splitting system urls webbrowser ;
12 CONSTANT: DEFAULT-URL "gopher://gopher.quux.org"
14 CONSTANT: HISTORY V{ }
20 : find-url ( url items -- i item )
21 [ dup array? [ first ] when = ] with find ;
23 : nth-url ( i items -- url )
24 ?nth dup array? [ first ] when ;
26 : stack-url ( delta -- url )
27 URL ?first STACK find-url drop
28 [ + STACK nth-url ] [ drop f ] if* ;
30 : add-stack ( args -- )
31 dup dup array? [ first ] when
32 dup STACK find-url drop [
35 URL ?first STACK find-url drop [
36 over PAGE find-url drop [
37 1 + dup STACK nth-url rot = [
40 STACK [ length ] [ delete-slice ] bi
43 0 STACK remove-nth! drop
57 : add-history ( args -- )
58 HISTORY dup length 10 > [
60 ] when dupd remove! push ;
62 : print-links ( links verbose? -- )
63 LINKS delete-all over LINKS push-all
65 1 + swap [ dup array? [ first ] when URL ?first = [ drop "*" ] when ] keep
66 _ [ dup array? [ dup second empty? not ] [ f ] if ] [ f ] if [
67 first2 swap "[%s] %s (%s)\n" printf
69 dup array? [ first2 ] [ f ] if
70 dup empty? -rot ? "[%s] %s\n" printf
74 : gopher-history ( -- )
75 HISTORY t print-links ;
77 : gopher-print ( item-type body -- )
79 gopher-text swap ${ A_MENU A_INDEX } member?
80 [ [ dup empty? [ <gopher-link> ] unless ] map ] when
83 dup type>> CHAR: i = [
86 [ name>> ] [ >url present ] bi
88 PAGE length swap "[%s] %s\n" printf
94 LINKS delete-all PAGE LINKS push-all ;
96 : gopher-get ( args -- )
97 dup array? [ first ] when dup URL set-first
98 >url gopher over ${ A_TEXT A_MENU A_INDEX } member? [
99 "gopher.txt" temp-file
100 [ utf8 [ gopher-print ] with-file-writer ]
101 [ utf8 file-contents print ] bi
103 "ERROR: Cannot display '" "'" surround print drop
106 : gopher-go ( args -- )
107 dup array? [ first ] when present [ DEFAULT-URL ] when-empty
108 { [ "://" over subseq? ] [ "gopher://" head? ] } 1||
109 [ "gopher://" prepend ] unless
110 dup "gopher://" head? [
111 [ add-history ] [ add-stack ] [ gopher-get ] tri
114 : gopher-reload ( -- )
115 URL ?first gopher-go ;
118 -1 stack-url [ gopher-get ] when* ;
120 : gopher-forward ( -- )
121 1 stack-url [ gopher-get ] when* ;
124 "gopher.txt" temp-file dup file-exists? [
127 "PAGER" os-env [ "less" ] unless* >>command
128 input-stream get >>stdin
133 : gopher-ls ( args -- )
134 [ PAGE ] [ "-l" = ] bi* print-links ;
137 "gopher.txt" temp-file ?delete-file 0 exit ;
140 URL ?first [ print ] when* ;
143 URL ?first [ >url "/" >>path gopher-go ] when* ;
145 : gopher-shell ( args -- )
146 "|" split "gopher.txt" temp-file dup file-exists? [
147 "cat" swap 2array prefix run-pipeline drop
153 { quot [ drop gopher-back ] }
154 { help "Go back to the previous gopher URL." }
155 { abbrevs { "b" } } }
158 { quot [ drop gopher-forward ] }
159 { help "Go forward to the next gopher URL." }
160 { abbrevs { "f" } } }
163 { quot [ drop gopher-history ] }
164 { help "Display recently viewed gopher URLs." }
165 { abbrevs { "h" "hist" } } }
168 { quot [ drop gopher-less ] }
169 { help "View the most recent gopher URL in a pager." }
170 { abbrevs { "l" } } }
173 { quot [ gopher-ls ] }
174 { help "List the currently available links." }
178 { quot [ gopher-go ] }
179 { help "Go to a gopher URL" }
180 { abbrevs { "g" } } }
183 { quot [ drop gopher-url ] }
184 { help "Print the most recent gopher URL." }
188 { quot [ drop gopher-reload ] }
189 { help "Reload the most recent gopher URL." }
190 { abbrevs { "r" } } }
193 { quot [ drop gopher-root ] }
194 { help "Navigate to the most recent gopher URL's root." }
198 { quot [ gopher-shell ] }
199 { help "'cat' the most recent gopher URL through a shell." }
200 { abbrevs { "!" } } }
203 { quot [ drop DEFAULT-URL gopher-go ] }
204 { help "Go to the default gopher URL" }
208 { quot [ drop gopher-quit ] }
209 { help "Quit the program." }
210 { abbrevs { "q" "exit" } } }
213 TUPLE: gopher-command-loop < command-loop ;
215 M: gopher-command-loop missing-command
216 over string>number [ 1 - LINKS ?nth ] [ f ] if* [
223 "Welcome to Gopher!" "GOPHER>"
224 gopher-command-loop new-command-loop
225 COMMANDS [ over add-command ] each