/ app-utils.lisp
app-utils.lisp
 1  ;; -*-lisp-*-
 2  
 3  (defpackage :asteroid.app-utils
 4    (:use :cl)
 5    (:export :internal-disable-debugger)
 6    (:export :internal-quit
 7     :pht))
 8  
 9  (in-package :asteroid.app-utils)
10  
11  (defun pht (ht)
12    (alexandria:hash-table-alist ht))
13  
14  (defun internal-disable-debugger ()
15    (labels
16        ((internal-exit (c h)
17           (declare (ignore h))
18           (format t "~a~%" c)
19           (internal-quit)))
20      (setf *debugger-hook* #'internal-exit)))
21  
22  (defun internal-quit (&optional code)
23    "Taken from the cliki"
24    ;; This group from "clocc-port/ext.lisp"
25    #+allegro (excl:exit code)
26    #+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code)
27    #+cmu (ext:quit code)
28    #+cormanlisp (win32:exitprocess code)
29    #+gcl (lisp:bye code)                     ; XXX Or is it LISP::QUIT?
30    #+lispworks (lw:quit :status code)
31    #+lucid (lcl:quit code)
32    #+sbcl (sb-ext:exit :code code)
33    ;; This group from Maxima
34    #+kcl (lisp::bye)                         ; XXX Does this take an arg?
35    #+scl (ext:quit code)                     ; XXX Pretty sure this *does*.
36    #+(or openmcl mcl) (ccl::quit)
37    #+abcl (cl-user::quit)
38    #+ecl (si:quit)
39    ;; This group from <hebi...@math.uni.wroc.pl>
40    #+poplog (poplog::bye)                    ; XXX Does this take an arg?
41    #-(or allegro clisp cmu cormanlisp gcl lispworks lucid sbcl
42          kcl scl openmcl mcl abcl ecl)
43  
44    (error 'not-implemented :proc (list 'quit code)))