1 ;;; $Id: utils.lisp,v 1.1 2003/06/20 04:12:29 kevin Exp $
3 ;;;; General purpose utilities
7 (defmacro aif (test then &optional else)
11 (defmacro awhen (test-form &body body)
15 (defun keyword-symbol? (x)
16 "Returns T if object is a symbol in the keyword package"
18 (string-equal "keyword" (package-name (symbol-package x)))))
20 (defun list-to-spaced-string (list)
21 (format nil "~{~A~^ ~}" list))
23 (defun print-n-chars (char n stream)
25 (optimize (speed 3) (safety 0) (space 0)))
29 (write-char char stream)))
31 (defun indent-spaces (n &optional (stream *standard-output*))
32 "Indent n*2 spaces to output stream"
33 (print-n-chars #\space (+ n n) stream))
35 (defun print-file-contents (file &optional (strm *standard-output*))
36 "Opens a reads a file. Returns the contents as a single string"
37 (when (probe-file file)
38 (with-open-file (in file :direction :input)
39 (do ((line (read-line in nil 'eof)
40 (read-line in nil 'eof)))
42 (write-string line strm)
43 (write-char #\newline strm)))))
45 (defun date-string (ut)
46 (check-type ut integer)
47 (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
48 (decode-universal-time ut)
49 (declare (ignore daylight-p zone))
50 (format nil "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~2,'0d:~2,'0d:~2,'0d"
51 dow day (1- mon) year hr min sec)))
53 (defun lml-quit (&optional (code 0))
54 "Function to exit the Lisp implementation."
55 #+allegro (excl:exit code)
56 #+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code)
57 #+(or cmu scl) (ext:quit code)
58 #+cormanlisp (win32:exitprocess code)
60 #+lispworks (lw:quit :status code)
61 #+lucid (lcl:quit code)
62 #+sbcl (sb-ext:quit :unix-status (typecase code (number code) (null 0) (t 1)))
63 #+openmcl (ccl:quit code)
64 #+(and mcl (not openmcl)) (declare (ignore code))
65 #+(and mcl (not openmcl)) (ccl:quit)
66 #-(or allegro clisp cmu scl cormanlisp gcl lispworks lucid sbcl mcl)
67 (error 'not-implemented :proc (list 'quit code)))
71 "Returns the current working directory. Based on CLOCC's DEFAULT-DIRECTORY function."
72 #+allegro (excl:current-directory)
73 #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
74 #+(or cmu scl) (ext:default-directory)
75 #+cormanlisp (ccl:get-current-directory)
76 #+lispworks (hcl:get-working-directory)
77 #+lucid (lcl:working-directory)
78 #+sbcl (sb-unix:posix-getcwd/)
79 #+mcl (ccl:mac-default-directory)
80 #-(or allegro clisp cmu scl sbcl cormanlisp lispworks lucid mcl) (truename "."))