arthur/beluga
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 7 Wiki Activity

Add prefix feature
Build project / build (push) Successful in 56s
Details

Browse Source
This commit is contained in:
Arthur Barraux
2026-01-09 14:54:07 +01:00
parent 410f382592
commit 815114923d
10 changed files with 491 additions and 373 deletions
Download Patch File Download Diff File Expand all files Collapse all files
config/init.lisp
+36 -20
View File
@@ -17,6 +17,7 @@
)
)
(define (char-between ch lo hi)
(if (char>=? ch lo)
(char<=? ch hi)
@@ -33,11 +34,11 @@
#f)))
#f))
(define (word-char-p ch)
(if (alphanumericp ch)
#t
(char= ch #\_)))
#f))
(define editor-move-to-end-of-word (lambda () (
(if (word-char-p (editor-read-char))
@@ -46,23 +47,38 @@
))
))
(define enter-and-tab
(lambda ()
(editor-insert-new-line)
(let ((is-in (move-cursor "up")))
(do ((ch (editor-read-char) (editor-read-char)))
((and (not (char=? ch #\space)) is-in) #f)
(move-cursor "down")
(editor-insert-char " ")
(set! is-in (move-cursor "up")))
(move-cursor "down"))))
;; KEY MAPPING
(add-prefix "user")
(map-key "CTRL-q" editor-quit)
(map-key "CTRL-d" editor-save)
(map-key "ARROW-UP" '(move-cursor "up"))
(map-key "ARROW-DOWN" '(move-cursor "down"))
(map-key "ARROW-RIGHT" '(move-cursor "right"))
(map-key "ARROW-LEFT" '(move-cursor "left"))
(map-key "ENTER" editor-insert-new-line)
(map-key "CTRL-a" move-cursor-beg-line)
(map-key "CTRL-e" move-cursor-end-line)
(map-key "BACKSPACE" editor-delete-previous-char)
(map-key "DEL" editor-delete-next-char)
(map-key "PAGE-UP" move-cursor-page-up)
(map-key "PAGE-DOWN" move-cursor-page-down)
(map-key "CTRL-o" editor-open-file)
(map-key "CTRL-k" editor-del-row)
(map-key "CTRL-s" editor-find)
(map-key "CTRL-r" editor-move-to-end-of-word)
(map-key "CTRL-x" '(editor-set-prefix "user") "no-prefix")
(map-key "CTRL-g" '(editor-set-prefix "no-prefix") "user")
(map-key "CTRL-c" editor-quit "user")
(map-key "CTRL-s" editor-save "user")
(map-key "ARROW-UP" '(move-cursor "up") "no-prefix")
(map-key "ARROW-DOWN" '(move-cursor "down") "no-prefix")
(map-key "ARROW-RIGHT" '(move-cursor "right") "no-prefix")
(map-key "ARROW-LEFT" '(move-cursor "left") "no-prefix")
(map-key "ENTER" enter-and-tab "no-prefix")
(map-key "CTRL-a" move-cursor-beg-line "no-prefix")
(map-key "CTRL-e" move-cursor-end-line "no-prefix")
(map-key "BACKSPACE" editor-delete-previous-char "no-prefix")
(map-key "DEL" editor-delete-next-char "no-prefix")
(map-key "PAGE-UP" move-cursor-page-up "no-prefix")
(map-key "PAGE-DOWN" move-cursor-page-down "no-prefix")
(map-key "f" editor-open-file "user")
(map-key "TAB" editor-insert-tab "no-prefix")
(map-key "CTRL-k" editor-del-row "no-prefix")
(map-key "CTRL-s" editor-find "no-prefix")
(map-key "CTRL-r" editor-move-to-end-of-word "no-prefix")
include/builtins.h
+8
View File
@@ -19,6 +19,8 @@ Lisp moveCursorBeginLine(Lisp args, LispError *e, LispContext ctx);
Lisp moveCursorEndLine(Lisp args, LispError *e, LispContext ctx);
Lisp l_editorInserTab(Lisp args, LispError *e, LispContext ctx);
Lisp deletePreviousChar(Lisp args, LispError *e, LispContext ctx);
Lisp editorMoveCursorPageUp(Lisp args, LispError* e, LispContext ctx);
@@ -37,4 +39,10 @@ Lisp editorFind_L(Lisp args, LispError *e, LispContext ctx);
Lisp editorReadChar_L(Lisp args, LispError *e, LispContext ctx);
Lisp editorSetPrefix(Lisp args, LispError *e, LispContext ctx);
Lisp editorPrefix(Lisp args, LispError *e, LispContext ctx);
void free_structs(void);
#endif
include/data.h
+10
View File
@@ -31,8 +31,14 @@ struct const_t {
int QUIT_TIMES;
};
struct prefix_t {
char prefix_name[64];
int prefix_id;
};
struct keyBind_t {
char *key_sequence;
int prefix_id;
Lisp command;
};
@@ -53,6 +59,7 @@ struct editorConfig {
int dirty;
char *filename;
enum editorStatus_e state;
int prefix_state;
char status_msg[80];
time_t status_msg_time;
struct termios orig_termios; /**< Terminal communication interface */
@@ -69,6 +76,9 @@ struct editorConfig {
struct keyBind_t* key_binds;
int number_of_keybinds;
struct prefix_t* prefix;
int number_of_prefix;
};
/**
include/input.h
+1 -1
View File
@@ -24,7 +24,7 @@ char *editorPrompt(char *prompt, char * PlaceHolder, char bPathMode);
char *key_to_string(int key);
void editorMoveCursor(int key);
int editorMoveCursor(int key);
int executeKeyBind(char *key_sequence);
include/lisp.h
+12 -12
View File
@@ -1861,8 +1861,8 @@ static Lisp parse_symbol_(Lexer* lex, LispContext ctx)
char scratch[LISP_IDENTIFIER_MAX];
size_t length = lexer_copy_token(lex, 0, LISP_IDENTIFIER_MAX, scratch);
// always convert symbols to uppercase
for (int i = 0; i < length; ++i)
scratch[i] = toupper(scratch[i]);
// for (int i = 0; i < length; ++i)
// scratch[i] = toupper(scratch[i]);
return symbol_intern_(ctx.p->symbols, scratch, length, ctx);
}
@@ -3183,17 +3183,17 @@ LispContext lisp_init(void)
ctx.p->macros = lisp_make_table(ctx);
Lisp* c = ctx.p->symbol_cache;
c[SYM_IF] = lisp_make_symbol("IF", ctx);
c[SYM_BEGIN] = lisp_make_symbol("BEGIN", ctx);
c[SYM_QUOTE] = lisp_make_symbol("QUOTE", ctx);
c[SYM_QUASI_QUOTE] = lisp_make_symbol("QUASIQUOTE", ctx);
c[SYM_UNQUOTE] = lisp_make_symbol("UNQUOTE", ctx);
c[SYM_UNQUOTE_SPLICE] = lisp_make_symbol("UNQUOTESPLICE", ctx);
c[SYM_DEFINE] = lisp_make_symbol("_DEF", ctx);
c[SYM_DEFINE_MACRO] = lisp_make_symbol("DEFINE-MACRO", ctx);
c[SYM_SET] = lisp_make_symbol("_SET!", ctx);
c[SYM_IF] = lisp_make_symbol("if", ctx);
c[SYM_BEGIN] = lisp_make_symbol("begin", ctx);
c[SYM_QUOTE] = lisp_make_symbol("quote", ctx);
c[SYM_QUASI_QUOTE] = lisp_make_symbol("quasiquote", ctx);
c[SYM_UNQUOTE] = lisp_make_symbol("unquote", ctx);
c[SYM_UNQUOTE_SPLICE] = lisp_make_symbol("unquotesplice", ctx);
c[SYM_DEFINE] = lisp_make_symbol("_def", ctx);
c[SYM_DEFINE_MACRO] = lisp_make_symbol("define-macro", ctx);
c[SYM_SET] = lisp_make_symbol("_set!", ctx);
c[SYM_LAMBDA] = lisp_make_symbol("/\\_", ctx);
c[SYM_CONS] = lisp_make_symbol("CONS", ctx);
c[SYM_CONS] = lisp_make_symbol("cons", ctx);
return ctx;
}
include/lisp_lib.h
+194 -197
View File
@@ -36,7 +36,7 @@ static const char* lib_0_sequences_src_ =
(if (pair? args) \n\
(if (pair? (cdr args)) \n\
(if (pair? (cdr (cdr args))) \n\
`(/\\_ ,(car args) ,(cons 'BEGIN (cdr args))) \n\
`(/\\_ ,(car args) ,(cons 'begin (cdr args))) \n\
`(/\\_ ,(car args) ,(car (cdr args)))) \n\
(syntax-error \"lambda missing body expressions: (lambda (args) body)\")) \n\
(syntax-error \"lambda missing argument: (lambda (args) body)\")))) \n\
@@ -44,18 +44,18 @@ static const char* lib_0_sequences_src_ =
(define-macro set! (lambda (var x) \n\
(begin \n\
(if (not (symbol? var)) (syntax-error \"set! not a variable\")) \n\
`(_SET! ,var ,x)))) \n\
`(_set! ,var ,x)))) \n\
\n\
(define-macro define \n\
(lambda (var . exprs) \n\
(if (symbol? var) \n\
(if (pair? (cdr exprs)) \n\
(syntax-error \"define: (define var x)\") \n\
`(_DEF ,var ,(car exprs))) \n\
`(_def ,var ,(car exprs))) \n\
(if (pair? var) \n\
`(_DEF ,(car var) \n\
(LAMBDA ,(cdr var) \n\
,(if (null? (cdr exprs)) (car exprs) (cons 'BEGIN exprs)))) \n\
`(_def ,(car var) \n\
(lambda ,(cdr var) \n\
,(if (null? (cdr exprs)) (car exprs) (cons 'begin exprs)))) \n\
(syntax-error \"define: not a symbol\") )))) \n\
\n\
(define (first x) (car x)) \n\
@@ -98,13 +98,13 @@ static const char* lib_0_sequences_src_ =
(define (_expand-shorthand-body path) \n\
(if (null? path) (cons 'pair '()) \n\
(list (if (char=? (car path) #\\A) \n\
(cons 'CAR (_expand-shorthand-body (cdr path))))))) \n\
(cons 'car (_expand-shorthand-body (cdr path))))))) \n\
\n\
(define (_expand-shorthand text) \n\
(cons 'DEFINE (cons (list (string->symbol (string-append \"C\" text \"R\")) 'pair) \n\
(cons 'define (cons (list (string->symbol (string-append \"C\" text \"R\")) 'pair) \n\
(_expand-shorthand-body (string->list text))))) \n\
\n\
(define-macro _shorthand-accessors (lambda args (cons 'BEGIN (map1 _expand-shorthand args)))) \n\
(define-macro _shorthand-accessors (lambda args (cons 'begin (map1 _expand-shorthand args)))) \n\
\n\
(define (vector . args) (list->vector args)) \n\
\n\
@@ -124,14 +124,14 @@ static const char* lib_0_sequences_src_ =
static const char* lib_1_forms_src_ =
"(define (_make-lambda args body) \n\
(list 'LAMBDA args (if (null? (cdr body)) (car body) (cons 'BEGIN body)))) \n\
(list 'lambda args (if (null? (cdr body)) (car body) (cons 'begin body)))) \n\
\n\
\n\
; (LET <name> ((<var0> <expr0>) ... (<varN> <expr1>)) <body0> ... <bodyN>) \n\
; => ((LAMBDA (<var0> ... <varN>) (BEGIN <body0> ... <bodyN>)) <expr0> ... <expr1>) \n\
; (let <name> ((<var0> <expr0>) ... (<varN> <expr1>)) <body0> ... <bodyN>) \n\
; => ((lambda (<var0> ... <varN>) (begin <body0> ... <bodyN>)) <expr0> ... <expr1>) \n\
; => named \n\
; ((lambda () \n\
; (define <name> (LAMBDA (<var0> ... <varN>) (BEGIN <body0> ... <bodyN>))) \n\
; (define <name> (lambda (<var0> ... <varN>) (begin <body0> ... <bodyN>))) \n\
; (<name> <expr0> ... <exprN>))) \n\
\n\
(define (_check-binding-list bindings) \n\
@@ -145,7 +145,7 @@ static const char* lib_1_forms_src_ =
(define initial-args (map1 (lambda (entry) (second entry)) bindings)) \n\
(if (null? var) \n\
(cons body-func initial-args) \n\
(list (_make-lambda '() (list (list 'DEFINE var body-func) (cons var initial-args)))))) \n\
(list (_make-lambda '() (list (list 'define var body-func) (cons var initial-args)))))) \n\
\n\
(define-macro let (lambda args \n\
(if (pair? (first args)) \n\
@@ -153,8 +153,8 @@ static const char* lib_1_forms_src_ =
(_let->combination (first args) (second args) (cdr (cdr args)))))) \n\
\n\
(define (_let*-helper bindings body) \n\
(if (null? bindings) (if (null? (cdr body)) (car body) (cons 'BEGIN body)) \n\
(list 'LET (list (car bindings)) (_let*-helper (cdr bindings) body)))) \n\
(if (null? bindings) (if (null? (cdr body)) (car body) (cons 'begin body)) \n\
(list 'let (list (car bindings)) (_let*-helper (cdr bindings) body)))) \n\
\n\
(define-macro let* (lambda (bindings . body) \n\
(_check-binding-list bindings) \n\
@@ -163,17 +163,17 @@ static const char* lib_1_forms_src_ =
(define-macro letrec (lambda (bindings . body) \n\
(_check-binding-list bindings) \n\
(cons (_make-lambda (map1 (lambda (entry) (first entry)) bindings) \n\
(append (map1 (lambda (entry) (list 'SET! (first entry) (second entry))) \n\
(append (map1 (lambda (entry) (list 'set! (first entry) (second entry))) \n\
bindings) body)) \n\
(map1 (lambda (entry) '()) bindings)))) \n\
\n\
\n\
; (COND (<pred0> <expr0>) \n\
; (cond (<pred0> <expr0>) \n\
; (<pred1> <expr1>) \n\
; ... \n\
; (else <expr-1>)) \n\
; => \n\
; (IF <pred0> <expr0> \n\
; (if <pred0> <expr0> \n\
; (if <pred1> <expr1> \n\
; .... \n\
; (if <predN> <exprN> <expr-1>)) ... ) \n\
@@ -187,11 +187,11 @@ static const char* lib_1_forms_src_ =
\n\
(define (_cond-helper clauses) \n\
(if (null? clauses) '() \n\
(if (eq? (car (car clauses)) 'ELSE) \n\
(cons 'BEGIN (cdr (car clauses))) \n\
(list 'IF \n\
(if (eq? (car (car clauses)) 'else) \n\
(cons 'begin (cdr (car clauses))) \n\
(list 'if \n\
(car (car clauses)) \n\
(cons 'BEGIN (cdr (car clauses))) \n\
(cons 'begin (cdr (car clauses))) \n\
(_cond-helper (cdr clauses)))))) \n\
\n\
(define-macro cond (lambda clauses \n\
@@ -206,26 +206,26 @@ static const char* lib_2_forms_src_ =
(cond ((null? preds) #t) \n\
((null? (cdr preds)) (car preds)) \n\
(else \n\
`(IF ,(car preds) ,(_and-helper (cdr preds)) #f)))) \n\
`(if ,(car preds) ,(_and-helper (cdr preds)) #f)))) \n\
(define-macro and (lambda preds (_and-helper preds))) \n\
\n\
(define (_or-helper preds var) \n\
(cond ((null? preds) #f) \n\
((null? (cdr preds)) (car preds)) \n\
(else \n\
`(BEGIN (SET! ,var ,(car preds)) \n\
(IF ,var ,var ,(_or-helper (cdr preds) var)))))) \n\
`(begin (set! ,var ,(car preds)) \n\
(if ,var ,var ,(_or-helper (cdr preds) var)))))) \n\
\n\
(define-macro or (lambda preds \n\
(let ((var (gensym))) \n\
`(LET ((,var '())) ,(_or-helper preds var))))) \n\
`(let ((,var '())) ,(_or-helper preds var))))) \n\
\n\
(define-macro case (lambda (key . clauses) \n\
(let ((expr (gensym))) \n\
`(LET ((,expr ,key)) \n\
,(cons 'COND (map1 (lambda (entry) \n\
`(let ((,expr ,key)) \n\
,(cons 'cond (map1 (lambda (entry) \n\
(cons (if (pair? (car entry)) \n\
`(MEMV ,expr (quote ,(car entry))) \n\
`(memv ,expr (quote ,(car entry))) \n\
(car entry)) \n\
(cdr entry))) clauses)))))) \n\
\n\
@@ -234,20 +234,21 @@ static const char* lib_2_forms_src_ =
`(begin (set! ,l (cons ,v ,l)) ,l))) \n\
\n\
; (DO ((<var0> <init0> <step0>) ...) (<test> <result>) <body>) \n\
\n\
(define-macro do \n\
(lambda (vars loop-check . loops) \n\
(let ( (names '()) (inits '()) (steps '()) (f (gensym)) ) \n\
(for-each1 (lambda (var) \n\
(push (car var) names) \n\
(set! var (cdr var)) \n\
(push (car var) inits) \n\
(set! var (cdr var)) \n\
(push (car var) steps)) vars) \n\
`((LAMBDA () \n\
(DEFINE ,f (LAMBDA ,names \n\
(IF ,(car loop-check) \n\
(for-each1 (lambda (var-spec) \n\
(push (car var-spec) names) \n\
(push (car (cdr var-spec)) inits) \n\
(if (pair? (cdr (cdr var-spec))) \n\
(push (car (cdr (cdr var-spec))) steps) \n\
(push (car var-spec) steps))) vars) \n\
`((lambda () \n\
(define ,f (lambda ,names \n\
(if ,(car loop-check) \n\
,(if (pair? (cdr loop-check)) (car (cdr loop-check)) '()) \n\
,(cons 'BEGIN (append loops (list (cons f steps)))) ))) \n\
,(cons 'begin (append loops (list (cons f steps)))) ))) \n\
,(cons f inits) \n\
)) ))) \n\
\n\
@@ -262,18 +263,18 @@ static const char* lib_2_forms_src_ =
(define-macro swap! \n\
(lambda (x y) \n\
(let ((temp (gensym))) \n\
`(LET ((,temp ,x)) \n\
(SET! ,temp ,x) \n\
(SET! ,x ,y) \n\
(SET! ,y ,temp))))) \n\
`(let ((,temp ,x)) \n\
(set! ,temp ,x) \n\
(set! ,x ,y) \n\
(set! ,y ,temp))))) \n\
\n\
(define-macro inc! ; CL incf \n\
(lambda (x) \n\
`(SET! ,x (+ ,x 1)))) \n\
`(set! ,x (+ ,x 1)))) \n\
\n\
(define-macro dec! ; CL decf \n\
(lambda (x) \n\
`(SET! ,x (- ,x 1))))";
`(set! ,x (- ,x 1))))";
static const char* lib_3_math_src_ =
"(define (number? x) (real? x)) \n\
@@ -445,7 +446,7 @@ static const char* lib_4_sequences_src_ =
static const char* lib_5_streams_src_ =
"(define-macro delay (lambda (expr) \n\
`(make-promise ,(cons 'LAMBDA \n\
`(make-promise ,(cons 'lambda \n\
(cons '() \n\
(cons expr '())))))) \n\
\n\
@@ -1926,182 +1927,178 @@ static Lisp sch_is_cont(Lisp args, LispError* e, LispContext ctx)
static const LispFuncDef lib_cfunc_defs[] = {
{ "ERROR", sch_error },
{ "SYNTAX-ERROR", sch_syntax_error },
{ "error", sch_error },
{ "syntax-error", sch_syntax_error },
// Output Procedures https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Output-Procedures.html
{ "_WRITE", sch_write },
{ "_DISPLAY", sch_display },
{ "_WRITE-CHAR", sch_write_char },
{ "_FLUSH-OUTPUT-PORT", sch_flush },
{ "_READ", sch_read },
{ "INPUT-PORT?", sch_is_port_in },
{ "OUTPUT-PORT?", sch_is_port_out },
{ "OPEN-INPUT-FILE", sch_open_input },
{ "OPEN-OUTPUT-FILE", sch_open_output },
{ "CLOSE-INPUT-PORT", sch_port_close },
{ "CLOSE-OUTPUT-PORT", sch_port_close },
{ "EOF-OBJECT?", sch_is_eof },
// Output Procedures
{ "_write", sch_write },
{ "_display", sch_display },
{ "_write-char", sch_write_char },
{ "_flush-output-port", sch_flush },
{ "_read", sch_read },
{ "input-port?", sch_is_port_in },
{ "output-port?", sch_is_port_out },
{ "open-input-file", sch_open_input },
{ "open-output-file", sch_open_output },
{ "close-input-port", sch_port_close },
{ "close-output-port", sch_port_close },
{ "eof-object?", sch_is_eof },
// Universal Time https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Universal-Time.html
{ "GET-UNIVERSAL-TIME", sch_univeral_time },
{ "PRINT-GC-STATISTICS", sch_print_gc_stats },
// Universal Time
{ "get-universal-time", sch_univeral_time },
{ "print-gc-statistics", sch_print_gc_stats },
{ "MACROEXPAND", sch_macroexpand },
{ "macroexpand", sch_macroexpand },
// Equivalence Predicates https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Equivalence-Predicates.html
{ "EQ?", sch_exact_eq },
{ "EQV?", sch_equal },
{ "EQUAL?", sch_equal_r },
// Equivalence Predicates
{ "eq?", sch_exact_eq },
{ "eqv?", sch_equal },
{ "equal?", sch_equal_r },
// Booleans https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Booleans.html
{ "BOOLEAN?", sch_is_boolean },
{ "NOT", sch_not },
// Booleans
{ "boolean?", sch_is_boolean },
{ "not", sch_not },
// PAIRS
{ "CONS", sch_cons },
{ "CAR", sch_car },
{ "CDR", sch_cdr },
{ "SET-CAR!", sch_set_car },
{ "SET-CDR!", sch_set_cdr },
{ "NULL?", sch_is_null },
{ "PAIR?", sch_is_pair },
{ "cons", sch_cons },
{ "car", sch_car },
{ "cdr", sch_cdr },
{ "set-car!", sch_set_car },
{ "set-cdr!", sch_set_cdr },
{ "null?", sch_is_null },
{ "pair?", sch_is_pair },
// Lists https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_8.html
{ "LIST", sch_list },
{ "LIST?", sch_is_list },
{ "MAKE-LIST", sch_make_list },
{ "LIST-COPY", sch_list_copy },
{ "LENGTH", sch_length },
{ "APPEND", sch_append },
{ "APPEND-REVERSE!", sch_append_reverse },
{ "LIST-REF", sch_list_ref },
{ "NTHCDR", sch_list_advance },
// Lists
{ "list", sch_list },
{ "list?", sch_is_list },
{ "make-list", sch_make_list },
{ "list-copy", sch_list_copy },
{ "length", sch_length },
{ "append", sch_append },
{ "append-reverse!", sch_append_reverse },
{ "list-ref", sch_list_ref },
{ "nthcdr", sch_list_advance },
// Vectors https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_9.html#SEC82
{ "VECTOR?", sch_is_vector },
{ "MAKE-VECTOR", sch_make_vector },
{ "VECTOR-GROW", sch_vector_grow },
{ "VECTOR-LENGTH", sch_vector_length },
{ "VECTOR-SET!", sch_vector_set },
{ "VECTOR-SWAP!", sch_vector_swap },
{ "VECTOR-REF", sch_vector_ref },
{ "VECTOR-FILL!", sch_vector_fill },
{ "VECTOR-ASSQ", sch_vector_assq },
{ "SUBVECTOR", sch_subvector },
{ "LIST->VECTOR", sch_list_to_vector },
{ "VECTOR->LIST", sch_vector_to_list },
// Vectors
{ "vector?", sch_is_vector },
{ "make-vector", sch_make_vector },
{ "vector-grow", sch_vector_grow },
{ "vector-length", sch_vector_length },
{ "vector-set!", sch_vector_set },
{ "vector-swap!", sch_vector_swap },
{ "vector-ref", sch_vector_ref },
{ "vector-fill!", sch_vector_fill },
{ "vector-assq", sch_vector_assq },
{ "subvector", sch_subvector },
{ "list->vector", sch_list_to_vector },
{ "vector->list", sch_vector_to_list },
// Strings https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_7.html#SEC61
{ "STRING?", sch_is_string },
{ "MAKE-STRING", sch_make_string },
{ "STRING=?", sch_equal_r },
{ "STRING<?", sch_string_less },
{ "SUBSTRING", sch_substring },
{ "STRING-NULL?", sch_string_is_null },
{ "STRING-LENGTH", sch_string_length },
{ "STRING-REF", sch_string_ref },
{ "STRING-SET!", sch_string_set },
{ "STRING-UPCASE", sch_string_upcase },
{ "STRING-DOWNCASE", sch_string_downcase },
{ "STRING-APPEND", sch_string_append },
{ "STRING->LIST", sch_string_to_list },
{ "LIST->STRING", sch_list_to_string },
{ "STRING->NUMBER", sch_string_to_number },
{ "NUMBER->STRING", sch_number_to_string },
// Strings
{ "string?", sch_is_string },
{ "make-string", sch_make_string },
{ "string=?", sch_equal_r },
{ "string<?", sch_string_less },
{ "substring", sch_substring },
{ "string-null?", sch_string_is_null },
{ "string-length", sch_string_length },
{ "string-ref", sch_string_ref },
{ "string-set!", sch_string_set },
{ "string-upcase", sch_string_upcase },
{ "string-downcase", sch_string_downcase },
{ "string-append", sch_string_append },
{ "string->list", sch_string_to_list },
{ "list->string", sch_list_to_string },
{ "string->number", sch_string_to_number },
{ "number->string", sch_number_to_string },
// Characters https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Characters.html#Characters
{ "CHAR?", sch_is_char },
{ "CHAR=?", sch_equals },
{ "CHAR<?", sch_char_less },
// Characters
{ "char?", sch_is_char },
{ "char=?", sch_equals },
{ "char<?", sch_char_less },
{ "CHAR-UPCASE", sch_char_upcase },
{ "CHAR-DOWNCASE", sch_char_downcase },
{ "CHAR-WHITESPACE?", sch_char_is_white },
{ "CHAR-ALPHANUMERIC?", sch_char_is_alphanum },
{ "CHAR-ALPHABETIC?", sch_char_is_alpha },
{ "CHAR-NUMERIC?", sch_char_is_number },
{ "CHAR->INTEGER", sch_char_to_int },
{ "char-upcase", sch_char_upcase },
{ "char-downcase", sch_char_downcase },
{ "char-whitespace?", sch_char_is_white },
{ "char-alphanumeric?", sch_char_is_alphanum },
{ "char-alphabetic?", sch_char_is_alpha },
{ "char-numeric?", sch_char_is_number },
{ "char->integer", sch_char_to_int },
// Association Lists https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Association-Lists.html
// Numerical operations https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Numerical-operations.html
// Numerical operations
{ "=", sch_equals },
{ "+", sch_add },
{ "-", sch_sub },
{ "*", sch_mult },
{ "/", sch_divide },
{ "<", sch_less },
{ "INTEGER?", sch_is_int },
{ "EVEN?", sch_is_even },
{ "REAL?", sch_is_real },
{ "EXP", sch_exp },
{ "EXPT", sch_power },
{ "LOG", sch_log },
{ "SIN", sch_sin },
{ "COS", sch_cos },
{ "TAN", sch_tan },
{ "ATAN", sch_atan },
{ "SQRT", sch_sqrt },
{ "ROUND", sch_round },
{ "FLOOR", sch_floor },
{ "CEILING", sch_ceiling },
{ "QUOTIENT", sch_quotient },
{ "REMAINDER", sch_remainder },
{ "MODULO", sch_modulo },
{ "ABS", sch_abs },
{ "MAGNITUDE", sch_abs },
{ "EXACT?", sch_is_int },
{ "EXACT->INEXACT", sch_to_inexact },
{ "INEXACT->EXACT", sch_to_exact },
{ "integer?", sch_is_int },
{ "even?", sch_is_even },
{ "real?", sch_is_real },
{ "exp", sch_exp },
{ "expt", sch_power },
{ "log", sch_log },
{ "sin", sch_sin },
{ "cos", sch_cos },
{ "tan", sch_tan },
{ "atan", sch_atan },
{ "sqrt", sch_sqrt },
{ "round", sch_round },
{ "floor", sch_floor },
{ "ceiling", sch_ceiling },
{ "quotient", sch_quotient },
{ "remainder", sch_remainder },
{ "modulo", sch_modulo },
{ "abs", sch_abs },
{ "magnitude", sch_abs },
{ "exact?", sch_is_int },
{ "exact->inexact", sch_to_inexact },
{ "inexact->exact", sch_to_exact },
// Symbols https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Symbols.html
{ "SYMBOL?", sch_is_symbol },
{ "SYMBOL<?", sch_symbol_less },
{ "STRING->SYMBOL", sch_string_to_symbol },
{ "SYMBOL->STRING", sch_symbol_to_string },
{ "GENERATE-UNINTERNED-SYMBOL", sch_gensym },
{ "GENSYM", sch_gensym },
// Symbols
{ "symbol?", sch_is_symbol },
{ "symbol<?", sch_symbol_less },
{ "string->symbol", sch_string_to_symbol },
{ "symbol->string", sch_symbol_to_string },
{ "generate-uninterned-symbol", sch_gensym },
{ "gensym", sch_gensym },
// Environments https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_14.html
{ "EVAL", sch_eval },
{ "SCHEME-REPORT-ENVIRONMENT", sch_system_env },
{ "INTERACTION-ENVIRONMENT", sch_user_env },
// { "THE-ENVIRONMENT", sch_current_env },
// Environments
{ "eval", sch_eval },
{ "scheme-report-environment", sch_system_env },
{ "interaction-environment", sch_user_env },
// Hash Tables https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Basic-Hash-Table-Operations.html#Basic-Hash-Table-Operations
{ "HASH-TABLE?", sch_is_table },
{ "MAKE-HASH-TABLE", sch_table_make },
{ "HASH-TABLE-SET!", sch_table_set },
{ "HASH-TABLE-REF", sch_table_get },
{ "HASH-TABLE-SIZE", sch_table_size },
{ "HASH-TABLE->ALIST", sch_table_to_alist },
// Hash Tables
{ "hash-table?", sch_is_table },
{ "make-hash-table", sch_table_make },
{ "hash-table-set!", sch_table_set },
{ "hash-table-ref", sch_table_get },
{ "hash-table-size", sch_table_size },
{ "hash-table->alist", sch_table_to_alist },
{ "PROMISE?", sch_is_promise },
{ "MAKE-PROMISE", sch_make_promise },
{ "_PROMISE-PROCEDURE", sch_promise_proc },
{ "_PROMISE-STORE!", sch_promise_store },
{ "PROMISE-VALUE", sch_promise_val },
{ "PROMISE-FORCED?", sch_promise_forced },
{ "promise?", sch_is_promise },
{ "make-promise", sch_make_promise },
{ "_promise-procedure", sch_promise_proc },
{ "_promise-store!", sch_promise_store },
{ "promise-value", sch_promise_val },
{ "promise-forced?", sch_promise_forced },
// Procedures https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Procedure-Operations.html#Procedure-Operations
{ "APPLY", sch_apply },
{ "COMPILED-PROCEDURE?", sch_is_func },
{ "COMPOUND-PROCEDURE?", sch_is_lambda },
{ "PROCEDURE-ENVIRONMENT", sch_lambda_env },
// TOOD: Almost standard
{ "PROCEDURE-BODY", sch_lambda_body },
{ "CALL/CC", sch_call_cc },
{ "CONTINUATION?", sch_is_cont },
// Procedures
{ "apply", sch_apply },
{ "compiled-procedure?", sch_is_func },
{ "compound-procedure?", sch_is_lambda },
{ "procedure-environment", sch_lambda_env },
{ "procedure-body", sch_lambda_body },
{ "call/cc", sch_call_cc },
{ "continuation?", sch_is_cont },
// Random Numbers https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Random-Numbers.html
{ "RANDOM", sch_pseudo_rand },
{ "RANDOM-SEED!", sch_pseudo_seed },
// Random Numbers
{ "random", sch_pseudo_rand },
{ "random-seed!", sch_pseudo_seed },
// Garbage Collection https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-user/Garbage-Collection.html
{ "GC-FLIP", sch_gc_flip },
// Garbage Collection
{ "gc-flip", sch_gc_flip },
{ NULL, NULL }
};
void lisp_lib_load(LispContext ctx)
@@ -2111,14 +2108,14 @@ void lisp_lib_load(LispContext ctx)
lisp_table_set(
table,
lisp_make_symbol("_CURRENT-OUTPUT-PORT", ctx),
lisp_make_symbol("_current-output-port", ctx),
lisp_make_port(stdout, 0),
ctx
);
lisp_table_set(
table,
lisp_make_symbol("_CURRENT-INPUT-PORT", ctx),
lisp_make_symbol("_current-input-port", ctx),
lisp_make_port(stdin, 1),
ctx
);
src/builtins.c
+93 -24
View File
@@ -1,51 +1,87 @@
#include "../include/builtins.h"
#include "../include/define.h"
#include "../include/input.h"
#include "../include/file_io.h"
#include "../include/editor_op.h"
#include "../include/row_op.h"
#include "../include/data.h"
#include "../include/define.h"
#include "../include/editor_op.h"
#include "../include/file_io.h"
#include "../include/input.h"
#include "../include/row_op.h"
#include "include/output.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
struct prefix_t find_prefix(const char prefix_name[64]) {
int i = E.number_of_prefix + 1;
while (i--) {
if (!strcmp(prefix_name, E.prefix[i].prefix_name)) {
return E.prefix[i];
}
}
return E.prefix[0];
}
Lisp mapKey(Lisp args, LispError *e, LispContext ctx) {
/*
* 3 arguments keybind command prefix
*/
const char *key_sequence = lisp_string(lisp_car(args));
args = lisp_cdr(args);
// second argument
Lisp func = lisp_car(args);
E.key_binds =
(struct keyBind_t *)realloc(E.key_binds, ++E.number_of_keybinds * sizeof(struct keyBind_t));
E.key_binds[E.number_of_keybinds - 1].key_sequence = (char *) malloc(50 * sizeof(char));
E.key_binds = (struct keyBind_t *)realloc(
E.key_binds, ++E.number_of_keybinds * sizeof(struct keyBind_t));
E.key_binds[E.number_of_keybinds - 1].key_sequence =
(char *)malloc(50 * sizeof(char));
strncpy(E.key_binds[E.number_of_keybinds - 1].key_sequence, key_sequence, 50);
E.key_binds[E.number_of_keybinds - 1].command = func;
// Third argument
args = lisp_cdr(args);
const char *prefix_name = lisp_string(lisp_car(args));
struct prefix_t prefix = find_prefix(prefix_name);
E.key_binds[E.number_of_keybinds - 1].prefix_id = prefix.prefix_id;
return lisp_null();
}
Lisp moveCursor(Lisp args, LispError *e, LispContext ctx) {
const char *direction = lisp_string(lisp_car(args));
int is_in = 0;
switch (direction[0]) {
case 'u':
editorMoveCursor(ARROW_UP);
is_in = editorMoveCursor(ARROW_UP);
break;
case 'd':
editorMoveCursor(ARROW_DOWN);
is_in = editorMoveCursor(ARROW_DOWN);
break;
case 'r':
editorMoveCursor(ARROW_RIGHT);
is_in = editorMoveCursor(ARROW_RIGHT);
break;
case 'l':
editorMoveCursor(ARROW_LEFT);
is_in = editorMoveCursor(ARROW_LEFT);
break;
}
fprintf(stderr, "move lisp %d\n", is_in);
return lisp_make_bool(is_in);
}
void free_structs(void) {
int i;
free(E.prefix);
for (i = 0; i < E.number_of_keybinds; ++i) {
free(E.key_binds[i].key_sequence);
}
free(E.key_binds);
free(E.filename);
free(E.row->chars);
free(E.row->render);
free(E.row);
return lisp_null();
}
Lisp editorQuit(Lisp args, LispError *e, LispContext ctx) {
@@ -55,24 +91,21 @@ Lisp editorQuit(Lisp args, LispError* e, LispContext ctx) {
--E.quit_times_buffer;
return lisp_null();
}
free_structs();
write(STDOUT_FILENO, "\x1b[2J", 4);
write(STDOUT_FILENO, CURSOR_TOP_LEFT, 3);
disableRawMode();
lisp_shutdown(E.ctx);
exit(0);
return lisp_null();
}
Lisp l_editorSave(Lisp args, LispError *e, LispContext ctx) {
editorSave();
return lisp_null();
}
Lisp l_editorInsertNewLine(Lisp args, LispError *e, LispContext ctx) {
@@ -80,8 +113,15 @@ Lisp l_editorInsertNewLine(Lisp args, LispError* e, LispContext ctx) {
editorInsertNewLine();
return lisp_null();
}
Lisp l_editorInserTab(Lisp args, LispError *e, LispContext ctx) {
for (int i = 0; i<E.constantes.TAB_LENGTH; ++i) {
editorInsertChar(' ');
}
return lisp_null();
}
Lisp moveCursorBeginLine(Lisp args, LispError *e, LispContext ctx) {
@@ -96,7 +136,6 @@ Lisp moveCursorEndLine(Lisp args, LispError* e, LispContext ctx) {
return lisp_null();
}
Lisp deletePreviousChar(Lisp args, LispError *e, LispContext ctx) {
editorDelChar();
return lisp_null();
@@ -126,13 +165,15 @@ Lisp editorMoveCursorPageDown(Lisp args, LispError* e, LispContext ctx) {
Lisp editorOpenFile(Lisp args, LispError *e, LispContext ctx) {
char *filename = editorPrompt("Open : %s", getenv("PWD"), 1);
if (filename)
if (filename){
editorOpen(filename);
}
free(filename);
return lisp_null();
}
Lisp editorPrintC(Lisp args, LispError *e, LispContext ctx) {
char c = lisp_string(lisp_car(args))[0];
editorInsertChar(c);
@@ -141,12 +182,14 @@ Lisp editorPrintC(Lisp args, LispError *e, LispContext ctx) {
Lisp addPackage(Lisp args, LispError *e, LispContext ctx) {
const char *package_name = lisp_string(lisp_car(args));
fprintf(stderr, "%s\n", package_name);
char *package_dir = (char *)calloc(256, sizeof(char));
FILE *fd_package = NULL;
strcat(package_dir, getenv("HOME"));
strcat(package_dir, "/.beluga/packages/");
strcat(package_dir, package_name);
strcat(package_dir, "/init.lisp");
fprintf(stderr, "%s\n", package_dir);
fd_package = fopen(package_dir, "r");
lisp_eval(lisp_read_file(fd_package, &E.ctx_error, E.ctx), &E.ctx_error,
E.ctx);
@@ -154,7 +197,6 @@ Lisp addPackage(Lisp args, LispError *e, LispContext ctx) {
free(package_dir);
return lisp_null();
}
Lisp editorDelRow_L(Lisp args, LispError *e, LispContext ctx) {
@@ -168,7 +210,34 @@ Lisp editorFind_L(Lisp args, LispError *e, LispContext ctx) {
}
Lisp editorReadChar_L(Lisp args, LispError *e, LispContext ctx) {
fprintf(stderr, "char read : %c\n", E.row[E.cursor_y].render[E.cursor_x]);
return lisp_make_char(E.row[E.cursor_y].render[E.cursor_x]);
Lisp returned_char;
if (E.row[E.cursor_y].render[E.cursor_x] == 0) {
returned_char = lisp_make_char('a');
} else {
returned_char = lisp_make_char(E.row[E.cursor_y].render[E.cursor_x]);
}
return returned_char;
}
Lisp editorSetPrefix(Lisp args, LispError *e, LispContext ctx) {
/*
* Set the prefix state of editor to the prefix in argument
*/
const char *prefix_name = lisp_string(lisp_car(args));
struct prefix_t prefix = find_prefix(prefix_name);
E.prefix_state = prefix.prefix_id;
editorSetStatusMessage("prefix %s", prefix.prefix_name);
fprintf(stderr, "%s set\n", prefix_name);
return lisp_null();
}
Lisp editorPrefix(Lisp args, LispError *e, LispContext ctx) {
E.prefix = (struct prefix_t *)realloc(E.prefix, (++(E.number_of_prefix) + 1) *
sizeof(struct prefix_t));
E.prefix[E.number_of_prefix].prefix_id = E.number_of_prefix;
strncpy(E.prefix[E.number_of_prefix].prefix_name, lisp_string(lisp_car(args)),
64);
return lisp_null();
}
src/editor_op.c
+5
View File
@@ -13,6 +13,10 @@ void editorInsertChar(int c) {
}
void editorInsertNewLine() {
/*
* Add new line and place the cursor at the beginning of it
*/
fprintf(stderr, "Inserting new line\n");
erow *row;
if (!E.cursor_x) {
editorInsertRow(E.cursor_y, "", 0);
@@ -27,6 +31,7 @@ void editorInsertNewLine() {
}
++E.cursor_y;
E.cursor_x = 0;
fprintf(stderr, "Insert new line done\n");
}
void editorDelChar() {
src/init.c
+28 -19
View File
@@ -1,8 +1,9 @@
#include "../include/init.h"
#include "../include/builtins.h"
#include "../include/data.h"
#include "../include/terminal.h"
#include "../include/builtins.h"
#include <stdio.h>
#include <stdlib.h>
#define LISP_IMPLEMENTATION
#include "../include/lisp.h"
@@ -10,31 +11,32 @@
extern struct editorConfig;
void registerBuiltin(char *key_sequence, LispCFunc f) {
lisp_env_define(E.ctx.p->env, lisp_make_symbol(key_sequence, E.ctx),
lisp_make_func(f), E.ctx);
}
void initBuiltins() {
// move cursor
registerBuiltin("MOVE-CURSOR", moveCursor);
registerBuiltin("MAP-KEY", mapKey);
registerBuiltin("EDITOR-QUIT", editorQuit);
registerBuiltin("EDITOR-SAVE", l_editorSave);
registerBuiltin("EDITOR-INSERT-NEW-LINE", l_editorInsertNewLine);
registerBuiltin("MOVE-CURSOR-BEG-LINE", moveCursorBeginLine);
registerBuiltin("MOVE-CURSOR-END-LINE", moveCursorEndLine);
registerBuiltin("EDITOR-DELETE-PREVIOUS-CHAR", deletePreviousChar);
registerBuiltin("MOVE-CURSOR-PAGE-UP", editorMoveCursorPageUp);
registerBuiltin("MOVE-CURSOR-PAGE-DOWN", editorMoveCursorPageDown);
registerBuiltin("EDITOR-OPEN-FILE", editorOpenFile);
registerBuiltin("EDITOR-INSERT-CHAR", editorPrintC);
registerBuiltin("ADD-PACKAGE", addPackage);
registerBuiltin("EDITOR-DEL-ROW", editorDelRow_L);
registerBuiltin("EDITOR-FIND", editorFind_L);
registerBuiltin("EDITOR-READ-CHAR", editorReadChar_L);
registerBuiltin("move-cursor", moveCursor);
registerBuiltin("map-key", mapKey);
registerBuiltin("editor-quit", editorQuit);
registerBuiltin("editor-save", l_editorSave);
registerBuiltin("editor-insert-new-line", l_editorInsertNewLine);
registerBuiltin("move-cursor-beg-line", moveCursorBeginLine);
registerBuiltin("move-cursor-end-line", moveCursorEndLine);
registerBuiltin("editor-delete-previous-char", deletePreviousChar);
registerBuiltin("move-cursor-page-up", editorMoveCursorPageUp);
registerBuiltin("move-cursor-page-down", editorMoveCursorPageDown);
registerBuiltin("editor-open-file", editorOpenFile);
registerBuiltin("editor-insert-char", editorPrintC);
registerBuiltin("add-package", addPackage);
registerBuiltin("editor-del-row", editorDelRow_L);
registerBuiltin("editor-find", editorFind_L);
registerBuiltin("editor-read-char", editorReadChar_L);
registerBuiltin("add-prefix", editorPrefix);
registerBuiltin("editor-set-prefix", editorSetPrefix);
registerBuiltin("editor-insert-tab", l_editorInserTab);
}
void initEditor() {
@@ -57,6 +59,13 @@ void initEditor() {
E.screenrows -= 2;
E.number_of_keybinds = 0;
E.number_of_prefix = 0;
// General prefix is 0 (no prefix)
E.prefix = (struct prefix_t *)malloc(sizeof(struct prefix_t));
E.prefix[0].prefix_id = 0;
strncpy(E.prefix[0].prefix_name, "no-prefix", 64);
E.prefix_state = 0;
strcat(init_file_path, getenv("HOME"));
strcat(init_file_path, "/.beluga/config/init.lisp");
src/input.c
+15 -11
View File
@@ -1,14 +1,14 @@
#include "../include/input.h"
#include "../include/define.h"
#include "../include/editor_op.h"
#include "../include/output.h"
#include "../include/define.h"
#include <ctype.h>
#include <sys/stat.h>
#include <dirent.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/stat.h>
#include <unistd.h>
extern struct editorConfig E;
@@ -38,7 +38,6 @@ char * file_completion(const char *path) {
return NULL;
}
dir = opendir(directory);
if (!dir)
return NULL;
@@ -61,7 +60,6 @@ char * file_completion(const char *path) {
closedir(dir);
dir = NULL;
return NULL;
}
/**
@@ -129,11 +127,12 @@ char *key_to_string(int key) {
char tmp[10];
sprintf(tmp, "%d", key);
// First test enter key
if (key == '\r') {
strcpy(key_str, "ENTER");
} else if (key == '\t') {
strcpy(key_str, "TAB");
} else if (key >= 1 && key <= 26) { // CTRL keys
snprintf(key_str, sizeof(key_str), "CTRL-%c", 'a' + key - 1);
} else {
@@ -158,7 +157,6 @@ char *key_to_string(int key) {
strcpy(key_str, "PAGE-DOWN");
break;
case DEL_KEY:
fprintf(stderr, "delete key\n");
strcpy(key_str, "DEL");
break;
@@ -189,8 +187,7 @@ char *key_to_string(int key) {
return key_str;
}
void editorMoveCursor(int key) {
int editorMoveCursor(int key) {
erow *row = (E.cursor_y >= E.numrows) ? NULL : &E.row[E.cursor_y];
int row_len;
switch (key) {
@@ -226,18 +223,26 @@ void editorMoveCursor(int key) {
row_len = row ? row->size : 0;
if (E.cursor_x > row_len) {
E.cursor_x = row_len;
return 0;
}
return 1;
}
int executeKeyBind(char *key_sequence) {
int i;
int previous_state = 0;
fprintf(stderr, "pressed %s\n", key_sequence);
for (i = 0; i < E.number_of_keybinds; ++i) {
if (!strcmp(key_sequence, E.key_binds[i].key_sequence)) {
fprintf(stderr, "lisp function %s\n", key_sequence);
if (E.prefix_state != E.key_binds[i].prefix_id) {
return 0;
}
previous_state = E.prefix_state;
// It's a symbol, create a function call
lisp_eval(lisp_cons(E.key_binds[i].command, lisp_null(), E.ctx),
&E.ctx_error, E.ctx);
if (E.prefix_state == previous_state)
E.prefix_state = 0;
return 1;
}
}
@@ -252,5 +257,4 @@ void editorProcessKeypress() {
}
editorInsertChar(c);
E.quit_times_buffer = E.constantes.QUIT_TIMES;
}