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