Create abstract interface between editor code and toolkit rendering
This commit is contained in:
parent
eee88df4bc
commit
dce1c2a09e
87
hall.scm
87
hall.scm
|
|
@ -12,57 +12,58 @@
|
|||
(dependencies `(("guile-config" ,guile-config)
|
||||
("guile-ncurses" ,guile-ncurses)
|
||||
("guile-ts" ,guile-ts)
|
||||
("tree-sitter-bash" ,tree-sitter-bash)
|
||||
("tree-sitter-bibtex" ,tree-sitter-bibtex)
|
||||
("tree-sitter-c" ,tree-sitter-c)
|
||||
("tree-sitter-c-sharp" ,tree-sitter-c-sharp)
|
||||
("tree-sitter-clojure" ,tree-sitter-clojure)
|
||||
("tree-sitter-cmake" ,tree-sitter-cmake)
|
||||
("tree-sitter-cpp" ,tree-sitter-cpp)
|
||||
("tree-sitter-css" ,tree-sitter-css)
|
||||
("tree-sitter-dockerfile" ,tree-sitter-dockerfile)
|
||||
("tree-sitter-elixir" ,tree-sitter-elixir)
|
||||
("tree-sitter-elm" ,tree-sitter-elm)
|
||||
("tree-sitter-go" ,tree-sitter-go)
|
||||
("tree-sitter-gomod" ,tree-sitter-gomod)
|
||||
("tree-sitter-haskell" ,tree-sitter-haskell)
|
||||
("tree-sitter-heex" ,tree-sitter-heex)
|
||||
("tree-sitter-html" ,tree-sitter-html)
|
||||
("tree-sitter-java" ,tree-sitter-java)
|
||||
("tree-sitter-javascript" ,tree-sitter-javascript)
|
||||
("tree-sitter-json" ,tree-sitter-json)
|
||||
("tree-sitter-julia" ,tree-sitter-julia)
|
||||
("tree-sitter-lua" ,tree-sitter-lua)
|
||||
("tree-sitter-markdown" ,tree-sitter-markdown)
|
||||
("tree-sitter-markdown-gfm" ,tree-sitter-markdown-gfm)
|
||||
("tree-sitter-meson" ,tree-sitter-meson)
|
||||
("tree-sitter-ocaml" ,tree-sitter-ocaml)
|
||||
("tree-sitter-org" ,tree-sitter-org)
|
||||
("tree-sitter-php" ,tree-sitter-php)
|
||||
("tree-sitter-plantuml" ,tree-sitter-plantuml)
|
||||
("tree-sitter-python" ,tree-sitter-python)
|
||||
("tree-sitter-r" ,tree-sitter-r)
|
||||
("tree-sitter-racket" ,tree-sitter-racket)
|
||||
("tree-sitter-ruby" ,tree-sitter-ruby)
|
||||
("tree-sitter-rust" ,tree-sitter-rust)
|
||||
("tree-sitter-scala" ,tree-sitter-scala)
|
||||
("tree-sitter-bash" ,tree-sitter-bash)
|
||||
("tree-sitter-bibtex" ,tree-sitter-bibtex)
|
||||
("tree-sitter-c" ,tree-sitter-c)
|
||||
("tree-sitter-c-sharp" ,tree-sitter-c-sharp)
|
||||
("tree-sitter-clojure" ,tree-sitter-clojure)
|
||||
("tree-sitter-cmake" ,tree-sitter-cmake)
|
||||
("tree-sitter-cpp" ,tree-sitter-cpp)
|
||||
("tree-sitter-css" ,tree-sitter-css)
|
||||
("tree-sitter-dockerfile" ,tree-sitter-dockerfile)
|
||||
("tree-sitter-elixir" ,tree-sitter-elixir)
|
||||
("tree-sitter-elm" ,tree-sitter-elm)
|
||||
("tree-sitter-go" ,tree-sitter-go)
|
||||
("tree-sitter-gomod" ,tree-sitter-gomod)
|
||||
("tree-sitter-haskell" ,tree-sitter-haskell)
|
||||
("tree-sitter-heex" ,tree-sitter-heex)
|
||||
("tree-sitter-html" ,tree-sitter-html)
|
||||
("tree-sitter-java" ,tree-sitter-java)
|
||||
("tree-sitter-javascript" ,tree-sitter-javascript)
|
||||
("tree-sitter-json" ,tree-sitter-json)
|
||||
("tree-sitter-julia" ,tree-sitter-julia)
|
||||
("tree-sitter-lua" ,tree-sitter-lua)
|
||||
("tree-sitter-markdown" ,tree-sitter-markdown)
|
||||
("tree-sitter-markdown-gfm" ,tree-sitter-markdown-gfm)
|
||||
("tree-sitter-meson" ,tree-sitter-meson)
|
||||
("tree-sitter-ocaml" ,tree-sitter-ocaml)
|
||||
("tree-sitter-org" ,tree-sitter-org)
|
||||
("tree-sitter-php" ,tree-sitter-php)
|
||||
("tree-sitter-plantuml" ,tree-sitter-plantuml)
|
||||
("tree-sitter-python" ,tree-sitter-python)
|
||||
("tree-sitter-r" ,tree-sitter-r)
|
||||
("tree-sitter-racket" ,tree-sitter-racket)
|
||||
("tree-sitter-ruby" ,tree-sitter-ruby)
|
||||
("tree-sitter-rust" ,tree-sitter-rust)
|
||||
("tree-sitter-scala" ,tree-sitter-scala)
|
||||
("tree-sitter-scheme" ,tree-sitter-scheme)
|
||||
("tree-sitter-typescript" ,tree-sitter-typescript)))
|
||||
("tree-sitter-typescript" ,tree-sitter-typescript)))
|
||||
(skip ())
|
||||
(files (libraries
|
||||
((directory "sloth" ((scheme-file "editor")
|
||||
(scheme-file "interface")))))
|
||||
((directory "sloth" ((scheme-file "common")
|
||||
(scheme-file "editor")
|
||||
(scheme-file "interface")
|
||||
(scheme-file "ncurses")))))
|
||||
(tests ((directory "tests" ())))
|
||||
(programs
|
||||
((directory "scripts" ((in-file "sloth")))))
|
||||
((directory "scripts" ((in-file "sloth")))))
|
||||
(documentation
|
||||
((directory "doc" ((texi-file "sloth")))
|
||||
(text-file "LICENSE")
|
||||
(symlink "README" "README.org")
|
||||
(symlink "README" "README.org")
|
||||
(org-file "README")))
|
||||
(infrastructure
|
||||
((text-file ".gitignore")
|
||||
(text-file "zhu-li")
|
||||
(scheme-file "guix")
|
||||
(scheme-file "hall")
|
||||
(scheme-file "manifest")))))
|
||||
(scheme-file "guix")
|
||||
(scheme-file "hall")
|
||||
(scheme-file "manifest")))))
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@
|
|||
"(Listof String) -> Int
|
||||
program entrypoint; handle commandline args and call appropriate procedures"
|
||||
(define options (getopt-config-auto args %configuration))
|
||||
(start-loop (option-ref options '(file) #f)))
|
||||
(start-loop (init-frontend 'ncurses) (option-ref options '(file) #f)))
|
||||
|
||||
;;; Local Variables:
|
||||
;;; mode: scheme
|
||||
|
|
|
|||
|
|
@ -0,0 +1,16 @@
|
|||
(define-module (sloth common)
|
||||
#:use-module (oop goops)
|
||||
#:export (<sloth-frontend>
|
||||
fetch-input
|
||||
get-main-win
|
||||
set-cursor-pos
|
||||
end
|
||||
write-buffer))
|
||||
|
||||
(define-class <sloth-frontend> ()
|
||||
(main-win #:getter get-main-win #:init-keyword #:main-win))
|
||||
|
||||
(define-generic fetch-input) ; args: <sloth-frontend>
|
||||
(define-generic set-cursor-pos) ; args: <sloth-frontend> x y
|
||||
(define-generic end) ; args: <sloth-frontend>
|
||||
(define-generic write-buffer) ; args: <sloth-frontend> buffer lines-scrolled
|
||||
261
sloth/editor.scm
261
sloth/editor.scm
|
|
@ -1,174 +1,191 @@
|
|||
(define-module (sloth editor)
|
||||
#:use-module (sloth interface)
|
||||
#:use-module (ncurses curses)
|
||||
#:use-module (ts)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
#:use-module (srfi srfi-9 gnu)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (sloth interface)
|
||||
#:use-module (sloth common)
|
||||
#:use-module (ts)
|
||||
#:export (start-loop))
|
||||
|
||||
(define-immutable-record-type <sloth-state>
|
||||
(make-sloth-state win mode tree point-node)
|
||||
sloth-state?
|
||||
(win sloth-state-win)
|
||||
(mode sloth-state-mode set-sloth-state-mode)
|
||||
(tree sloth-state-tree set-sloth-state-tree)
|
||||
(point-node sloth-state-point-node set-sloth-state-point-node))
|
||||
(define-class <sloth-state> ()
|
||||
(frontend #:init-keyword #:frontend #:getter get-frontend)
|
||||
(mode #:init-value 'normal-mode #:accessor mode)
|
||||
(buffer #:init-value '("") #:accessor buffer)
|
||||
(tree #:accessor tree)
|
||||
(point-node #:accessor point-node)
|
||||
(curx #:init-value 0 #:accessor curx)
|
||||
(cury #:init-value 0 #:accessor cury)
|
||||
(lines-scrolled #:init-value 0 #:accessor lines-scrolled))
|
||||
|
||||
(define* (start-loop #:optional (file #f))
|
||||
(define state (make-sloth-state (init-win) 'normal-mode #f #f))
|
||||
(if file
|
||||
(core-loop (find-file state file))
|
||||
(core-loop state)))
|
||||
(define* (start-loop frontend #:optional (file #f))
|
||||
(define state (make <sloth-state>
|
||||
#:frontend frontend))
|
||||
(find-file state file)
|
||||
(write-buffer (get-frontend state)
|
||||
(buffer state)
|
||||
(lines-scrolled state))
|
||||
(core-loop state))
|
||||
|
||||
(define (core-loop state)
|
||||
(define win (sloth-state-win state))
|
||||
(define mode (sloth-state-mode state))
|
||||
(define new-state
|
||||
(case mode
|
||||
((normal-mode) (normal-mode-process-input state (getch win)))
|
||||
((insert-mode) (insert-mode-process-input state (getch win)))))
|
||||
(core-loop new-state))
|
||||
(case (mode state)
|
||||
((normal-mode)
|
||||
(normal-mode-process-input state
|
||||
(fetch-input (get-frontend state))))
|
||||
((insert-mode)
|
||||
(insert-mode-process-input state
|
||||
(fetch-input (get-frontend state)))))
|
||||
(write-buffer (get-frontend state)
|
||||
(buffer state)
|
||||
(lines-scrolled state))
|
||||
(core-loop state))
|
||||
|
||||
(define (insert-mode-process-input state key)
|
||||
(define y (getcury (sloth-state-win state)))
|
||||
(define x (getcurx (sloth-state-win state)))
|
||||
(cond
|
||||
((eqv? key KEY_BACKSPACE)
|
||||
(backward-delete-char state))
|
||||
((eqv? key KEY_DC)
|
||||
(delete-char state))
|
||||
((eqv? key KEY_LEFT)
|
||||
(move-cursor state y (- x 1)))
|
||||
((eqv? key KEY_RIGHT)
|
||||
(move-cursor state y (+ x 1)))
|
||||
((eqv? key KEY_UP)
|
||||
(move-cursor state (- y 1) x))
|
||||
((eqv? key KEY_DOWN)
|
||||
(move-cursor state (+ y 1) x))
|
||||
((eqv? key #\esc)
|
||||
(set-sloth-state-mode state 'normal-mode))
|
||||
(else (insert-char state key))))
|
||||
(if (memq key insertable-characters)
|
||||
(insert-char state key)
|
||||
(case key
|
||||
((backspace)
|
||||
(backward-delete-char state))
|
||||
((delete)
|
||||
(delete-char state))
|
||||
((left)
|
||||
(move-cursor state #:x -1 #:relative? #t))
|
||||
((right)
|
||||
(move-cursor state #:x 1 #:relative? #t))
|
||||
((up)
|
||||
(move-cursor state #:y -1 #:relative? #t))
|
||||
((down)
|
||||
(move-cursor state #:y 1 #:relative? #t))
|
||||
((escape)
|
||||
(set! (mode state) 'normal-mode)))))
|
||||
|
||||
(define (normal-mode-process-input state key)
|
||||
(define win (sloth-state-win state))
|
||||
(define y (getcury win))
|
||||
(define x (getcurx win))
|
||||
(cond
|
||||
((or (eqv? key KEY_LEFT)
|
||||
(eqv? key #\h))
|
||||
(move-cursor state y (- x 1)))
|
||||
((or (eqv? key KEY_RIGHT)
|
||||
(eqv? key #\l))
|
||||
(move-cursor state y (+ x 1)))
|
||||
((or (eqv? key KEY_UP)
|
||||
(eqv? key #\k))
|
||||
(move-cursor state (- y 1) x))
|
||||
((or (eqv? key KEY_DOWN)
|
||||
(eqv? key #\j))
|
||||
(move-cursor state (+ y 1) x))
|
||||
((eqv? key #\n) (next-node state))
|
||||
((eqv? key #\d) (down-node state))
|
||||
((eqv? key #\p) (prev-node state))
|
||||
((eqv? key #\u) (up-node state))
|
||||
((eqv? key #\i) (set-sloth-state-mode state 'insert-mode))
|
||||
((eqv? key #\q)
|
||||
(endwin)
|
||||
(quit))
|
||||
(else state)))
|
||||
(case key
|
||||
((left h) (move-cursor state #:x -1 #:relative? #t))
|
||||
((right l) (move-cursor state #:x 1 #:relative? #t))
|
||||
((up k) (move-cursor state #:y -1 #:relative? #t))
|
||||
((down j) (move-cursor state #:y 1 #:relative? #t))
|
||||
((n) (next-node state))
|
||||
((d) (down-node state))
|
||||
((p) (prev-node state))
|
||||
((u) (up-node state))
|
||||
((i) (set! (mode state) 'insert-mode))
|
||||
((q)
|
||||
(end (get-frontend state))
|
||||
(quit))))
|
||||
|
||||
(define* (get-lines p #:optional (acc '()))
|
||||
(let ((l (get-line p)))
|
||||
(if (eof-object? l)
|
||||
(reverse acc)
|
||||
(get-lines p (cons l acc)))))
|
||||
|
||||
(define (find-file state file)
|
||||
(define win (sloth-state-win state))
|
||||
(define contents "")
|
||||
(when (file-exists? file)
|
||||
(set! contents
|
||||
(call-with-input-file file get-string-all))
|
||||
(addstr win contents)
|
||||
(refresh win)
|
||||
(move win 0 0))
|
||||
(when (and file (file-exists? file))
|
||||
(set! (buffer state)
|
||||
(call-with-input-file file get-lines)))
|
||||
(define scheme-lang (get-ts-language-from-file "libtree-sitter-scheme"
|
||||
"tree_sitter_scheme"))
|
||||
(define scheme-parser (ts-parser-new #:language scheme-lang))
|
||||
(define tree (ts-parser-parse-string scheme-parser
|
||||
#f
|
||||
contents))
|
||||
(set-fields
|
||||
state
|
||||
((sloth-state-tree) tree)
|
||||
((sloth-state-point-node) (or (ts-node-child (ts-tree-root-node tree)
|
||||
0)
|
||||
(ts-tree-root-node tree)))))
|
||||
(define parse-tree (ts-parser-parse-string scheme-parser
|
||||
#f
|
||||
(string-join (buffer state) "\n")))
|
||||
(set! (tree state) parse-tree)
|
||||
(set! (point-node state)
|
||||
(or (ts-node-child (ts-tree-root-node parse-tree)
|
||||
0)
|
||||
(ts-tree-root-node parse-tree))))
|
||||
|
||||
;; These are stubs for now, but they'll get more complex
|
||||
;; as we add features and more processing is needed on updates
|
||||
(define (string-delete-kth s k)
|
||||
(string-append
|
||||
(string-take s k)
|
||||
(string-drop s (1+ k))))
|
||||
|
||||
(define (backward-delete-char state)
|
||||
(define x (getcurx (sloth-state-win state)))
|
||||
(define y (getcury (sloth-state-win state)))
|
||||
(delch (sloth-state-win state) #:y y #:x (- x 1))
|
||||
state)
|
||||
(define buf (buffer state))
|
||||
(define x (curx state))
|
||||
(define y (cury state))
|
||||
(list-set! buf y
|
||||
(string-delete-kth (list-ref buf y) (1- x)))
|
||||
(move-cursor state #:x -1 #:relative? #t))
|
||||
|
||||
(define (delete-char state)
|
||||
(delch (sloth-state-win state))
|
||||
state)
|
||||
(define buf (buffer state))
|
||||
(define x (curx state))
|
||||
(define y (cury state))
|
||||
(list-set! buf y
|
||||
(string-delete-kth (list-ref buf y) x)))
|
||||
|
||||
(define (move-cursor state y x)
|
||||
(move (sloth-state-win state) y x)
|
||||
state)
|
||||
(define* (move-cursor state #:key (x #f) (y #f) (relative? #f))
|
||||
(if x (set! (curx state)
|
||||
(if relative?
|
||||
(+ x (curx state))
|
||||
x)))
|
||||
(if y (set! (cury state)
|
||||
(if relative?
|
||||
(+ y (cury state))
|
||||
y)))
|
||||
(set-cursor-pos (get-frontend state)
|
||||
(curx state)
|
||||
(cury state)))
|
||||
|
||||
(define (string-insert s ch k)
|
||||
(string-append
|
||||
(string-take s k)
|
||||
(string ch)
|
||||
(string-drop s k)))
|
||||
|
||||
(define (insert-char state char)
|
||||
(define x (getcurx (sloth-state-win state)))
|
||||
(define y (getcury (sloth-state-win state)))
|
||||
(insch (sloth-state-win state) (normal char))
|
||||
(move (sloth-state-win state) y (+ x 1))
|
||||
state)
|
||||
(define buf (buffer state))
|
||||
(define x (curx state))
|
||||
(define y (cury state))
|
||||
(list-set! buf y
|
||||
(string-insert (list-ref buf y)
|
||||
(sloth-input-code->insertable-char char)
|
||||
x))
|
||||
(move-cursor state #:x 1 #:relative? #t))
|
||||
|
||||
(define (next-node state)
|
||||
(define target (or (ts-node-next-sibling
|
||||
(sloth-state-point-node state)
|
||||
(point-node state)
|
||||
#t)
|
||||
(false-if-exception
|
||||
(ts-node-next-sibling
|
||||
(ts-node-parent
|
||||
(sloth-state-point-node state))
|
||||
(point-node state))
|
||||
#t))))
|
||||
(if target
|
||||
(let ((point (ts-node-start-point target)))
|
||||
(move (sloth-state-win state)
|
||||
(car point) (cdr point))
|
||||
(set-sloth-state-point-node state target))
|
||||
state))
|
||||
(set! (point-node state) target)
|
||||
(move-cursor state
|
||||
#:y (car point) #:x (cdr point)))))
|
||||
|
||||
(define (prev-node state)
|
||||
(define target (or (ts-node-prev-sibling
|
||||
(sloth-state-point-node state)
|
||||
(point-node state)
|
||||
#t)
|
||||
(ts-node-parent
|
||||
(sloth-state-point-node state))))
|
||||
(point-node state))))
|
||||
(if target
|
||||
(let ((point (ts-node-start-point target)))
|
||||
(move (sloth-state-win state)
|
||||
(car point) (cdr point))
|
||||
(set-sloth-state-point-node state target))
|
||||
state))
|
||||
(set! (point-node state) target)
|
||||
(move-cursor state
|
||||
#:y (car point) #:x (cdr point)))))
|
||||
|
||||
(define (down-node state)
|
||||
(define target (false-if-exception
|
||||
(car (ts-node-childs
|
||||
(sloth-state-point-node state)
|
||||
(point-node state)
|
||||
#t))))
|
||||
(if target
|
||||
(let ((point (ts-node-start-point target)))
|
||||
(move (sloth-state-win state)
|
||||
(car point) (cdr point))
|
||||
(set-sloth-state-point-node state target))
|
||||
state))
|
||||
(set! (point-node state) target)
|
||||
(move-cursor state
|
||||
#:y (car point) #:x (cdr point)))))
|
||||
|
||||
(define (up-node state)
|
||||
(define target (ts-node-parent (sloth-state-point-node state)))
|
||||
(define target (ts-node-parent (point-node state)))
|
||||
(if (and target
|
||||
(not (equal? target (ts-tree-root-node (sloth-state-tree state)))))
|
||||
(not (equal? target (ts-tree-root-node (tree state)))))
|
||||
(let ((point (ts-node-start-point target)))
|
||||
(move (sloth-state-win state)
|
||||
(car point) (cdr point))
|
||||
(set-sloth-state-point-node state target))
|
||||
state))
|
||||
(set! (point-node state) target)
|
||||
(move-cursor state
|
||||
#:y (car point) #:x (cdr point)))))
|
||||
|
|
|
|||
|
|
@ -1,10 +1,362 @@
|
|||
(define-module (sloth interface)
|
||||
#:use-module (ncurses curses)
|
||||
#:export (init-win))
|
||||
#:use-module (ice-9 exceptions)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (rnrs enums)
|
||||
#:use-module (sloth common)
|
||||
#:use-module (sloth ncurses)
|
||||
#:export (insertable-char->sloth-input-code
|
||||
insertable-characters
|
||||
sloth-input-code->insertable-char
|
||||
sloth-input-keys
|
||||
init-frontend))
|
||||
|
||||
(define (init-win)
|
||||
(define win (initscr))
|
||||
(raw!)
|
||||
(noecho!)
|
||||
(keypad! win #t)
|
||||
win)
|
||||
(define sloth-input-keys
|
||||
(make-enumeration
|
||||
'(a b c d e f g h i j k l m n o
|
||||
p q r s t u v w x y z
|
||||
s-a s-b s-c s-d s-e s-f s-g
|
||||
s-h s-i s-j s-k s-l s-m s-n
|
||||
s-o s-p s-q s-r s-s s-t s-u
|
||||
s-v s-w s-x s-y s-z
|
||||
|
||||
one two three four five six seven eight nine zero
|
||||
backtick ! @ hash $ % ^ & * lparen rparen dash _
|
||||
lbrace rbrace lbracket rbracket pipe backslash / ?
|
||||
< > comma dot : semicolon + = apostrophe quote
|
||||
|
||||
c-a c-b c-c c-d c-e c-f c-g c-h
|
||||
c-i c-j c-k c-l c-m c-n c-o c-p
|
||||
c-q c-r c-s c-t c-u c-v c-w c-x
|
||||
c-y c-z
|
||||
|
||||
c-one c-two c-three c-four c-five c-six
|
||||
c-seven c-eight c-nine c-zero
|
||||
c-~ c-backtick c-! @ c-hash c-$ c-%
|
||||
c-^ c-& c-* c-lparen c-rparen c-dash
|
||||
v c-_ c-lbrace c-rbrace c-lbracket c-rbracket
|
||||
c-pipe c-backslash c-/ c-? c-< c->
|
||||
c-comma c-dot c-: c-semicolon c-+ c-=
|
||||
c-apostrophe c-quote
|
||||
|
||||
m-a m-b m-c m-d m-e m-f m-g m-h m-i m-j
|
||||
m-k m-l m-m m-n m-o m-p m-q m-r m-s m-t
|
||||
m-u m-v m-w m-x m-y m-z
|
||||
m-s-a m-s-b m-s-c m-s-d m-s-e
|
||||
m-s-f m-s-g m-s-h m-s-i m-s-j
|
||||
m-s-k m-s-l m-s-m m-s-n m-s-o
|
||||
m-s-p m-s-q m-s-r m-s-s m-s-t
|
||||
m-s-u m-s-v m-s-w m-s-x m-s-y
|
||||
m-s-z
|
||||
|
||||
m-one m-two m-three m-four m-five m-six m-seven
|
||||
m-eight m-nine m-zero
|
||||
m-~ m-backtick m-! @ m-hash m-$ m-% m-^ m-&
|
||||
m-* m-lparen m-rparen m-dash m-_ m-lbrace
|
||||
m-rbrace m-lbracket m-rbracket m-pipe m-backslash
|
||||
m-/ m-? m-< m-> m-comma m-dot m-: m-semicolon m-+ m-=
|
||||
m-apostrophe m-quote
|
||||
|
||||
c-m-a c-m-b c-m-c c-m-d c-m-e
|
||||
c-m-f c-m-g c-m-h c-m-i c-m-j
|
||||
c-m-k c-m-l c-m-m c-m-n c-m-o
|
||||
c-m-p c-m-q c-m-r c-m-s c-m-t
|
||||
c-m-u c-m-v c-m-w c-m-x c-m-y
|
||||
c-m-z
|
||||
c-m-s-a c-m-s-b c-m-s-c c-m-s-d
|
||||
c-m-s-e c-m-s-f c-m-s-g c-m-s-h
|
||||
c-m-s-i c-m-s-j c-m-s-k c-m-s-l
|
||||
c-m-s-m c-m-s-n c-m-s-o c-m-s-p
|
||||
c-m-s-q c-m-s-r c-m-s-s c-m-s-t
|
||||
c-m-s-u c-m-s-v c-m-s-w c-m-s-x
|
||||
c-m-s-y c-m-s-z
|
||||
|
||||
c-m-one c-m-two c-m-three c-m-four c-m-five
|
||||
c-m-six c-m-seven c-m-eight c-m-nine c-m-zero
|
||||
c-m-~ c-m-backtick c-m-! @ c-m-hash c-m-$
|
||||
c-m-% c-m-^ c-m-& c-m-* c-m-lparen
|
||||
c-m-rparen c-m-dash c-m-_ c-m-lbrace c-m-rbrace
|
||||
c-m-lbracket c-m-rbracket c-m-pipe c-m-backslash
|
||||
c-m-/ c-m-? c-m-< c-m-> c-m-comma c-m-dot
|
||||
c-m-: c-m-semicolon c-m-+ c-m-= c-m-apostrophe c-m-quote
|
||||
|
||||
esc home end insert delete page-up page-down print-screen ret
|
||||
backspace tab space
|
||||
f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12
|
||||
left right up down
|
||||
|
||||
s-esc s-home s-end s-insert s-delete
|
||||
s-page-up s-page-down s-print-screen s-ret
|
||||
s-backspace s-tab s-space
|
||||
s-f1 s-f2 s-f3 s-f4 s-f5 s-f6 s-f7
|
||||
s-f8 s-f9 s-f10 s-f11 s-f12
|
||||
s-left s-right s-up s-down
|
||||
|
||||
m-esc m-home m-end m-insert m-delete m-page-up m-page-down
|
||||
m-print-screen m-ret m-backspace m-tab m-space
|
||||
m-f1 m-f2 m-f3 m-f4 m-f5 m-f6 m-f7 m-f8 m-f9 m-f10
|
||||
m-f11 m-f12
|
||||
m-left m-right m-up m-down
|
||||
|
||||
m-s-esc m-s-home m-s-end m-s-insert
|
||||
m-s-delete m-s-page-up m-s-page-down
|
||||
m-s-print-screen m-s-ret m-s-backspace m-s-tab m-s-space
|
||||
m-s-f1 m-s-f2 m-s-f3 m-s-f4 m-s-f5
|
||||
m-s-f6 m-s-f7 m-s-f8 m-s-f9 m-s-f10
|
||||
m-s-f11 m-s-f12
|
||||
m-s-left m-s-right m-s-up m-s-down
|
||||
|
||||
c-esc c-home c-end c-insert c-delete c-page-up
|
||||
c-page-down c-print-screen c-ret c-backspace c-tab c-space
|
||||
c-f1 c-f2 c-f3 c-f4 c-f5 c-f6 c-f7 c-f8 c-f9
|
||||
c-f10 c-f11 c-f12
|
||||
c-left c-right c-up c-down
|
||||
|
||||
c-s-esc c-s-home c-s-end c-s-insert
|
||||
c-s-delete c-s-page-up c-s-page-down
|
||||
c-s-print-screen c-s-ret c-s-backspace
|
||||
c-s-tab
|
||||
c-s-f1 c-s-f2 c-s-f3 c-s-f4 c-s-f5
|
||||
c-s-f6 c-s-f7 c-s-f8 c-s-f9 c-s-f10
|
||||
c-s-f11 c-s-f12
|
||||
c-s-left c-s-right c-s-up c-s-down
|
||||
|
||||
c-m-esc c-m-home c-m-end c-m-insert c-m-delete
|
||||
c-m-page-up c-m-page-down c-m-print-screen c-m-ret
|
||||
c-m-backspace c-m-tab c-m-space
|
||||
c-m-f1 c-m-f2 c-m-f3 c-m-f4 c-m-f5 c-m-f6
|
||||
c-m-f7 c-m-f8 c-m-f9 c-m-f10 c-m-f11 c-m-f12
|
||||
c-m-left c-m-right c-m-up c-m-down
|
||||
|
||||
c-m-s-esc c-m-s-home c-m-s-end
|
||||
c-m-s-insert c-m-s-delete c-m-s-page-up
|
||||
c-m-s-page-down c-m-s-print-screen c-m-s-ret
|
||||
c-m-s-backspace c-m-s-tab c-m-s-space
|
||||
c-m-s-f1 c-m-s-f2 c-m-s-f3 c-m-s-f4
|
||||
c-m-s-f5 c-m-s-f6 c-m-s-f7 c-m-s-f8
|
||||
c-m-s-f9 c-m-s-f10 c-m-s-f11 c-m-s-f12
|
||||
c-m-s-left c-m-s-right c-m-s-up c-m-s-down)))
|
||||
|
||||
(define insertable-characters
|
||||
'(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
|
||||
#\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
|
||||
#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
|
||||
#\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
|
||||
#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
|
||||
#\` #\~ #\! #\@ #\# #\$ #\% #\^ #\& #\* #\( #\) #\- #\_
|
||||
#\= #\+ #\[ #\] #\{ #\} #\| #\\ #\; #\: #\' #\" #\, #\<
|
||||
#\. #\> #\/ #\? #\newline #\space #\tab
|
||||
a b c d e f g h i j k l m n o p q r s t u v w x y z
|
||||
s-a s-b s-c s-d s-e s-f s-g s-h s-i s-j s-k s-l s-m
|
||||
s-n s-o s-p s-q s-r s-s s-t s-u s-v s-w s-x s-y s-z
|
||||
zero one two three four five six seven eight nine
|
||||
backtick ~ ! @ hash $ % ^ & * lparen rparen dash _
|
||||
= + lbracket rbracket lbrace rbrace pipe backslash
|
||||
semicolon : apostrophe quote comma < > dot / ? ret space tab))
|
||||
|
||||
(define (insertable-char->sloth-input-code char)
|
||||
(case char
|
||||
((#\a) 'a)
|
||||
((#\b) 'b)
|
||||
((#\c) 'c)
|
||||
((#\d) 'd)
|
||||
((#\e) 'e)
|
||||
((#\f) 'f)
|
||||
((#\g) 'g)
|
||||
((#\h) 'h)
|
||||
((#\i) 'i)
|
||||
((#\j) 'j)
|
||||
((#\k) 'k)
|
||||
((#\l) 'l)
|
||||
((#\m) 'm)
|
||||
((#\n) 'n)
|
||||
((#\o) 'o)
|
||||
((#\p) 'p)
|
||||
((#\q) 'q)
|
||||
((#\r) 'r)
|
||||
((#\s) 's)
|
||||
((#\t) 't)
|
||||
((#\u) 'u)
|
||||
((#\v) 'v)
|
||||
((#\w) 'w)
|
||||
((#\x) 'x)
|
||||
((#\y) 'y)
|
||||
((#\z) 'z)
|
||||
((#\A) 's-a)
|
||||
((#\B) 's-b)
|
||||
((#\C) 's-c)
|
||||
((#\D) 's-d)
|
||||
((#\E) 's-e)
|
||||
((#\F) 's-f)
|
||||
((#\G) 's-g)
|
||||
((#\H) 's-h)
|
||||
((#\I) 's-i)
|
||||
((#\J) 's-j)
|
||||
((#\K) 's-k)
|
||||
((#\L) 's-l)
|
||||
((#\M) 's-m)
|
||||
((#\N) 's-n)
|
||||
((#\O) 's-o)
|
||||
((#\P) 's-p)
|
||||
((#\Q) 's-q)
|
||||
((#\R) 's-r)
|
||||
((#\S) 's-s)
|
||||
((#\T) 's-t)
|
||||
((#\U) 's-u)
|
||||
((#\V) 's-v)
|
||||
((#\W) 's-w)
|
||||
((#\X) 's-x)
|
||||
((#\Y) 's-y)
|
||||
((#\Z) 's-z)
|
||||
((#\0) 'zero)
|
||||
((#\1) 'one)
|
||||
((#\2) 'two)
|
||||
((#\3) 'three)
|
||||
((#\4) 'four)
|
||||
((#\5) 'five)
|
||||
((#\6) 'six)
|
||||
((#\7) 'seven)
|
||||
((#\8) 'eight)
|
||||
((#\9) 'nine)
|
||||
((#\`) 'backtick)
|
||||
((#\~) '~)
|
||||
((#\!) '!)
|
||||
((#\@) '@)
|
||||
((#\#) 'hash)
|
||||
((#\$) '$)
|
||||
((#\%) '%)
|
||||
((#\^) '^)
|
||||
((#\&) '&)
|
||||
((#\*) '*)
|
||||
((#\() 'lparen)
|
||||
((#\)) 'rparen)
|
||||
((#\-) 'dash)
|
||||
((#\_) '_)
|
||||
((#\=) '=)
|
||||
((#\+) '+)
|
||||
((#\[) 'lbracket)
|
||||
((#\]) 'rbracket)
|
||||
((#\{) 'lbrace)
|
||||
((#\}) 'rbrace)
|
||||
((#\|) 'pipe)
|
||||
((#\\) 'backslash)
|
||||
((#\;) 'semicolon)
|
||||
((#\:) ':)
|
||||
((#\') 'apostrophe)
|
||||
((#\") 'quote)
|
||||
((#\,) 'comma)
|
||||
((#\<) '<)
|
||||
((#\.) 'dot)
|
||||
((#\>) '>)
|
||||
((#\/) '/)
|
||||
((#\?) '?)
|
||||
((#\newline) 'enter)
|
||||
((#\space) 'space)
|
||||
((#\tab) 'tab)))
|
||||
|
||||
(define (sloth-input-code->insertable-char code)
|
||||
(case code
|
||||
((a) #\a)
|
||||
((b) #\b)
|
||||
((c) #\c)
|
||||
((d) #\d)
|
||||
((e) #\e)
|
||||
((f) #\f)
|
||||
((g) #\g)
|
||||
((h) #\h)
|
||||
((i) #\i)
|
||||
((j) #\j)
|
||||
((k) #\k)
|
||||
((l) #\l)
|
||||
((m) #\m)
|
||||
((n) #\n)
|
||||
((o) #\o)
|
||||
((p) #\p)
|
||||
((q) #\q)
|
||||
((r) #\r)
|
||||
((s) #\s)
|
||||
((t) #\t)
|
||||
((u) #\u)
|
||||
((v) #\v)
|
||||
((w) #\w)
|
||||
((x) #\x)
|
||||
((y) #\y)
|
||||
((z) #\z)
|
||||
((s-a) #\A)
|
||||
((s-b) #\B)
|
||||
((s-c) #\C)
|
||||
((s-d) #\D)
|
||||
((s-e) #\E)
|
||||
((s-f) #\F)
|
||||
((s-g) #\G)
|
||||
((s-h) #\H)
|
||||
((s-i) #\I)
|
||||
((s-j) #\J)
|
||||
((s-k) #\K)
|
||||
((s-l) #\L)
|
||||
((s-m) #\M)
|
||||
((s-n) #\N)
|
||||
((s-o) #\O)
|
||||
((s-p) #\P)
|
||||
((s-q) #\Q)
|
||||
((s-r) #\R)
|
||||
((s-s) #\S)
|
||||
((s-t) #\T)
|
||||
((s-u) #\U)
|
||||
((s-v) #\V)
|
||||
((s-w) #\W)
|
||||
((s-x) #\X)
|
||||
((s-y) #\Y)
|
||||
((s-z) #\Z)
|
||||
((zero) #\0)
|
||||
((one) #\1)
|
||||
((two) #\2)
|
||||
((three) #\3)
|
||||
((four) #\4)
|
||||
((five) #\5)
|
||||
((six) #\6)
|
||||
((seven) #\7)
|
||||
((eight) #\8)
|
||||
((nine) #\9)
|
||||
((backtick) #\`)
|
||||
((~) #\~)
|
||||
((!) #\!)
|
||||
((@) #\@)
|
||||
((#\$) '$)
|
||||
((hash) #\#)
|
||||
((%) #\%)
|
||||
((^) #\^)
|
||||
((&) #\&)
|
||||
((*) #\*)
|
||||
((lparen) #\()
|
||||
((rparen) #\))
|
||||
((dash) #\-)
|
||||
((_) #\_)
|
||||
((=) #\=)
|
||||
((+) #\+)
|
||||
((lbracket) #\[)
|
||||
((rbracket) #\])
|
||||
((lbrace) #\{)
|
||||
((rbrace) #\})
|
||||
((pipe) #\|)
|
||||
((backslash) #\\)
|
||||
((semicolon) #\;)
|
||||
((:) #\:)
|
||||
((apostrophe) #\')
|
||||
((quote) #\")
|
||||
((comma) #\,)
|
||||
((<) #\<)
|
||||
((dot) #\.)
|
||||
((>) #\>)
|
||||
((/) #\/)
|
||||
((?) #\?)
|
||||
((enter) #\newline)
|
||||
((space) #\space)
|
||||
((tab) #\tab)))
|
||||
|
||||
(define (init-frontend frontend)
|
||||
(case frontend
|
||||
((ncurses) (init-ncurses))
|
||||
(else (raise-exception
|
||||
(make-exception
|
||||
(make-exception-with-message "Unknown frontend")
|
||||
(make-exception-with-irritants frontend))))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,298 @@
|
|||
(define-module (sloth ncurses)
|
||||
#:use-module (ncurses curses)
|
||||
#:use-module (sloth interface)
|
||||
#:use-module (sloth common)
|
||||
#:use-module (oop goops)
|
||||
#:export (init-ncurses))
|
||||
|
||||
(define-class <ncurses-frontend> (<sloth-frontend>)
|
||||
;; Since writing text in ncurses typically requires setting and moving the
|
||||
;; cursor, our frontend class needs to know where the cursor is supposed to
|
||||
;; be so it can ensure it always gets reset to that point.
|
||||
(curx #:init-value 0 #:accessor curx)
|
||||
(cury #:init-value 0 #:accessor cury))
|
||||
|
||||
(define (init-ncurses)
|
||||
(define win (initscr))
|
||||
(define state (make <ncurses-frontend>
|
||||
#:main-win win))
|
||||
(raw!)
|
||||
(noecho!)
|
||||
(keypad! win #t)
|
||||
state)
|
||||
|
||||
(define (input-waiting? win)
|
||||
(nodelay! win #t)
|
||||
(define result (getch win))
|
||||
(nodelay! win #f)
|
||||
result)
|
||||
|
||||
(define-method (fetch-input (nc <ncurses-frontend>))
|
||||
(let ((ch (getch (get-main-win nc))))
|
||||
(if (memq ch insertable-characters)
|
||||
(insertable-char->sloth-input-code ch)
|
||||
(case ch
|
||||
;; You might note a lack of c-s-[letter], and other input
|
||||
;; options. This is due to terminals being Strange. Try C-A in
|
||||
;; Emacs and it moves to the front of the line while marking,
|
||||
;; a distinct behavior from C-a. Try this in *terminal* Emacs,
|
||||
;; and it doesn't work. In conclusion, terminals are a kludge
|
||||
;; from the days of teletypewriters. If multiple inputs map to
|
||||
;; the same charactes in the terminal, I've just picked
|
||||
;; whichever is first (or seems like it *should* be prior)
|
||||
((#\soh) 'c-a)
|
||||
((#\etx) 'c-c)
|
||||
((#\eot) 'c-d)
|
||||
((#\enq) 'c-e)
|
||||
((#\ack) 'c-f)
|
||||
((#\alarm) 'c-g)
|
||||
((#\vtab) 'c-k)
|
||||
((#\page) 'c-l)
|
||||
((#\so) 'c-n)
|
||||
((#\si) 'c-o)
|
||||
((#\dle) 'c-p)
|
||||
((#\dc1) 'c-q)
|
||||
((#\dc2) 'c-r)
|
||||
((#\dc3) 'c-s)
|
||||
((#\dc4) 'c-t)
|
||||
((#\nak) 'c-u)
|
||||
((#\syn) 'c-v)
|
||||
((#\etb) 'c-w)
|
||||
((#\can) 'c-x)
|
||||
((#\em) 'c-y)
|
||||
((#\sub) 'c-z)
|
||||
((#\nul) 'c-backtick)
|
||||
((#\rs) 'c-~)
|
||||
((#\fs) 'c-four)
|
||||
((#\gs) 'c-five)
|
||||
((#\us) 'c-seven)
|
||||
((258) 'down)
|
||||
((259) 'up)
|
||||
((260) 'left)
|
||||
((261) 'right)
|
||||
((262) 'home)
|
||||
((263) 'backspace)
|
||||
((265) 'f1)
|
||||
((266) 'f2)
|
||||
((267) 'f3)
|
||||
((268) 'f4)
|
||||
((269) 'f5)
|
||||
((270) 'f6)
|
||||
((271) 'f7)
|
||||
((272) 'f8)
|
||||
((273) 'f9)
|
||||
((274) 'f10)
|
||||
((275) 'f11)
|
||||
((276) 'f12)
|
||||
((277) 's-f1)
|
||||
((278) 's-f2)
|
||||
((279) 's-f3)
|
||||
((280) 's-f4)
|
||||
((281) 's-f5)
|
||||
((282) 's-f6)
|
||||
((283) 's-f7)
|
||||
((284) 's-f8)
|
||||
((285) 's-f9)
|
||||
((286) 's-f10)
|
||||
((287) 's-f11)
|
||||
((288) 's-f12)
|
||||
((289) 'c-f1)
|
||||
((290) 'c-f2)
|
||||
((291) 'c-f3)
|
||||
((292) 'c-f4)
|
||||
((293) 'c-f5)
|
||||
((294) 'c-f6)
|
||||
((295) 'c-f7)
|
||||
((296) 'c-f8)
|
||||
((297) 'c-f9)
|
||||
((298) 'c-f10)
|
||||
((299) 'c-f11)
|
||||
((300) 'c-f12)
|
||||
((301) 'c-s-f1)
|
||||
((302) 'c-s-f2)
|
||||
((303) 'c-s-f3)
|
||||
((304) 'c-s-f4)
|
||||
((305) 'c-s-f5)
|
||||
((306) 'c-s-f6)
|
||||
((307) 'c-s-f7)
|
||||
((308) 'c-s-f8)
|
||||
((309) 'c-s-f9)
|
||||
((310) 'c-s-f10)
|
||||
((311) 'c-s-f11)
|
||||
((312) 'c-s-f12)
|
||||
((313) 'm-f1)
|
||||
((314) 'm-f2)
|
||||
((315) 'm-f3)
|
||||
((316) 'm-f4)
|
||||
((317) 'm-f5)
|
||||
((318) 'm-f6)
|
||||
((319) 'm-f7)
|
||||
((320) 'm-f8)
|
||||
((321) 'm-f9)
|
||||
((322) 'm-f10)
|
||||
((323) 'm-f11)
|
||||
((324) 'm-f12)
|
||||
((330) 'delete)
|
||||
((331) 'insert)
|
||||
((336) 's-down)
|
||||
((337) 's-up)
|
||||
((360) 'end)
|
||||
((383) 's-delete)
|
||||
((386) 's-end)
|
||||
((391) 's-home)
|
||||
((393) 's-left)
|
||||
((512) 'm-delete)
|
||||
((513) 'c-delete)
|
||||
((516) 'c-m-delete)
|
||||
((518) 'm-down)
|
||||
((519) 'm-s-down)
|
||||
((520) 'c-down)
|
||||
((521) 'c-s-down)
|
||||
((522) 'c-m-down)
|
||||
((523) 'm-end)
|
||||
((525) 'c-end)
|
||||
((527) 'c-m-end)
|
||||
((528) 'm-home)
|
||||
((530) 'c-home)
|
||||
((532) 'c-m-home)
|
||||
((533) 'm-insert)
|
||||
((535) 'c-insert)
|
||||
((537) 'c-m-insert)
|
||||
((538) 'm-left)
|
||||
((539) 'm-s-left)
|
||||
((540) 'c-left)
|
||||
((541) 'c-s-left)
|
||||
((542) 'c-m-left)
|
||||
((553) 'm-right)
|
||||
((554) 'm-s-right)
|
||||
((555) 'c-right)
|
||||
((556) 'c-s-right)
|
||||
((557) 'c-m-right)
|
||||
((559) 'm-up)
|
||||
((560) 'm-s-up)
|
||||
((561) 'c-up)
|
||||
((562) 'c-s-up)
|
||||
((563) 'c-m-up)
|
||||
;; TODO: M-characters. Most of the time this is ESC
|
||||
;; immediately followed by the character, so M-6 is ESC 6.
|
||||
;; So when we see ESC we need to check if there's another
|
||||
;; character waiting, and if there is then it's M-[char],
|
||||
;; and otherwise it's just ESC.
|
||||
((#\esc)
|
||||
(let ((more? (input-waiting? (get-main-win nc))))
|
||||
(if (not more?)
|
||||
'escape
|
||||
(case more?
|
||||
((#f) 'escape)
|
||||
((#\a) 'm-a)
|
||||
((#\b) 'm-b)
|
||||
((#\c) 'm-c)
|
||||
((#\d) 'm-d)
|
||||
((#\e) 'm-e)
|
||||
((#\f) 'm-f)
|
||||
((#\g) 'm-g)
|
||||
((#\h) 'm-h)
|
||||
((#\i) 'm-i)
|
||||
((#\j) 'm-j)
|
||||
((#\k) 'm-k)
|
||||
((#\l) 'm-l)
|
||||
((#\m) 'm-m)
|
||||
((#\n) 'm-n)
|
||||
((#\o) 'm-o)
|
||||
((#\p) 'm-p)
|
||||
((#\q) 'm-q)
|
||||
((#\r) 'm-r)
|
||||
((#\s) 'm-s)
|
||||
((#\t) 'm-t)
|
||||
((#\u) 'm-u)
|
||||
((#\v) 'm-v)
|
||||
((#\w) 'm-w)
|
||||
((#\x) 'm-x)
|
||||
((#\y) 'm-y)
|
||||
((#\z) 'm-z)
|
||||
((#\A) 'm-s-a)
|
||||
((#\B) 'm-s-b)
|
||||
((#\C) 'm-s-c)
|
||||
((#\D) 'm-s-d)
|
||||
((#\E) 'm-s-e)
|
||||
((#\F) 'm-s-f)
|
||||
((#\G) 'm-s-g)
|
||||
((#\H) 'm-s-h)
|
||||
((#\I) 'm-s-i)
|
||||
((#\J) 'm-s-j)
|
||||
((#\K) 'm-s-k)
|
||||
((#\L) 'm-s-l)
|
||||
((#\M) 'm-s-m)
|
||||
((#\N) 'm-s-n)
|
||||
((#\O) 'm-s-o)
|
||||
((#\P) 'm-s-p)
|
||||
((#\Q) 'm-s-q)
|
||||
((#\R) 'm-s-r)
|
||||
((#\S) 'm-s-s)
|
||||
((#\T) 'm-s-t)
|
||||
((#\U) 'm-s-u)
|
||||
((#\V) 'm-s-v)
|
||||
((#\W) 'm-s-w)
|
||||
((#\X) 'm-s-x)
|
||||
((#\Y) 'm-s-y)
|
||||
((#\Z) 'm-s-z)
|
||||
((#\0) 'm-zero)
|
||||
((#\1) 'm-one)
|
||||
((#\2) 'm-two)
|
||||
((#\3) 'm-three)
|
||||
((#\4) 'm-four)
|
||||
((#\5) 'm-five)
|
||||
((#\6) 'm-six)
|
||||
((#\7) 'm-seven)
|
||||
((#\8) 'm-eight)
|
||||
((#\9) 'm-nine)
|
||||
((#\`) 'm-backtick)
|
||||
((#\~) 'm-~)
|
||||
((#\!) 'm-!)
|
||||
((#\@) 'm-@)
|
||||
((#\$) 'm-$)
|
||||
((#\%) 'm-%)
|
||||
((#\^) 'm-^)
|
||||
((#\&) 'm-&)
|
||||
((#\*) 'm-*)
|
||||
((#\() 'm-lparen)
|
||||
((#\)) 'm-rparen)
|
||||
((#\-) 'm-dash)
|
||||
((#\_) 'm-_)
|
||||
((#\=) 'm-=)
|
||||
((#\+) 'm-+)
|
||||
((#\[) 'm-lbracket)
|
||||
((#\]) 'm-rbracket)
|
||||
((#\{) 'm-lbrace)
|
||||
((#\}) 'm-rbrace)
|
||||
((#\\) 'm-backslash)
|
||||
((#\|) 'm-pipe)
|
||||
((#\;) 'm-semicolon)
|
||||
((#\:) 'm-:)
|
||||
((#\') 'm-apostrophe)
|
||||
((#\") 'm-quote)
|
||||
((#\,) 'm-comma)
|
||||
((#\<) 'm-<)
|
||||
((#\.) 'm-dot)
|
||||
((#\>) 'm->)
|
||||
((#\/) 'm-/)
|
||||
((#\?) 'm-?)))))))))
|
||||
|
||||
(define-method (set-cursor-pos (nc <ncurses-frontend>) x y)
|
||||
(set! (curx nc) x)
|
||||
(set! (cury nc) y)
|
||||
(move (get-main-win nc) y x))
|
||||
|
||||
(define-method (end (nc <ncurses-frontend>))
|
||||
(endwin)
|
||||
(quit))
|
||||
|
||||
(define-method (write-buffer (nc <ncurses-frontend>) buffer lines-scrolled)
|
||||
(define win (get-main-win nc))
|
||||
(erase win)
|
||||
(do ((i 0 (1+ i)))
|
||||
((> i (lines)))
|
||||
(addstr win (list-ref buffer (+ i lines-scrolled))
|
||||
#:y i #:x 0))
|
||||
(move win (cury nc) (curx nc))
|
||||
(refresh win))
|
||||
Loading…
Reference in New Issue