-
-
Notifications
You must be signed in to change notification settings - Fork 19
/
repl.lisp
executable file
·687 lines (601 loc) · 25.4 KB
/
repl.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
;; #!/usr/bin/sbcl --script
(load "~/quicklisp/setup")
(let ((*standard-output* (make-broadcast-stream)))
(ql:quickload "cl-readline"))
(uiop:define-package :sbcli
(:use :common-lisp :trivial-package-local-nicknames)
(:import-from :magic-ed
:magic-ed)
(:export repl sbcli help what *repl-version* *repl-name* *prompt* *prompt2* *result-indicator* *init-file*
*quicklisp*
*hist-file* *special*
*syntax-highlighting* *pygmentize* *pygmentize-options*))
(in-package :sbcli)
;; repl-utilities: nice to have, but don't clutter the CIEL package by exporting them.
;; For instance, "summary" is too common a word to be exported.
(cl-reexport:reexport-from :repl-utilities
:include
'(:repl-utilities
:readme
;; :doc ;; conflicts with our little %doc helper.
:summary
:package-apropos
:trace-package
:print-hash))
(defvar *repl-version* "0.1.5") ;XXX: print CIEL version.
(defvar *banner* "
_..._
.-'_..._''. .---.
.' .' '.\.--. __.....__ | |
/ .' |__| .-'' '. | |
. ' .--. / .-''''-. `. | |
| | | |/ /________\ \| |
| | | || || |
. ' | |\ .-------------'| |
\ '. .| | \ '-.____...---.| |
'. `._____.-'/|__| `. .' | |
`-.______ / `''-...... -' '---'
`
")
(defvar *repl-name* "CIEL's REPL")
(defvar *prompt* (format nil "~a" (cl-ansi-text:green "ciel-user> ")))
(defvar *prompt2* "....> ")
(defvar *result-indicator* "=> ")
(defvar *init-file* "~/.cielrc")
(defvar *hist-file* "~/.ciel_history")
(defvar *hist* (list))
(defvar *syntax-highlighting* nil)
(defvar *pygmentize* nil "(optional) Path to a pygments executable. If not set, we try to find it.")
(defvar *pygmentize-options* (list "-s" "-l" "lisp"))
(defparameter *lisp-critic* nil "If non-nil, give feedback on the code you type using lisp-critic.")
(declaim (special *special*))
(defun print-system-info (&optional (stream t))
;; see also https://github.com/40ants/cl-info
(format stream "~&OS: ~a ~a~&" (software-type) (software-version))
(format stream "~&Lisp: ~a ~a~&" (lisp-implementation-type) (lisp-implementation-version))
#+asdf
(format stream "~&ASDF: ~a~&" (asdf:asdf-version))
#-asdf
(format stream "NO ASDF!")
#+quicklisp
(format stream "~&Quicklisp: ~a~&" (ql-dist:all-dists))
#-quicklisp
(format stream "Quicklisp is not installed~&"))
(defun read-hist-file ()
(with-open-file (in *hist-file* :if-does-not-exist :create)
(loop for line = (read-line in nil nil)
while line
;; hack because cl-readline has no function for this.
;; TODO: it has it now.
do (cffi:foreign-funcall "add_history"
:string line
:void))))
(defun update-hist-file (str)
(with-open-file (out *hist-file*
:direction :output
:if-exists :append
:if-does-not-exist :create)
(write-line str out)))
(defun load-init-file (&optional (init-file *init-file*))
"Load the ~/.cielrc init file.
Defaults to `*init-file*'."
(load init-file))
(defun end ()
"Ends the session."
(format t "~%Bye!~&")
(uiop:quit))
;; (defun reset ()
;; "Resets the session environment"
;; (delete-package 'sbcli)
;; (defpackage :sbcli (:use :common-lisp :ciel))
;; ;XXX: ?
;; (in-package :sbcli))
(defun novelty-check (str1 str2)
(string/= (string-trim " " str1)
(string-trim " " str2)))
(defun history-add (txt res)
(setq *hist* (cons (list txt res) *hist*)))
(defun format-output (&rest args)
(format (car args) "~a ; => ~a" (caadr args) (cadadr args)))
(defun write-to-file (fname)
"Writes the current session to a file <filename>"
(with-open-file (file fname
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(format file "~{~/sbcli:format-output/~^~%~}" (reverse *hist*))))
(defun what (sym)
"Gets help on a symbol <sym>: :? str"
(format t "inspecting ~a.~&~
To inspect further objects, type their number.~&~
To quit, type q and Enter." sym)
(handler-case (inspect (read-from-string sym))
(error (c) (format *error-output* "Error during inspection: ~a~%" c))))
(defun help ()
"Prints this general help message"
(format t "~a version ~a~%" *repl-name* *repl-version*)
(write-line "Read more on packages with readme or summary. For example: (summary :str)")
(write-line "Special commands:")
(maphash
(lambda (k v) (format t " %~a => ~a~%" k (documentation (cdr v) t)))
*special*)
;; (write-line "Currently defined:")
;; (print-currently-defined)
(write-line "Press CTRL-D or type %q to exit"))
(defun symbol-documentation (symbol)
"Print the available documentation for this symbol."
;; Normally, the documentation function takes as second argument the
;; type designator. We loop over each type and print the available
;; documentation.
(handler-case (loop for doc-type in '(variable function structure type setf)
with sym = (if (stringp symbol)
;; used from the readline REPL
(read-from-string symbol)
;; used from Slime
symbol)
for doc = (unless (consp sym) ;; when a function is quoted: :doc 'defun
;; instead of :doc defun
(documentation sym doc-type))
when doc
do (format t "~a: ~a~&" doc-type doc)
when (and (equal doc-type 'function)
(fboundp sym))
do (format t "ARGLIST: ~a~&" (format nil "~(~a~)"
(trivial-arguments:arglist sym))))
(error (c) (format *error-output* "Error during documentation lookup: ~a~&" c))))
(defun print-currently-defined ()
(do-all-symbols (s *package*)
(when (and (or (fboundp s) (boundp s)) (eql (symbol-package s) *package*))
(let ((what (cond ((fboundp s) 'function) ((constantp s) 'constant) (t 'variable))))
(format t " ~a: ~a (~a) ~a~%" (string-downcase (string s))
(or (documentation s what)
"No documentation")
what
(if (boundp s)
(format nil "(value ~a)" (eval s))
""))))))
(defun dump-disasm (sym)
"Dumps the disassembly of a symbol <sym>"
(handler-case (disassemble (read-from-string sym))
(unbound-variable (var) (format t "~a~%" var))
(type-error (err) (format t "~a~%" err))
(sb-int:compiled-program-error (err) (format t "~a~%" err))
(undefined-function (fun) (format t "~a~%" fun))))
(defun dump-type (expr)
"Prints the type of a expression <expr>"
(handler-case (format t "~a~%" (type-of (eval (read-from-string expr))))
(unbound-variable (var) (format t "~a~%" var))
(type-error (err) (format t "~a~%" err))
(sb-int:compiled-program-error (err) (format t "~a~%" err))
(undefined-function (fun) (format t "~a~%" fun))))
(defun edit-and-load-file (file)
"Edit a file with EDITOR and evaluate it."
(magic-ed file))
(defun toggle-lisp-critic ()
"Enable or disable the lisp critic. He critizes the code you type before compiling it."
(setf *lisp-critic* (not *lisp-critic*))
(format t "The lisp-critic is ~a.~&" (if *lisp-critic* "enabled" "disabled")))
;; -1 means take the string as one arg
(defvar *special*
(alexandria:alist-hash-table
`( ;; ("help" . (0 . ,#'general-help))
("help" . (0 . ,#'help))
("doc" . (1 . ,#'symbol-documentation))
("?" . (1 . ,#'what))
;; ("r" . (1 . ,#'readme))
;; ("s" . (1 . ,#'summary))
("w" . (1 . ,#'write-to-file))
("d" . (1 . ,#'dump-disasm))
("t" . (-1 . ,#'dump-type))
("q" . (0 . ,#'end))
;; ("z" . (0 . ,#'reset))
("lisp-critic" . (0 . ,#'toggle-lisp-critic))
("edit" . (1 . ,#'edit-and-load-file))
)
:test 'equal)
"All special commands starting with :")
(defun special-command-p (text)
"A *special* command starts with %."
(str:starts-with-p "%" text))
;; both functions are required to get completion on %
(defun list-special-commands ()
(loop for k being the hash-key of *special*
collect (format nil "%~a" k)))
(defun intern-special-commands ()
(loop for k being the hash-key of *special*
for symname = (format nil "%~a" k)
do (intern symname :sbcli)))
(intern-special-commands)
(defun call-special (fundef call args)
(let ((l (car fundef))
(fun (cdr fundef))
(rl (length args)))
(cond
((= -1 l) (funcall fun (str:join " " args)))
((< rl l)
(format *error-output*
"Expected ~a arguments to ~a, but got ~a!~%"
l call rl))
(t (apply fun (subseq args 0 l))))))
(defun handle-special-input (text)
(let* ((words (str:words text))
(k (subseq (car words) 1 (length (car words))))
(v (gethash k *special*)))
(if v
(call-special v (car words) (cdr words))
(format *error-output* "Unknown special command: ~a~%" k))))
(defun evaluate-lisp (text parsed)
"Evaluate (EVAL) the user input.
In case of evaluation error, print it.
Then print the result. Print its multiple values.
Save the input history.
Handle the special *, + et all REPL history variables."
(let ((result-list
(multiple-value-list
(handler-case (eval parsed)
(unbound-variable (var)
(format *error-output* "~a~%" var))
(undefined-function (fun)
(format *error-output* "~a~%" fun))
(sb-int:compiled-program-error ()
(format *error-output* "~a"
(cl-ansi-text:red "Compiler error.~%")))
(error (condition)
(format *error-output* "~a~a~%"
(cl-ansi-text:red "Evaluation error: ")
condition))))))
(history-add text (car result-list))
(when result-list
(setf +++ ++
/// //
*** (car ///)
++ +
// /
** (car //)
+ parsed
/ result-list
* (car result-list))
;; Print the result, and all multple values. They are printed like so:
;; (not the best with =>)
;; ciel-user> (values 1 2 3)
;; => 1
;; 2
;; 3
(format t "~a~{~s~&~}~%" *result-indicator* result-list))))
#+(or nil)
(let* ((input "(values :one :two)")
(result (with-output-to-string (*standard-output*)
(evaluate-lisp "whatever" (read-from-string input)))))
(assert (and (str:containsp ":one"
result
:ignore-case t)
(str:containsp ":two"
result
:ignore-case t)))
(assert (equal '(:ONE :TWO)
/)))
(defun lisp-critic-applicable (txt)
"TXT is code that should start with a parenthesis. Don't critique global variables."
(str:starts-with? "(" (str:trim txt)))
(defun handle-lisp (before text)
(let* ((new-txt (format nil "~a ~a" before text))
(parsed (handler-case (read-from-string new-txt)
(end-of-file () (sbcli new-txt *prompt2*))
(error (condition)
(format *error-output* "Parser error: ~a~%" condition))))
(to-critic (when (and *lisp-critic*
(lisp-critic-applicable new-txt)
parsed)
`(lisp-critic:critique ,parsed))))
(when to-critic
;; The call to lisp-critic doesn't evaluate the lisp code,
;; it only scans it and prints feedback.
(evaluate-lisp text to-critic))
;; But even if the lisp-critic is enabled,
;; we want the code we type to be eval'ed.
(when parsed
(evaluate-lisp text parsed))))
(defun handle-input (before text)
(if (and (> (length text) 1)
(special-command-p text))
(handle-special-input text)
(handle-lisp before text)))
(defun get-package-for-search (text)
"Return a list with:
- the text after the colon or double colon
- the package name
- T if we look for an external symbol, NIL for an internal one."
(let ((pos))
(cond
((setf pos (search "::" text))
(list (subseq text (+ pos 2))
(subseq text 0 pos)
nil))
((setf pos (position #\: text))
(if (zerop pos)
(list text nil t)
(list (subseq text (1+ pos))
(subseq text 0 pos)
t)))
(t (list text nil t)))))
(defun list-external-symbols (sym-name pkg-name)
"List external symbols of PKG-NAME (a string).
(the symbol name is currently ignored)."
(declare (ignorable sym-name))
(assert (stringp pkg-name))
(loop :for sym :being :the :external-symbols :of (find-package pkg-name)
:collect (format nil "~(~a:~a~)" pkg-name sym)))
(defun list-internal-symbols (sym-name pkg-name)
"List internal symbols of the package named PKG-NAME (a string)."
(declare (ignorable sym-name))
(assert (stringp pkg-name))
(loop :for sym :being :the :symbols :of (find-package pkg-name)
:collect (format nil "~(~a::~a~)" pkg-name sym)))
(defun list-local-nicknames (&optional (package *package*))
"Return a list of local nicknames.
(downcased strings, with a trailing colon to denote a package)"
(loop :for pair in (package-local-nicknames package)
:collect (format nil "~a:" (str:downcase (car pair)))))
(defun list-symbols-and-packages (sym-name)
"Base case, when the user entered a string with no colon that would delimit a package.
Return the current packages, symbols of the current package, current keywords.
They are filtered afterwards, in SELECT-COMPLETIONS."
(declare (ignorable sym-name))
(concatenate 'list
(list-special-commands)
(loop :for pkg :in (list-all-packages)
:append (loop :for name :in (package-nicknames pkg)
:collect (format nil "~(~a:~)" name))
:collect (format nil "~(~a:~)" (package-name pkg)))
(list-local-nicknames *package*)
(loop :for sym :being :the :symbols :of *package*
:collect (string-downcase sym))
(loop :for kw :being :the :symbols :of (find-package "KEYWORD")
:collect (format nil ":~(~a~)" kw))))
(defun select-completions (text items)
"TEXT is the string entered at the prompt, ITEMS is a list of
strings to match candidates against (for example in the form \"package:sym\")."
(setf items
(loop :for item :in items
:when (str:starts-with-p text item)
:collect item))
(unless (cdr items)
(setf rl:*completion-append-character*
(if (str:ends-with-p ":" (car items))
#\nul
#\space))
(return-from select-completions items))
(cons
(subseq (car items) 0
(loop :for item :in (cdr items)
:minimize (or (mismatch (car items) item) (length item))))
items))
#+(or)
(progn
(assert (member "str:concat"
(select-completions "str:con" (list "str:containsp" "str:concat" "str:constant-case"))
:test #'string-equal)))
(defun shell-passthrough-p (arg)
"Return t if arg (string) starts with \"!\".
This is used to offer custom TAB completion, not to launch shell commands.
The Clesh readtable is responsible of that."
(str:starts-with-p "!" arg))
(defun complete-filename-p (text start end &key (line-buffer rl:*line-buffer*))
"Return T if we should feed the tab completion candidates filenames, instead of the regular Lisp symbols.
We answer yes when we are tab-completing a secord word on the prompt and a quote comes before it.
TEXT, START and END: see `custom-complete'.
Ex:
!ls \"test TAB => yes return files instead of lisp symbols for completion.
!\"tes TAB => well, no.
(load \"test TAB => yes
(load (test TAB => no
"
(declare (ignore end))
(and (not (shell-passthrough-p text))
(> start 1) ;; 1 is an opening parenthesis.
(char-equal #\" (elt line-buffer (1- start))) ;; after an opening quote.
))
#+test-ciel
(progn
(assert (complete-filename-p "test" 7 10 :line-buffer "(load \"test"))
(assert (complete-filename-p "test" 7 10 :line-buffer "(!foo \"test"))
(assert (not (complete-filename-p "test" 1 5 :line-buffer "\"test")))
)
(defun filter-candidates (text file-candidates)
"Return a list of files (strings) in the current directory that start with TEXT."
;; yeah, this calls for more features. Hold on a minute will you.
(remove-if #'null
(mapcar (lambda (path)
(let ((namestring (file-namestring path)))
(when (str:starts-with-p text namestring)
namestring)))
file-candidates)))
(defun complete-binaries-from-path-p (text start end &key (line-buffer rl:*line-buffer*))
"Return T if we should TAB-complete shell executables, and search them on the PATH.
START must be 0: we are writing the first word on the readline prompt,
TEXT must start with ! the mark of the shell pass-through."
(declare (ignore end line-buffer))
(and (zerop start)
(str:starts-with-p "!" text)))
(defun find-binaries-candidates (text)
"Find binaries starting with TEXT in PATH.
Return: a list of strings."
(loop with s = (string-left-trim "!" text)
for dir in (uiop:getenv-absolute-directories "PATH")
for res = (filter-candidates s (uiop:directory-files dir))
collect res into candidates
finally (return
;; we got "!text", we have to return candidates
;; with the "!" prefix, so that readline agrees they are completions.
(mapcar (lambda (bin)
(str:concat "!" bin))
(alexandria:flatten candidates)))))
(defun custom-complete (text &optional start end)
"Custom completer function for readline, triggered when we press TAB.
Complete filenames on the current directory when appropriate (after a quote).
TEXT is the current word being type. Not the full command line.
START is the start of this word. If we type the first word of the command
and TAB-complete it, then START equals 0. For a second word, START != 0.
Ex:
!ls te TAB
TEXT is \"te\", START is 4 and END is 6.
That way we give other completion candidates depending on START."
(when (string-equal text "")
(return-from custom-complete nil))
(destructuring-bind (sym-name pkg-name external-p)
(get-package-for-search (string-upcase text))
(when (and pkg-name
(not (find-package pkg-name)))
(return-from custom-complete nil))
(select-completions
(str:downcase text)
(cond
((complete-binaries-from-path-p text start end :line-buffer rl:*line-buffer*)
(find-binaries-candidates text))
((complete-filename-p text start end :line-buffer rl:*line-buffer*)
;; complete file names on the current directory.
;; Yes we could complete both: lisp symbols AND files. See with usage.
(filter-candidates text (uiop:directory-files ".")))
((zerop (length pkg-name))
(list-symbols-and-packages sym-name))
(external-p
(list-external-symbols sym-name pkg-name))
(t
(list-internal-symbols sym-name pkg-name))))))
#+(or)
(progn
(assert (member "str:suffixp"
(custom-complete "str:suff")
:test #'string-equal))
(assert (member "uiop:file-exists-p"
(custom-complete "uiop:file-")
:test #'string-equal)))
(defun format-prompt (text &key (colored t))
(let ((prompt (str:concat text "> ")))
(format nil "~a" (if colored
(cl-ansi-text:green prompt)
prompt))))
(defun sbcli (txt prompt)
"Read user input and evaluate it.
This function must be called from inside the CIEL-USER package."
(let* ((prompt-text (if (functionp prompt)
(funcall prompt)
prompt))
(cur-pkg-name (package-name *package*))
(text
(handler-case
(rl:readline :prompt (if (string-equal "CIEL-USER" cur-pkg-name)
prompt-text
(sbcli::format-prompt cur-pkg-name))
:add-history t
:novelty-check #'sbcli::novelty-check)
;; Catch a C-c.
(#+sbcl sb-sys:interactive-interrupt
#+ccl ccl:interrupt-signal-condition
#+clisp system::simple-interrupt-condition
#+ecl ext:interactive-interrupt
#+allegro excl:interrupt-signal
()
(write-char #\linefeed)
""))))
(unless text (sbcli::end))
(if (string= text "")
(sbcli::sbcli "" *prompt*))
(when *hist-file* (sbcli::update-hist-file text))
(cond
;; Handle documentation lookup.
((str:ends-with-p " ?" text)
(sbcli::symbol-documentation (last-nested-expr text)))
;; Interactive and visual shell command?
;; They are now handled by Clesh.
;; When on a non "dumb" terminal, all shell commands are run interactively.
;; No need to check for a "!" in the input here,
;; it's done with the clesh readtable when handling lisp.
;; Default: run the lisp command (with the lisp-critic, the shell passthrough
;; and other add-ons).
(t
(sbcli::handle-input txt text)))
(finish-output nil)
(format t "~&")
(sbcli::sbcli "" *prompt*)))
(defun edit-current-input (arg key)
;; experimental, doesn't properly work.
(declare (ignore arg key))
(let ((filename "/tmp/ciel-temp.lisp")
(current-input rl:*line-buffer*))
(str:to-file filename current-input)
(magic-ed filename)
;; ... user writes...
;; (NB: rl:replace-line preserves the point position and that's annoying)
;; (setf rl:*line-buffer* (str:trim (str:from-file filename)))
;; (rl:redisplay)
;; (rl:delete-text 0 rl:+end+)
(uiop:format! t "text is: ~a~&" (str:from-file filename))
;; (rl:insert-text (str:concat "hello" (str:trim (str:from-file filename))))
(setf rl:*line-buffer* (str:trim (str:from-file filename)))
(rl:redisplay)
))
(defun repl (&key noinform no-usernit)
"Toplevel REPL.
CLI options:
- -h, --help
- --noinform: don't print the welcome banner.
- --no-userinit: don't load the user's cielrc init file.
"
(let ((argv (uiop:command-line-arguments)))
(when (or (member "-h" argv :test #'string-equal)
(member "--help" argv :test #'string-equal))
(format t "~a version ~a~%" *repl-name* *repl-version*)
(format t "Contribute on: https://github.com/ciel-lang/CIEL~&")
(print-system-info)
(format t "CIEL Is an Extended Lisp. It's Common Lisp, batteries included.~&~
It comes in the form of a Quicklisp library that you can use as any other one in your favourite editor, ~
as an SBCL core image and as a readline REPL, with developer goodies.~&")
(uiop:quit)))
(rl:register-function :complete #'custom-complete)
(rl:register-function :redisplay #'syntax-hl)
;; testing…
(defun print-some-text (arg key)
(declare (ignore arg key))
(rl:insert-text "inserted text"))
#+(or)
(rl:bind-keyseq "\\C-o" #'print-some-text)
(rl:bind-keyseq "\\C-x\\C-e" #'edit-current-input)
(rl:set-paren-blink-timeout 500)
;; Print a banner and system info.
;; Checking a CLI arg this way is an old, done before our use of Clingon.
(unless (or noinform
(member "--noinform" (uiop:command-line-arguments) :test #'string-equal))
(princ *banner*)
(write-line (str:repeat 80 "-"))
(print-system-info)
(write-line (str:repeat 80 "-"))
(help)
(write-char #\linefeed)
(finish-output nil))
;; Load CIEL's user init file.
(unless (or no-usernit
(member "--no-userinit" (uiop:command-line-arguments) :test #'string-equal))
(when (uiop:file-exists-p *init-file*)
(load-init-file)))
(when *hist-file* (read-hist-file))
(in-package :ciel-user)
;; Enable Clesh, only for the readline REPL,
;; part because we don't want to clutter the ciel-user package,
;; part because Clesh is buggy for us on Slime (!! and [...]).
;; We get the ! pass-through shell:
;; !ls
;; as well as [ ... ] on multilines.
;; Beware: the double bang !! doesn't work. See issues.
(named-readtables:in-readtable clesh:syntax)
(handler-case (sbcli::sbcli "" sbcli::*prompt*)
(error (c)
;; Normally lisp code is evaled and protected from errors in evaluate-lisp.
;; We need this for magic-ed.
;; As a special command it doesn't use evaluate-lisp.
(format *error-output* "~&Error: ~a~&" c)
(sbcli::sbcli "" sbcli::*prompt*))
(sb-sys:interactive-interrupt ()
(sbcli::end))))
;; When trying it out with --script:
;; (repl)