From: Frank Duncan <frank@kank.net>
Date: Sun, 15 May 2016 02:48:41 +0000 (-0500)
Subject: CLI Extension - :q
X-Git-Tag: v0.1.0~9
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=057ed8d;p=clnl

CLI Extension - :q
---

diff --git a/src/main/cli.lisp b/src/main/cli.lisp
index fe895e2..1aeb746 100644
--- 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 843cf01..8453391 100644
--- 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 0997963..48c3c58 100644
--- 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