From cba72871c9f0dcb20ce19765531506f4c81aa119 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 17 Dec 2014 13:07:15 -0800
Subject: [PATCH] gopher: initial commit of gopher lib.

---
 extra/gopher/authors.txt   |   1 +
 extra/gopher/gopher.factor | 117 +++++++++++++++++++++++++++++++++++++
 extra/gopher/summary.txt   |   1 +
 extra/gopher/tags.txt      |   1 +
 4 files changed, 120 insertions(+)
 create mode 100644 extra/gopher/authors.txt
 create mode 100644 extra/gopher/gopher.factor
 create mode 100644 extra/gopher/summary.txt
 create mode 100644 extra/gopher/tags.txt

diff --git a/extra/gopher/authors.txt b/extra/gopher/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/gopher/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/gopher/gopher.factor b/extra/gopher/gopher.factor
new file mode 100644
index 0000000000..3a12c56f4c
--- /dev/null
+++ b/extra/gopher/gopher.factor
@@ -0,0 +1,117 @@
+! Copyright (C) 2014 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors byte-arrays colors.constants combinators
+formatting fry images images.loader images.loader.private
+images.viewer io io.encodings.binary io.encodings.string
+io.encodings.utf8 io.sockets io.styles kernel make math
+math.parser namespaces prettyprint sequences splitting strings
+urls vocabs ;
+
+IN: gopher
+
+<PRIVATE
+
+CONSTANT: A_TEXT CHAR: 0
+CONSTANT: A_MENU CHAR: 1
+CONSTANT: A_CSO CHAR: 2
+CONSTANT: A_ERROR CHAR: 3
+CONSTANT: A_MACBINHEX CHAR: 4
+CONSTANT: A_PCBINHEX CHAR: 5
+CONSTANT: A_UUENCODED CHAR: 6
+CONSTANT: A_INDEX CHAR: 7
+CONSTANT: A_TELNET CHAR: 8
+CONSTANT: A_BINARY CHAR: 9
+CONSTANT: A_DUPLICATE CHAR: +
+CONSTANT: A_SOUND CHAR: s
+CONSTANT: A_EVENT CHAR: e
+CONSTANT: A_CALENDAR CHAR: c
+CONSTANT: A_HTML CHAR: h
+CONSTANT: A_TN3270 CHAR: T
+CONSTANT: A_MIME CHAR: M
+CONSTANT: A_IMAGE CHAR: I
+CONSTANT: A_WHOIS CHAR: w
+CONSTANT: A_QUERY CHAR: q
+CONSTANT: A_GIF CHAR: g
+CONSTANT: A_WWW CHAR: w
+CONSTANT: A_PLUS_IMAGE CHAR: :
+CONSTANT: A_PLUS_MOVIE CHAR: ;
+CONSTANT: A_PLUS_SOUND CHAR: <
+
+: get-binary ( selector -- binary )
+    "\r\n" append utf8 encode write flush
+    input-stream get (stream-contents-by-block) ;
+
+: get-gif ( selector -- image )
+    get-binary "gif" (image-class) load-image* ;
+
+: get-text ( selector query/f -- lines )
+    [ "\t" glue ] when* "\r\n" append
+    utf8 encode write flush
+    input-stream get (stream-contents-by-block)
+    utf8 decode string-lines
+    "." over index [ head ] when* ;
+
+TUPLE: gopher-link type name selector host port ;
+
+: <gopher-link> ( item -- gopher-link )
+    [ "" ] [
+        unclip swap "\t" split first4 gopher-link boa
+    ] if-empty ;
+
+M: gopher-link >url
+    dup type>> CHAR: h = [
+        selector>> "URL:" ?head drop
+    ] [
+        {
+            [ host>> ] [ port>> ] [ type>> ] [ selector>> ]
+        } cleave "gopher://%s:%s/%s%s" sprintf
+    ] if >url ;
+
+: get-menu ( selector -- lines )
+    f get-text [ <gopher-link> ] map ;
+
+: get-selector ( selector -- stuff )
+    "/" split1 "" or swap
+    dup length 1 > [ string>number ] [ first ] if
+    {
+        { A_TEXT [ f get-text ] }
+        { A_MENU [ get-menu ] }
+        { A_INDEX [ get-menu ] }
+        { A_GIF [ get-gif ] }
+        [ drop get-binary ]
+    } case ;
+
+PRIVATE>
+
+ERROR: not-a-gopher-url url ;
+
+: gopher ( url -- object )
+    dup url? [ >url ] unless
+    dup protocol>> "gopher" = [ not-a-gopher-url ] unless {
+        [ host>> ]
+        [ port>> 70 or <inet> binary ]
+        [ path>> rest ]
+    } cleave '[ _ get-selector ] with-client ;
+
+: gopher. ( url -- )
+    gopher {
+        { [ dup byte-array? ] [ . ] }
+        { [ dup image? ] [ image. ] }
+        [
+            [
+                dup gopher-link? [
+                    dup type>> CHAR: i = [
+                        name>> print
+                    ] [
+                        [ name>> ] keep [
+                            presented ,,
+                            COLOR: blue foreground ,,
+                        ] H{ } make format nl
+                    ] if
+                ] [
+                    print
+                ] if
+            ] each
+        ]
+    } cond ;
diff --git a/extra/gopher/summary.txt b/extra/gopher/summary.txt
new file mode 100644
index 0000000000..baa8d44977
--- /dev/null
+++ b/extra/gopher/summary.txt
@@ -0,0 +1 @@
+Gopher client
diff --git a/extra/gopher/tags.txt b/extra/gopher/tags.txt
new file mode 100644
index 0000000000..992ae12982
--- /dev/null
+++ b/extra/gopher/tags.txt
@@ -0,0 +1 @@
+network