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)
|
(dependencies `(("guile-config" ,guile-config)
|
||||||
("guile-ncurses" ,guile-ncurses)
|
("guile-ncurses" ,guile-ncurses)
|
||||||
("guile-ts" ,guile-ts)
|
("guile-ts" ,guile-ts)
|
||||||
("tree-sitter-bash" ,tree-sitter-bash)
|
("tree-sitter-bash" ,tree-sitter-bash)
|
||||||
("tree-sitter-bibtex" ,tree-sitter-bibtex)
|
("tree-sitter-bibtex" ,tree-sitter-bibtex)
|
||||||
("tree-sitter-c" ,tree-sitter-c)
|
("tree-sitter-c" ,tree-sitter-c)
|
||||||
("tree-sitter-c-sharp" ,tree-sitter-c-sharp)
|
("tree-sitter-c-sharp" ,tree-sitter-c-sharp)
|
||||||
("tree-sitter-clojure" ,tree-sitter-clojure)
|
("tree-sitter-clojure" ,tree-sitter-clojure)
|
||||||
("tree-sitter-cmake" ,tree-sitter-cmake)
|
("tree-sitter-cmake" ,tree-sitter-cmake)
|
||||||
("tree-sitter-cpp" ,tree-sitter-cpp)
|
("tree-sitter-cpp" ,tree-sitter-cpp)
|
||||||
("tree-sitter-css" ,tree-sitter-css)
|
("tree-sitter-css" ,tree-sitter-css)
|
||||||
("tree-sitter-dockerfile" ,tree-sitter-dockerfile)
|
("tree-sitter-dockerfile" ,tree-sitter-dockerfile)
|
||||||
("tree-sitter-elixir" ,tree-sitter-elixir)
|
("tree-sitter-elixir" ,tree-sitter-elixir)
|
||||||
("tree-sitter-elm" ,tree-sitter-elm)
|
("tree-sitter-elm" ,tree-sitter-elm)
|
||||||
("tree-sitter-go" ,tree-sitter-go)
|
("tree-sitter-go" ,tree-sitter-go)
|
||||||
("tree-sitter-gomod" ,tree-sitter-gomod)
|
("tree-sitter-gomod" ,tree-sitter-gomod)
|
||||||
("tree-sitter-haskell" ,tree-sitter-haskell)
|
("tree-sitter-haskell" ,tree-sitter-haskell)
|
||||||
("tree-sitter-heex" ,tree-sitter-heex)
|
("tree-sitter-heex" ,tree-sitter-heex)
|
||||||
("tree-sitter-html" ,tree-sitter-html)
|
("tree-sitter-html" ,tree-sitter-html)
|
||||||
("tree-sitter-java" ,tree-sitter-java)
|
("tree-sitter-java" ,tree-sitter-java)
|
||||||
("tree-sitter-javascript" ,tree-sitter-javascript)
|
("tree-sitter-javascript" ,tree-sitter-javascript)
|
||||||
("tree-sitter-json" ,tree-sitter-json)
|
("tree-sitter-json" ,tree-sitter-json)
|
||||||
("tree-sitter-julia" ,tree-sitter-julia)
|
("tree-sitter-julia" ,tree-sitter-julia)
|
||||||
("tree-sitter-lua" ,tree-sitter-lua)
|
("tree-sitter-lua" ,tree-sitter-lua)
|
||||||
("tree-sitter-markdown" ,tree-sitter-markdown)
|
("tree-sitter-markdown" ,tree-sitter-markdown)
|
||||||
("tree-sitter-markdown-gfm" ,tree-sitter-markdown-gfm)
|
("tree-sitter-markdown-gfm" ,tree-sitter-markdown-gfm)
|
||||||
("tree-sitter-meson" ,tree-sitter-meson)
|
("tree-sitter-meson" ,tree-sitter-meson)
|
||||||
("tree-sitter-ocaml" ,tree-sitter-ocaml)
|
("tree-sitter-ocaml" ,tree-sitter-ocaml)
|
||||||
("tree-sitter-org" ,tree-sitter-org)
|
("tree-sitter-org" ,tree-sitter-org)
|
||||||
("tree-sitter-php" ,tree-sitter-php)
|
("tree-sitter-php" ,tree-sitter-php)
|
||||||
("tree-sitter-plantuml" ,tree-sitter-plantuml)
|
("tree-sitter-plantuml" ,tree-sitter-plantuml)
|
||||||
("tree-sitter-python" ,tree-sitter-python)
|
("tree-sitter-python" ,tree-sitter-python)
|
||||||
("tree-sitter-r" ,tree-sitter-r)
|
("tree-sitter-r" ,tree-sitter-r)
|
||||||
("tree-sitter-racket" ,tree-sitter-racket)
|
("tree-sitter-racket" ,tree-sitter-racket)
|
||||||
("tree-sitter-ruby" ,tree-sitter-ruby)
|
("tree-sitter-ruby" ,tree-sitter-ruby)
|
||||||
("tree-sitter-rust" ,tree-sitter-rust)
|
("tree-sitter-rust" ,tree-sitter-rust)
|
||||||
("tree-sitter-scala" ,tree-sitter-scala)
|
("tree-sitter-scala" ,tree-sitter-scala)
|
||||||
("tree-sitter-scheme" ,tree-sitter-scheme)
|
("tree-sitter-scheme" ,tree-sitter-scheme)
|
||||||
("tree-sitter-typescript" ,tree-sitter-typescript)))
|
("tree-sitter-typescript" ,tree-sitter-typescript)))
|
||||||
(skip ())
|
(skip ())
|
||||||
(files (libraries
|
(files (libraries
|
||||||
((directory "sloth" ((scheme-file "editor")
|
((directory "sloth" ((scheme-file "common")
|
||||||
(scheme-file "interface")))))
|
(scheme-file "editor")
|
||||||
|
(scheme-file "interface")
|
||||||
|
(scheme-file "ncurses")))))
|
||||||
(tests ((directory "tests" ())))
|
(tests ((directory "tests" ())))
|
||||||
(programs
|
(programs
|
||||||
((directory "scripts" ((in-file "sloth")))))
|
((directory "scripts" ((in-file "sloth")))))
|
||||||
(documentation
|
(documentation
|
||||||
((directory "doc" ((texi-file "sloth")))
|
((directory "doc" ((texi-file "sloth")))
|
||||||
(text-file "LICENSE")
|
(text-file "LICENSE")
|
||||||
(symlink "README" "README.org")
|
(symlink "README" "README.org")
|
||||||
(org-file "README")))
|
(org-file "README")))
|
||||||
(infrastructure
|
(infrastructure
|
||||||
((text-file ".gitignore")
|
((text-file ".gitignore")
|
||||||
(text-file "zhu-li")
|
(scheme-file "guix")
|
||||||
(scheme-file "guix")
|
(scheme-file "hall")
|
||||||
(scheme-file "hall")
|
(scheme-file "manifest")))))
|
||||||
(scheme-file "manifest")))))
|
|
||||||
|
|
|
@ -45,7 +45,7 @@
|
||||||
"(Listof String) -> Int
|
"(Listof String) -> Int
|
||||||
program entrypoint; handle commandline args and call appropriate procedures"
|
program entrypoint; handle commandline args and call appropriate procedures"
|
||||||
(define options (getopt-config-auto args %configuration))
|
(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:
|
;;; Local Variables:
|
||||||
;;; mode: scheme
|
;;; 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)
|
(define-module (sloth editor)
|
||||||
#:use-module (sloth interface)
|
|
||||||
#:use-module (ncurses curses)
|
|
||||||
#:use-module (ts)
|
|
||||||
#:use-module (ice-9 textual-ports)
|
#: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))
|
#:export (start-loop))
|
||||||
|
|
||||||
(define-immutable-record-type <sloth-state>
|
(define-class <sloth-state> ()
|
||||||
(make-sloth-state win mode tree point-node)
|
(frontend #:init-keyword #:frontend #:getter get-frontend)
|
||||||
sloth-state?
|
(mode #:init-value 'normal-mode #:accessor mode)
|
||||||
(win sloth-state-win)
|
(buffer #:init-value '("") #:accessor buffer)
|
||||||
(mode sloth-state-mode set-sloth-state-mode)
|
(tree #:accessor tree)
|
||||||
(tree sloth-state-tree set-sloth-state-tree)
|
(point-node #:accessor point-node)
|
||||||
(point-node sloth-state-point-node set-sloth-state-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* (start-loop frontend #:optional (file #f))
|
||||||
(define state (make-sloth-state (init-win) 'normal-mode #f #f))
|
(define state (make <sloth-state>
|
||||||
(if file
|
#:frontend frontend))
|
||||||
(core-loop (find-file state file))
|
(find-file state file)
|
||||||
(core-loop state)))
|
(write-buffer (get-frontend state)
|
||||||
|
(buffer state)
|
||||||
|
(lines-scrolled state))
|
||||||
|
(core-loop state))
|
||||||
|
|
||||||
(define (core-loop state)
|
(define (core-loop state)
|
||||||
(define win (sloth-state-win state))
|
(case (mode state)
|
||||||
(define mode (sloth-state-mode state))
|
((normal-mode)
|
||||||
(define new-state
|
(normal-mode-process-input state
|
||||||
(case mode
|
(fetch-input (get-frontend state))))
|
||||||
((normal-mode) (normal-mode-process-input state (getch win)))
|
((insert-mode)
|
||||||
((insert-mode) (insert-mode-process-input state (getch win)))))
|
(insert-mode-process-input state
|
||||||
(core-loop new-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 (insert-mode-process-input state key)
|
||||||
(define y (getcury (sloth-state-win state)))
|
(if (memq key insertable-characters)
|
||||||
(define x (getcurx (sloth-state-win state)))
|
(insert-char state key)
|
||||||
(cond
|
(case key
|
||||||
((eqv? key KEY_BACKSPACE)
|
((backspace)
|
||||||
(backward-delete-char state))
|
(backward-delete-char state))
|
||||||
((eqv? key KEY_DC)
|
((delete)
|
||||||
(delete-char state))
|
(delete-char state))
|
||||||
((eqv? key KEY_LEFT)
|
((left)
|
||||||
(move-cursor state y (- x 1)))
|
(move-cursor state #:x -1 #:relative? #t))
|
||||||
((eqv? key KEY_RIGHT)
|
((right)
|
||||||
(move-cursor state y (+ x 1)))
|
(move-cursor state #:x 1 #:relative? #t))
|
||||||
((eqv? key KEY_UP)
|
((up)
|
||||||
(move-cursor state (- y 1) x))
|
(move-cursor state #:y -1 #:relative? #t))
|
||||||
((eqv? key KEY_DOWN)
|
((down)
|
||||||
(move-cursor state (+ y 1) x))
|
(move-cursor state #:y 1 #:relative? #t))
|
||||||
((eqv? key #\esc)
|
((escape)
|
||||||
(set-sloth-state-mode state 'normal-mode))
|
(set! (mode state) 'normal-mode)))))
|
||||||
(else (insert-char state key))))
|
|
||||||
|
|
||||||
(define (normal-mode-process-input state key)
|
(define (normal-mode-process-input state key)
|
||||||
(define win (sloth-state-win state))
|
(case key
|
||||||
(define y (getcury win))
|
((left h) (move-cursor state #:x -1 #:relative? #t))
|
||||||
(define x (getcurx win))
|
((right l) (move-cursor state #:x 1 #:relative? #t))
|
||||||
(cond
|
((up k) (move-cursor state #:y -1 #:relative? #t))
|
||||||
((or (eqv? key KEY_LEFT)
|
((down j) (move-cursor state #:y 1 #:relative? #t))
|
||||||
(eqv? key #\h))
|
((n) (next-node state))
|
||||||
(move-cursor state y (- x 1)))
|
((d) (down-node state))
|
||||||
((or (eqv? key KEY_RIGHT)
|
((p) (prev-node state))
|
||||||
(eqv? key #\l))
|
((u) (up-node state))
|
||||||
(move-cursor state y (+ x 1)))
|
((i) (set! (mode state) 'insert-mode))
|
||||||
((or (eqv? key KEY_UP)
|
((q)
|
||||||
(eqv? key #\k))
|
(end (get-frontend state))
|
||||||
(move-cursor state (- y 1) x))
|
(quit))))
|
||||||
((or (eqv? key KEY_DOWN)
|
|
||||||
(eqv? key #\j))
|
(define* (get-lines p #:optional (acc '()))
|
||||||
(move-cursor state (+ y 1) x))
|
(let ((l (get-line p)))
|
||||||
((eqv? key #\n) (next-node state))
|
(if (eof-object? l)
|
||||||
((eqv? key #\d) (down-node state))
|
(reverse acc)
|
||||||
((eqv? key #\p) (prev-node state))
|
(get-lines p (cons l acc)))))
|
||||||
((eqv? key #\u) (up-node state))
|
|
||||||
((eqv? key #\i) (set-sloth-state-mode state 'insert-mode))
|
|
||||||
((eqv? key #\q)
|
|
||||||
(endwin)
|
|
||||||
(quit))
|
|
||||||
(else state)))
|
|
||||||
|
|
||||||
(define (find-file state file)
|
(define (find-file state file)
|
||||||
(define win (sloth-state-win state))
|
(when (and file (file-exists? file))
|
||||||
(define contents "")
|
(set! (buffer state)
|
||||||
(when (file-exists? file)
|
(call-with-input-file file get-lines)))
|
||||||
(set! contents
|
|
||||||
(call-with-input-file file get-string-all))
|
|
||||||
(addstr win contents)
|
|
||||||
(refresh win)
|
|
||||||
(move win 0 0))
|
|
||||||
(define scheme-lang (get-ts-language-from-file "libtree-sitter-scheme"
|
(define scheme-lang (get-ts-language-from-file "libtree-sitter-scheme"
|
||||||
"tree_sitter_scheme"))
|
"tree_sitter_scheme"))
|
||||||
(define scheme-parser (ts-parser-new #:language scheme-lang))
|
(define scheme-parser (ts-parser-new #:language scheme-lang))
|
||||||
(define tree (ts-parser-parse-string scheme-parser
|
(define parse-tree (ts-parser-parse-string scheme-parser
|
||||||
#f
|
#f
|
||||||
contents))
|
(string-join (buffer state) "\n")))
|
||||||
(set-fields
|
(set! (tree state) parse-tree)
|
||||||
state
|
(set! (point-node state)
|
||||||
((sloth-state-tree) tree)
|
(or (ts-node-child (ts-tree-root-node parse-tree)
|
||||||
((sloth-state-point-node) (or (ts-node-child (ts-tree-root-node tree)
|
0)
|
||||||
0)
|
(ts-tree-root-node parse-tree))))
|
||||||
(ts-tree-root-node tree)))))
|
|
||||||
|
|
||||||
;; These are stubs for now, but they'll get more complex
|
(define (string-delete-kth s k)
|
||||||
;; as we add features and more processing is needed on updates
|
(string-append
|
||||||
|
(string-take s k)
|
||||||
|
(string-drop s (1+ k))))
|
||||||
|
|
||||||
(define (backward-delete-char state)
|
(define (backward-delete-char state)
|
||||||
(define x (getcurx (sloth-state-win state)))
|
(define buf (buffer state))
|
||||||
(define y (getcury (sloth-state-win state)))
|
(define x (curx state))
|
||||||
(delch (sloth-state-win state) #:y y #:x (- x 1))
|
(define y (cury state))
|
||||||
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)
|
(define (delete-char state)
|
||||||
(delch (sloth-state-win state))
|
(define buf (buffer state))
|
||||||
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)
|
(define* (move-cursor state #:key (x #f) (y #f) (relative? #f))
|
||||||
(move (sloth-state-win state) y x)
|
(if x (set! (curx state)
|
||||||
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 (insert-char state char)
|
||||||
(define x (getcurx (sloth-state-win state)))
|
(define buf (buffer state))
|
||||||
(define y (getcury (sloth-state-win state)))
|
(define x (curx state))
|
||||||
(insch (sloth-state-win state) (normal char))
|
(define y (cury state))
|
||||||
(move (sloth-state-win state) y (+ x 1))
|
(list-set! buf y
|
||||||
state)
|
(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 (next-node state)
|
||||||
(define target (or (ts-node-next-sibling
|
(define target (or (ts-node-next-sibling
|
||||||
(sloth-state-point-node state)
|
(point-node state)
|
||||||
#t)
|
#t)
|
||||||
(false-if-exception
|
(false-if-exception
|
||||||
(ts-node-next-sibling
|
(ts-node-next-sibling
|
||||||
(ts-node-parent
|
(ts-node-parent
|
||||||
(sloth-state-point-node state))
|
(point-node state))
|
||||||
#t))))
|
#t))))
|
||||||
(if target
|
(if target
|
||||||
(let ((point (ts-node-start-point target)))
|
(let ((point (ts-node-start-point target)))
|
||||||
(move (sloth-state-win state)
|
(set! (point-node state) target)
|
||||||
(car point) (cdr point))
|
(move-cursor state
|
||||||
(set-sloth-state-point-node state target))
|
#:y (car point) #:x (cdr point)))))
|
||||||
state))
|
|
||||||
|
|
||||||
(define (prev-node state)
|
(define (prev-node state)
|
||||||
(define target (or (ts-node-prev-sibling
|
(define target (or (ts-node-prev-sibling
|
||||||
(sloth-state-point-node state)
|
(point-node state)
|
||||||
#t)
|
#t)
|
||||||
(ts-node-parent
|
(ts-node-parent
|
||||||
(sloth-state-point-node state))))
|
(point-node state))))
|
||||||
(if target
|
(if target
|
||||||
(let ((point (ts-node-start-point target)))
|
(let ((point (ts-node-start-point target)))
|
||||||
(move (sloth-state-win state)
|
(set! (point-node state) target)
|
||||||
(car point) (cdr point))
|
(move-cursor state
|
||||||
(set-sloth-state-point-node state target))
|
#:y (car point) #:x (cdr point)))))
|
||||||
state))
|
|
||||||
|
|
||||||
(define (down-node state)
|
(define (down-node state)
|
||||||
(define target (false-if-exception
|
(define target (false-if-exception
|
||||||
(car (ts-node-childs
|
(car (ts-node-childs
|
||||||
(sloth-state-point-node state)
|
(point-node state)
|
||||||
#t))))
|
#t))))
|
||||||
(if target
|
(if target
|
||||||
(let ((point (ts-node-start-point target)))
|
(let ((point (ts-node-start-point target)))
|
||||||
(move (sloth-state-win state)
|
(set! (point-node state) target)
|
||||||
(car point) (cdr point))
|
(move-cursor state
|
||||||
(set-sloth-state-point-node state target))
|
#:y (car point) #:x (cdr point)))))
|
||||||
state))
|
|
||||||
|
|
||||||
(define (up-node state)
|
(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
|
(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)))
|
(let ((point (ts-node-start-point target)))
|
||||||
(move (sloth-state-win state)
|
(set! (point-node state) target)
|
||||||
(car point) (cdr point))
|
(move-cursor state
|
||||||
(set-sloth-state-point-node state target))
|
#:y (car point) #:x (cdr point)))))
|
||||||
state))
|
|
||||||
|
|
|
@ -1,10 +1,362 @@
|
||||||
(define-module (sloth interface)
|
(define-module (sloth interface)
|
||||||
#:use-module (ncurses curses)
|
#:use-module (ice-9 exceptions)
|
||||||
#:export (init-win))
|
#: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 sloth-input-keys
|
||||||
(define win (initscr))
|
(make-enumeration
|
||||||
(raw!)
|
'(a b c d e f g h i j k l m n o
|
||||||
(noecho!)
|
p q r s t u v w x y z
|
||||||
(keypad! win #t)
|
s-a s-b s-c s-d s-e s-f s-g
|
||||||
win)
|
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