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 ascii assocs combinators
   5 combinators.short-circuit formatting gemini gemini.private io
   6 io.encodings.string kernel math math.parser namespaces present
   7 sequences splitting urls ;
   8
   9 IN: gemini.cli
  10
  11 CONSTANT: ABBREVS H{
  12      { "b"    "back" }
  13      { "f"    "forward" }
  14      { "g"    "go" }
  15      { "h"    "history" }
  16      { "hist" "history" }
  17      { "q"    "quit" }
  18      { "r"    "reload" }
  19      { "u"    "up" }
  20 }
  21
  22 CONSTANT: HISTORY V{ }
  23 CONSTANT: LINKS V{ }
  24 CONSTANT: URL V{ }
  25
  26 : add-history ( args -- )
  27     HISTORY dup length 10 > [
  28         0 swap remove-nth!
  29     ] when dupd remove! push ;
  30
  31 : gemini-history ( args -- )
  32     drop HISTORY [ 1 + swap "[%s] %s\n" printf ] each-index
  33     LINKS delete-all HISTORY LINKS push-all ;
  34
  35 : gemini-get ( args -- )
  36     dup 0 URL set-nth
  37     >url dup gemini [ drop ] 2dip swap "text/" ?head [
  38         f pre [
  39             LINKS delete-all
  40             gemini-charset decode string-lines [
  41                 { [ pre get not ] [ "=>" ?head ] } 0&& [
  42                     swap gemini-link present LINKS push
  43                     LINKS length swap "[%s] %s\n" printf
  44                 ] [
  45                     gemini-line.
  46                 ] if
  47             ] with each
  48         ] with-variable
  49     ] [
  50         "ERROR: Cannot display '" "'" surround print 2drop
  51     ] if ;
  52
  53 : gemini-go ( args -- )
  54     [ "gemini://gemini.circumlunar.space" ] when-empty
  55     dup "gemini://" head? [ "gemini://" prepend ] unless
  56     dup add-history gemini-get ;
  57
  58 : gemini-reload ( args -- )
  59     drop HISTORY ?last gemini-go ;
  60
  61 : gemini-back ( args -- )
  62     drop URL ?first HISTORY index [
  63         1 - HISTORY ?nth [ gemini-get ] when*
  64     ] when* ;
  65
  66 : gemini-forward ( args -- )
  67     drop URL ?first HISTORY index [
  68         1 + HISTORY ?nth [ gemini-get ] when*
  69     ] when* ;
  70
  71 : gemini-up ( args -- )
  72     drop URL ?first [
  73         >url f >>query f >>anchor
  74         [ "/" ?tail drop "/" split1-last drop "/" append ] change-path
  75         present gemini-go
  76     ] when* ;
  77
  78 : gemini-cmd ( cmd -- )
  79     " " split1 swap >lower ABBREVS ?at drop {
  80         { "history" [ gemini-history ] }
  81         { "go" [ gemini-go ] }
  82         { "reload" [ gemini-reload ] }
  83         { "back" [ gemini-back ] }
  84         { "forward" [ gemini-forward ] }
  85         { "up" [ gemini-up ] }
  86         { "" [ drop ] }
  87         [
  88             dup string>number [ 1 - LINKS ?nth ] [ f ] if* [
  89                 2nip gemini-go
  90             ] [
  91                 "ERROR: Unknown command '" "'" surround print drop
  92             ] if*
  93         ]
  94     } case flush ;
  95
  96 : gemini-main ( -- )
  97     "Welcome to Project Gemini!" print flush [
  98         "GEMINI> " write flush readln
  99         [ gemini-cmd t ] [ f ] if*
 100     ] loop ;
 101
 102 MAIN: gemini-main