extra/gemini/cli/cli.factor

   1 ! Copyright (C) 2021 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors arrays ascii assocs combinators
   5 combinators.short-circuit formatting gemini gemini.private
   6 grouping io io.directories io.encodings.string io.encodings.utf8
   7 io.files io.files.temp io.launcher kernel math math.parser
   8 namespaces present sequences splitting system urls webbrowser ;
   9
  10 IN: gemini.cli
  11
  12 CONSTANT: ABBREVS H{
  13      { "b"    "back" }
  14      { "f"    "forward" }
  15      { "g"    "go" }
  16      { "h"    "history" }
  17      { "hist" "history" }
  18      { "l"    "less" }
  19      { "q"    "quit" }
  20      { "r"    "reload" }
  21      { "u"    "up" }
  22      { "?"    "help" }
  23 }
  24
  25 CONSTANT: COMMANDS H{
  26     { "back"    "Go back to the previous Gemini URL." }
  27     { "forward" "Go forward to the next Gemini URL." }
  28     { "go"      "Go to a Gemini URL" }
  29     { "help"    "Get help for commands." }
  30     { "history" "Display recently viewed Gemini URLs." }
  31     { "less"    "View the most recent Gemini URL in a pager." }
  32     { "quit"    "Quit the program." }
  33     { "reload"  "Reload the most recent Gemini URL." }
  34     { "up"      "Go up one directory from the recent Gemini URL." }
  35 }
  36
  37 CONSTANT: HISTORY V{ }
  38 CONSTANT: LINKS V{ }
  39 CONSTANT: STACK V{ }
  40 CONSTANT: URL V{ }
  41
  42 : add-stack ( args -- )
  43     URL ?first STACK index [
  44         1 + dup STACK ?nth pick = [
  45             2drop
  46         ] [
  47             STACK [ length ] [ delete-slice ] bi
  48             STACK push
  49             STACK length 10 > [
  50                 0 STACK remove-nth! drop
  51             ] when
  52         ] if
  53     ] [
  54         STACK push
  55     ] if* ;
  56
  57 : add-history ( args -- )
  58     HISTORY dup length 10 > [
  59         0 swap remove-nth!
  60     ] when dupd remove! push ;
  61
  62 : gemini-history ( -- )
  63     HISTORY [ 1 + swap "[%s] %s\n" printf ] each-index
  64     LINKS delete-all HISTORY LINKS push-all ;
  65
  66 : gemini-print ( url body meta -- )
  67     f pre [
  68         LINKS delete-all
  69         gemini-charset decode string-lines [
  70             { [ pre get not ] [ "=>" ?head ] } 0&& [
  71                 swap gemini-link present LINKS push
  72                 LINKS length swap "[%s] %s\n" printf
  73             ] [
  74                 gemini-line.
  75             ] if
  76         ] with each
  77     ] with-variable ;
  78
  79 : gemini-get ( args -- )
  80     dup 0 URL set-nth
  81     >url dup gemini [ drop ] 2dip swap "text/" ?head [
  82         "gemini.txt" temp-file
  83         [ utf8 [ gemini-print ] with-file-writer ]
  84         [ utf8 file-contents print ] bi
  85     ] [
  86         "ERROR: Cannot display '" "'" surround print 2drop
  87     ] if ;
  88
  89 : gemini-go ( args -- )
  90     [ "gemini://gemini.circumlunar.space" ] when-empty
  91     { [ "://" over subseq? ] [ "gemini://" head? ] } 1||
  92     [ "gemini://" prepend ] unless
  93     dup "gemini://" head? [
  94         [ add-history ] [ add-stack ] [ gemini-get ] tri
  95     ] [ open-url ] if ;
  96
  97 : gemini-reload ( -- )
  98     HISTORY ?last gemini-go ;
  99
 100 : gemini-back ( -- )
 101     URL ?first STACK index [
 102         1 - STACK ?nth [ gemini-get ] when*
 103     ] when* ;
 104
 105 : gemini-forward ( -- )
 106     URL ?first STACK index [
 107         1 + STACK ?nth [ gemini-get ] when*
 108     ] when* ;
 109
 110 : gemini-up ( -- )
 111     URL ?first [
 112         >url f >>query f >>anchor
 113         [ "/" ?tail drop "/" split1-last drop "/" append ] change-path
 114         present gemini-go
 115     ] when* ;
 116
 117 : gemini-less ( -- )
 118     "less" "gemini.txt" temp-file 2array try-process ;
 119
 120 : gemini-quit ( -- )
 121     "gemini.txt" temp-file ?delete-file 0 exit ;
 122
 123 : gemini-help ( args -- )
 124     [
 125         COMMANDS keys
 126         [ 6 <groups> ] [ longest length 4 + ] bi
 127         '[ [ _ CHAR: \s pad-tail write ] each nl ] each
 128     ] [
 129         ABBREVS ?at drop COMMANDS ?at [
 130             print
 131         ] [
 132             "ERROR: Command '" "' not found" surround print
 133         ] if
 134     ] if-empty ;
 135
 136 : gemini-cmd ( cmd -- )
 137     " " split1 swap >lower ABBREVS ?at drop {
 138         { "help" [ gemini-help ] }
 139         { "history" [ drop gemini-history ] }
 140         { "go" [ gemini-go ] }
 141         { "reload" [ drop gemini-reload ] }
 142         { "back" [ drop gemini-back ] }
 143         { "forward" [ drop gemini-forward ] }
 144         { "up" [ drop gemini-up ] }
 145         { "less" [ drop gemini-less ] }
 146         { "quit" [ drop gemini-quit ] }
 147         { "" [ drop ] }
 148         [
 149             dup string>number [ 1 - LINKS ?nth ] [ f ] if* [
 150                 2nip gemini-go
 151             ] [
 152                 "ERROR: Unknown command '" "'" surround print drop
 153             ] if*
 154         ]
 155     } case flush ;
 156
 157 : gemini-main ( -- )
 158     "Welcome to Project Gemini!" print flush [
 159         "GEMINI> " write flush readln
 160         [ gemini-cmd t ] [ f ] if*
 161     ] loop ;
 162
 163 MAIN: gemini-main