1 ! Copyright (C) 2021 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays combinators.short-circuit command-loop
5 formatting gemini gemini.private io io.directories
6 io.encodings.string io.encodings.utf8 io.files io.files.temp
7 io.launcher kernel math math.parser namespaces present sequences
8 splitting system urls webbrowser ;
12 CONSTANT: DEFAULT-URL "gemini://gemini.circumlunar.space"
14 CONSTANT: HISTORY V{ }
19 : add-stack ( args -- )
20 URL ?first STACK index [
21 1 + dup STACK ?nth pick = [
24 STACK [ length ] [ delete-slice ] bi
27 0 STACK remove-nth! drop
34 : add-history ( args -- )
35 HISTORY dup length 10 > [
37 ] when dupd remove! push ;
39 : gemini-history ( -- )
40 HISTORY [ 1 + swap "[%s] %s\n" printf ] each-index
41 LINKS delete-all HISTORY LINKS push-all ;
43 : gemini-print ( url body meta -- )
46 gemini-charset decode string-lines [
47 { [ pre get not ] [ "=>" ?head ] } 0&& [
48 swap gemini-link present LINKS push
49 LINKS length swap "[%s] %s\n" printf
56 : gemini-get ( args -- )
58 >url dup gemini [ drop ] 2dip swap "text/" ?head [
59 "gemini.txt" temp-file
60 [ utf8 [ gemini-print ] with-file-writer ]
61 [ utf8 file-contents print ] bi
63 "ERROR: Cannot display '" "'" surround print 2drop
66 : gemini-go ( args -- )
67 [ DEFAULT-URL ] when-empty
68 { [ "://" over subseq? ] [ "gemini://" head? ] } 1||
69 [ "gemini://" prepend ] unless
70 dup "gemini://" head? [
71 [ add-history ] [ add-stack ] [ gemini-get ] tri
74 : gemini-reload ( -- )
75 HISTORY ?last gemini-go ;
78 URL ?first STACK index [
79 1 - STACK ?nth [ gemini-get ] when*
82 : gemini-forward ( -- )
83 URL ?first STACK index [
84 1 + STACK ?nth [ gemini-get ] when*
89 >url f >>query f >>anchor
90 [ "/" ?tail drop "/" split1-last drop "/" append ] change-path
95 "gemini.txt" temp-file dup exists? [
96 "less" swap 2array try-process
100 "gemini.txt" temp-file ?delete-file 0 exit ;
105 { quot [ drop gemini-back ] }
106 { help "Go back to the previous Gemini URL." }
107 { abbrevs { "b" } } }
110 { quot [ drop gemini-forward ] }
111 { help "Go forward to the next Gemini URL." }
112 { abbrevs { "f" } } }
115 { quot [ drop gemini-history ] }
116 { help "Display recently viewed Gemini URLs." }
117 { abbrevs { "h" "hist" } } }
120 { quot [ drop gemini-less ] }
121 { help "View the most recent Gemini URL in a pager." }
122 { abbrevs { "l" } } }
125 { quot [ gemini-go ] }
126 { help "Go to a Gemini URL" }
127 { abbrevs { "g" } } }
130 { quot [ drop gemini-up ] }
131 { help "Go up one directory from the recent Gemini URL." }
132 { abbrevs { "u" } } }
135 { quot [ drop gemini-reload ] }
136 { help "Reload the most recent Gemini URL." }
137 { abbrevs { "r" } } }
140 { quot [ drop gemini-quit ] }
141 { help "Quit the program." }
142 { abbrevs { "q" } } }
145 TUPLE: gemini-command-loop < command-loop ;
147 M: gemini-command-loop missing-command
148 over string>number [ 1 - LINKS ?nth ] [ f ] if* [
155 "Welcome to Project Gemini!" "GEMINI>"
156 gemini-command-loop new-command-loop
157 COMMANDS [ over add-command ] each