/ 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)))