; a simple line editor for reading lisp expressions. ; colors strings and comments. nested parens get different colors. ; ; needs to do its own raw keyboard/screen management since we need to decide ; how to color each key right as it is printed. ; lots of logic devoted to handling backspace correctly. ; keyboard screen abort continuation -> string (function read-expression [ (default-space:space-address <- new space:literal 60:literal) (k:keyboard-address <- next-input) (screen:terminal-address <- next-input) (abort:continuation <- next-input) (history:buffer-address <- next-input) ; buffer of strings (history-length:integer <- get history:buffer-address/deref length:offset) (current-history-index:integer <- copy history-length:integer) (result:buffer-address <- init-buffer 10:literal) ; string to maybe add to (open-parens:integer <- copy 0:literal) ; for balancing parens and tracking nesting depth ; we can change color when backspacing over parens or comments or strings, ; but we need to know that they aren't escaped (escapes:buffer-address <- init-buffer 5:literal) ; to not return after just a comment (not-empty?:boolean <- copy nil:literal) { begin ; repeatedly read keys from the keyboard ; test: 34 (done?:boolean <- process-key default-space:space-address k:keyboard-address screen:terminal-address) (loop-unless done?:boolean) } ; trim trailing newline in result (easier history management below) { begin (l:character <- last result:buffer-address) (trailing-newline?:boolean <- equal l:character ((#\newline literal))) (break-unless trailing-newline?:boolean) (len:integer-address <- get-address result:buffer-address/deref length:offset) (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) } ; test: 3 => size of s is 2 (s:string-address <- to-array result:buffer-address) (reply s:string-address) ]) (function process-key [ ; return t to signal end of expression (default-space:space-address <- new space:literal 60:literal) (0:space-address/names:read-expression <- next-input) (k:keyboard-address <- next-input) (screen:terminal-address <- next-input) (c:character <- wait-for-key k:keyboard-address silent:literal/terminal) (len:integer-address <- get-address result:buffer-address/space:1/deref length:offset) (maybe-cancel-this-expression c:character abort:continuation/space:1) ; check for ctrl-d and exit { begin (eof?:boolean <- equal c:character ((ctrl-d literal))) (break-unless eof?:boolean) ; return empty expression (s:string-address-address <- get-address result:buffer-address/space:1/deref data:offset) (s:string-address-address/deref <- copy nil:literal) (reply t:literal) } ; check for backspace ; test: 34 ; todo: backspace past newline { begin (backspace?:boolean <- equal c:character ((#\backspace literal))) (break-unless backspace?:boolean) (print-character screen:terminal-address c:character/backspace) { begin ; delete last character if any (zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal) (break-if zero?:boolean) (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) ; switch colors ; test: "a"bc" ; test: "a\"bc" { begin (backspaced-over-close-quote?:boolean <- backspaced-over-unescaped? result:buffer-address/space:1 ((#\" literal)) escapes:buffer-address/space:1) ; " (break-unless backspaced-over-close-quote?:boolean) (slurp-string result:buffer-address/space:1 escapes:buffer-address/space:1 abort:continuation/space:1 k:keyboard-address screen:terminal-address) (reply nil:literal) } ; test: (+ 1 (2) ; test: (+ 1 #\(2) { begin (backspaced-over-open-paren?:boolean <- backspaced-over-unescaped? result:buffer-address/space:1 ((#\( literal)) escapes:buffer-address/space:1) (break-unless backspaced-over-open-paren?:boolean) (open-parens:integer/space:1 <- subtract open-parens:integer/space:1 1:literal) (reply nil:literal) } ; test: (+ 1 2) 3) ; test: (+ 1 2#\) 3) { begin (backspaced-over-close-paren?:boolean <- backspaced-over-unescaped? result:buffer-address/space:1 ((#\) literal)) escapes:buffer-address/space:1) (break-unless backspaced-over-close-paren?:boolean) (open-parens:integer/space:1 <- add open-parens:integer/space:1 1:literal) (reply nil:literal) } } (reply nil:literal) } ; up arrow; switch to previous item in history { begin (up-arrow?:boolean <- equal c:character ((up literal))) (break-unless up-arrow?:boolean) ; if history exists

/*
 * (C)opyright MMVI Anselm R. Garbe <garbeam at gmail dot com>
 * See LICENSE file for license details.
 */

#define DEFMODE			dotile /* dofloat */
#define FONT			"fixed"
#define BGCOLOR			"#666699"
#define FGCOLOR			"#eeeeee"
#define BORDERCOLOR		"#9999CC"
#define MODKEY			Mod1Mask
#define NUMLOCKMASK		Mod2Mask
#define MASTERW			52 /* percent */

enum { Tfnord, Tdev, Tnet, Twork, Tmisc, TLast };
#define TAGS \
char *tags[TLast] = { \
	[Tfnord] = "fnord", \
	[Tdev] = "dev", \
	[Tnet] = "net", \
	[Twork] = "work", \
	[Tmisc] = "misc", \
};
#define DEFTAG			Tdev

#define KEYS \
	const char *term[] = { "xterm", NULL }; \
static Key key[] = { \
	/* modifier		key		function	arguments */ \
	{ MODKEY,		XK_0,		view,		{ .i = Tfnord } }, \
	{ MODKEY,		XK_1,		view,		{ .i = Tdev } }, \
	{ MODKEY,		XK_2,		view,		{ .i = Tnet } }, \
	{ MODKEY,		XK_3,		view,		{ .i = Twork } }, \
	{ MODKEY,		XK_4,		view,		{ .i = Tmisc} }, \
	{ MODKEY,		XK_h,		viewprev,	{ 0 } }, \
	{ MODKEY,		XK_j,		focusnext,	{ 0 } }, \
	{ MODKEY,		XK_k,		focusprev,	{ 0 } }, \
	{ MODKEY,		XK_l,		viewnext,	{ 0 } }, \
	{ MODKEY,		XK_m,		togglemax,	{ 0 } }, \
	{ MODKEY,		XK_space,	togglemode,	{ 0 } }, \
	{ MODKEY,		XK_Return,	zoom,		{ 0 } }, \
	{ MODKEY|ControlMask,	XK_0,		appendtag,	{ .i = Tfnord } }, \
	{ MODKEY|ControlMask,	XK_1,		appendtag,	{ .i = Tdev } }, \
	{ MODKEY|ControlMask,	XK_2,		appendtag,	{ .i = Tnet } }, \
	{ MODKEY|ControlMask,	XK_3,		appendtag,	{ .i = Twork } }, \
	{ MODKEY|ControlMask,	XK_4,		appendtag,	{ .i = Tmisc } }, \
	{ MODKEY|ShiftMask,	XK_0,		replacetag,	{ .i = Tfnord } }, \
	{ MODKEY|ShiftMask,	XK_1,		replacetag,	{ .i = Tdev } }, \
	{ MODKEY|ShiftMask,	XK_2,		replacetag,	{ .i = Tnet } }, \
	{ MODKEY|ShiftMask,	XK_3,		replacetag,	{ .i = Twork } }, \
	{ MODKEY|ShiftMask,	XK_4,		replacetag,	{ .i = Tmisc } }, \
	{ MODKEY|ShiftMask,	XK_c,		killclient,	{ 0 } }, \
	{ MODKEY|ShiftMask,	XK_q,		quit,		{ 0 } }, \
	{ MODKEY|ShiftMask,	XK_Return,	spawn,		{ .argv = term } }, \
};

#define RULES \
static Rule rule[] = { \
	/* class:instance	tags				isfloat */ \
	{ "Firefox.*",		{ [Tnet] = "net" },		False }, \
	{ "Gimp.*",		{ 0 },				True}, \
};

character screen:terminal-address c:character 4:literal/fg/blue) ; handle backspace ; test: ; abcdef ; todo: how to exit comment? { begin (backspace?:boolean <- equal c:character ((#\backspace literal))) (break-unless backspace?:boolean) (len:integer-address <- get-address in:buffer-address/deref length:offset) ; buffer has to have at least the semi-colon so can't be empty (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) ; if we erase start of comment, return (comment-deleted?:boolean <- backspaced-over-unescaped? in:buffer-address ((#\; literal)) escapes:buffer-address) ; " (jump-unless comment-deleted?:boolean next-key-in-comment:offset) ; loop (reply nil:literal/read-comment?) } (in:buffer-address <- append in:buffer-address c:character) (newline?:boolean <- equal c:character ((#\newline literal))) (loop-unless newline?:boolean) } (reply t:literal/read-comment?) ]) (function slurp-string [ (default-space:space-address <- new space:literal 30:literal) (in:buffer-address <- next-input) (escapes:buffer-address <- next-input) (abort:continuation <- next-input) (k:keyboard-address <- next-input) (screen:terminal-address <- next-input) ; test: "abc" { begin next-key-in-string (c:character <- wait-for-key k:keyboard-address silent:literal/terminal) (maybe-cancel-this-expression c:character abort:continuation screen:terminal-address) ; test: check needs to come before print (print-character screen:terminal-address c:character 6:literal/fg/cyan) ; handle backspace ; test: "abcd" ; todo: how to exit string? { begin (backspace?:boolean <- equal c:character ((#\backspace literal))) (break-unless backspace?:boolean) (len:integer-address <- get-address in:buffer-address/deref length:offset) ; typed a quote before calling slurp-string, so can't be empty (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) ; if we erase start of string, return ; test: "34 (string-deleted?:boolean <- backspaced-over-unescaped? in:buffer-address ((#\" literal)) escapes:buffer-address) ; " ;? ($print string-deleted?:boolean) ;? 1 (jump-if string-deleted?:boolean end:offset) ; break (jump next-key-in-string:offset) ; loop } (in:buffer-address <- append in:buffer-address c:character) ; break on quote -- unless escaped by backslash ; test: "abc\"ef" { begin (backslash?:boolean <- equal c:character ((#\\ literal))) (break-unless backslash?:boolean) (in:buffer-address escapes:buffer-address <- slurp-escaped-character in:buffer-address 6:literal/cyan escapes:buffer-address abort:continuation k:keyboard-address screen:terminal-address) (jump next-key-in-string:offset) ; loop } ; if not backslash (end-quote?:boolean <- equal c:character ((#\" literal))) ; for vim: " (loop-unless end-quote?:boolean) } end ]) ; buffer to add character to, color to print it in to the screen, abort continuation (function slurp-escaped-character [ (default-space:space-address <- new space:literal 30:literal) (in:buffer-address <- next-input) (color-code:integer <- next-input) (escapes:buffer-address <- next-input) (abort:continuation <- next-input) (k:keyboard-address <- next-input) (screen:terminal-address <- next-input) (c:character <- wait-for-key k:keyboard-address silent:literal/terminal) (maybe-cancel-this-expression c:character abort:continuation screen:terminal-address) ; test: check needs to come before print (print-character screen:terminal-address c:character color-code:integer) (len:integer-address <- get-address in:buffer-address/deref length:offset) (escapes:buffer-address <- append escapes:buffer-address len:integer-address/deref) ;? ($print (("+" literal))) ;? 1 ; handle backspace ; test: "abc\def" ; test: #\ { begin (backspace?:boolean <- equal c:character ((#\backspace literal))) (break-unless backspace?:boolean) ; just typed a backslash, so buffer can't be empty (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) (elen:integer-address <- get-address escapes:buffer-address/deref length:offset) (elen:integer-address/deref <- subtract elen:integer-address/deref 1:literal) ;? ($print (("-" literal))) ;? 1 (reply in:buffer-address/same-as-arg:0 escapes:buffer-address/same-as-arg:2) } ; if not backspace, save and return (in:buffer-address <- append in:buffer-address c:character) (reply in:buffer-address/same-as-arg:0 escapes:buffer-address/same-as-arg:2) ]) (function backspaced-over-unescaped? [ (default-space:space-address <- new space:literal 30:literal) (in:buffer-address <- next-input) (expected:character <- next-input) (escapes:buffer-address <- next-input) ; char just backspaced over matches { begin (c:character <- past-last in:buffer-address) (char-match?:boolean <- equal c:character expected:character) (break-if char-match?:boolean) (reply nil:literal) } ; and char before cursor is not an escape { begin (most-recent-escape:integer <- last escapes:buffer-address) (last-idx:integer <- get in:buffer-address/deref length:offset) ;? ($print most-recent-escape:integer) ;? 1 ;? ($print last-idx:integer) ;? 1 (was-unescaped?:boolean <- not-equal last-idx:integer most-recent-escape:integer) (break-if was-unescaped?:boolean) (reply nil:literal) } (reply t:literal) ]) ; return the character past the end of the buffer, if there's room (function past-last [ (default-space:space-address <- new space:literal 30:literal) (in:buffer-address <- next-input) (n:integer <- get in:buffer-address/deref length:offset) (s:string-address <- get in:buffer-address/deref data:offset) (capacity:integer <- length s:string-address/deref) { begin (no-space?:boolean <- greater-or-equal n:integer capacity:integer) (break-unless no-space?:boolean) (reply ((#\null literal))) } (result:character <- index s:string-address/deref n:integer) (reply result:character) ]) (function maybe-cancel-this-expression [ ; check for ctrl-g and abort (default-space:space-address <- new space:literal 30:literal) (c:character <- next-input) (abort:continuation <- next-input) (screen:terminal-address <- next-input) { begin (interrupt?:boolean <- equal c:character ((ctrl-g literal))) (break-unless interrupt?:boolean) (print-character screen:terminal-address ((#\^ literal))) (print-character screen:terminal-address ((#\G literal))) (print-character screen:terminal-address ((#\newline literal))) (continue-from abort:continuation) } ]) (function main [ (default-space:space-address <- new space:literal 30:literal) (cursor-mode) ($print (("connected to anarki! type in an expression, then hit enter. ctrl-d exits. ctrl-g clears the current expression." literal))) (print-character nil:literal/terminal ((#\newline literal))) ; todo: ctrl-g shouldn't clear history (abort:continuation <- current-continuation) (history:buffer-address <- init-buffer 5:literal) ; buffer of buffers of strings, one per expression typed in { begin (s:string-address <- read-expression nil:literal/keyboard nil:literal/terminal abort:continuation history:buffer-address) (break-unless s:string-address) ;? (x:integer <- length s:string-address/deref) ;? 1 ;? ($print x:integer) ;? 1 ;? ($print ((#\newline literal))) ;? 1 (history:buffer-address <- append history:buffer-address s:string-address) ;? (len:integer <- get history:buffer-address/deref length:offset) ;? 1 ;? ($print len:integer) ;? 1 ;? ($print ((#\newline literal))) ;? 1 (retro-mode) ; print errors cleanly ;? (print-string nil:literal/terminal s:string-address) ;? 1 (t:string-address <- $eval s:string-address) (cursor-mode) ($print (("=> " literal))) (print-string nil:literal/terminal t:string-address) (print-character nil:literal/terminal ((#\newline literal))) (print-character nil:literal/terminal ((#\newline literal))) ; empty line separates each expression and result (loop) } ])