CLI Extension - :q

diff --git a/src/main/cli.lisp b/src/main/cli.lisp
index fe895e290ebf2bc735db8b4a253278bd612198d5..1aeb746c3b4b2c3842531bf2c6d222e5a1ad45bb 100644 (file)
--- a/src/main/cli.lisp
+++ b/src/main/cli.lisp
@@ -23,7 +23,6 @@ DESCRIPTION:
  (loop
   :for str := (cffi:with-foreign-pointer-as-string (str 255) (wgetnstr *cli* str 255))
   :while str
-  :while (and (string/= str "q") (string/= str "Q"))
   :do (print-command-and-response str (execute str)))
  (endwin)
  (sb-ext:exit :abort t))
@@ -85,7 +84,7 @@ DESCRIPTION:
   implementation of NetLogo.
   
   You can enter in various netlogo commands below,
-  or use q to quit the program.
+  or use :q to quit the program.
   
   See http://github.com/frankduncan/clnl for more
   information about CLNL and to keep apprised of

diff --git a/src/main/extensions/cli/cli.lisp b/src/main/extensions/cli/cli.lisp
index 843cf01463e7493b5b9f8784d549db3c63cc2d0b..84533918e1e49c6156f501a7f050d9348f927a2d 100644 (file)
--- a/src/main/extensions/cli/cli.lisp
+++ b/src/main/extensions/cli/cli.lisp
@@ -10,4 +10,9 @@ ARGUMENTS AND VALUES:
 DESCRIPTION:
 
   PRIMS returns the primitives used in the CLI extension."
- nil)
+ (list
+  (list :name :q :type :command :func #'shut-down)))
+
+(defun shut-down ()
+ (cl-charms/low-level:endwin)
+ (sb-ext:exit :abort t))

diff --git a/src/main/main.lisp b/src/main/main.lisp
index 0997963960d63dff7d1b8d51ec73ea96b118ed2d..48c3c58c59d5cf82534eb368c4fc6355478bfee2 100644 (file)
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -29,6 +29,8 @@ DESCRIPTION:
  (sb-thread:make-thread #'clnl-cli:run)
  (clnl-interface:run))
 
+(defvar *callback* nil)
+
 (defun boot (&optional file headless-mode)
  "BOOT &optional FILE HEADLESS-MODE => RESULT
 
@@ -51,7 +53,8 @@ DESCRIPTION:
   ((netlogoed-lisp
     (model->single-form-lisp
      (if file (with-open-file (str file) (clnl-model:read-from-nlogo str)) (clnl-model:default-model))
-     :initialize-interface (not headless-mode)))
+     :initialize-interface (not headless-mode)
+     :netlogo-callback (lambda (f) (setf *callback* f))))
    (*package* *model-package*))
   (eval netlogoed-lisp)))
 
@@ -67,7 +70,8 @@ DESCRIPTION:
 
   RUN-COMMANDS will take NetLogo commands, put them through the various
   stages need to turn them into Common Lisp code, and run it."
- (clnl-nvm:with-stop-handler (eval (clnl-transpiler:transpile (clnl-parser:parse (clnl-lexer:lex cmds))))))
+ (clnl-nvm:with-stop-handler
+  (funcall *callback* cmds)))
 
 (defun run-reporter (reporter)
  "RUN-REPORTER REPORTER => RESULT