From 37624f5d0755676f834ab17c373c711689b04e9f Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 28 Jun 2003 08:18:21 +0000 Subject: [PATCH] r5213: *** empty log message *** --- 2/utils.lisp | 165 ++++++++++++++++++++++++++------------------------- 1 file changed, 83 insertions(+), 82 deletions(-) diff --git a/2/utils.lisp b/2/utils.lisp index 20f6a45..a275a3e 100644 --- a/2/utils.lisp +++ b/2/utils.lisp @@ -1,82 +1,83 @@ -;;; $Id: utils.lisp,v 1.1 2003/06/20 04:12:29 kevin Exp $ -;;;; -;;;; General purpose utilities - -(in-package #:lml2) - -(defmacro aif (test then &optional else) - `(let ((it ,test)) - (if it ,then ,else))) - -(defmacro awhen (test-form &body body) - `(aif ,test-form - (progn ,@body))) - -(defun keyword-symbol? (x) - "Returns T if object is a symbol in the keyword package" - (and (symbolp x) - (string-equal "keyword" (package-name (symbol-package x))))) - -(defun list-to-spaced-string (list) - (format nil "~{~A~^ ~}" list)) - -(defun print-n-chars (char n stream) - (declare (fixnum n) - (optimize (speed 3) (safety 0) (space 0))) - (do ((i 0 (1+ i))) - ((= i n) char) - (declare (fixnum i)) - (write-char char stream))) - -(defun indent-spaces (n &optional (stream *standard-output*)) - "Indent n*2 spaces to output stream" - (print-n-chars #\space (+ n n) stream)) - -(defun print-file-contents (file &optional (strm *standard-output*)) - "Opens a reads a file. Returns the contents as a single string" - (when (probe-file file) - (with-open-file (in file :direction :input) - (do ((line (read-line in nil 'eof) - (read-line in nil 'eof))) - ((eql line 'eof)) - (write-string line strm) - (write-char #\newline strm))))) - -(defun date-string (ut) - (check-type ut integer) - (multiple-value-bind (sec min hr day mon year dow daylight-p zone) - (decode-universal-time ut) - (declare (ignore daylight-p zone)) - (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" - dow day (1- mon) year hr min sec))) - -(defun lml-quit (&optional (code 0)) - "Function to exit the Lisp implementation." - #+allegro (excl:exit code) - #+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code) - #+(or cmu scl) (ext:quit code) - #+cormanlisp (win32:exitprocess code) - #+gcl (lisp:bye code) - #+lispworks (lw:quit :status code) - #+lucid (lcl:quit code) - #+sbcl (sb-ext:quit :unix-status (typecase code (number code) (null 0) (t 1))) - #+openmcl (ccl:quit code) - #+(and mcl (not openmcl)) (declare (ignore code)) - #+(and mcl (not openmcl)) (ccl:quit) - #-(or allegro clisp cmu scl cormanlisp gcl lispworks lucid sbcl mcl) - (error 'not-implemented :proc (list 'quit code))) - - -(defun lml-cwd () - "Returns the current working directory. Based on CLOCC's DEFAULT-DIRECTORY function." - #+allegro (excl:current-directory) - #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory) - #+(or cmu scl) (ext:default-directory) - #+cormanlisp (ccl:get-current-directory) - #+lispworks (hcl:get-working-directory) - #+lucid (lcl:working-directory) - #+sbcl (sb-unix:posix-getcwd/) - #+mcl (ccl:mac-default-directory) - #-(or allegro clisp cmu scl sbcl cormanlisp lispworks lucid mcl) (truename ".")) - - +;;; $Id: utils.lisp,v 1.2 2003/06/28 08:18:21 kevin Exp $ +;;;; +;;;; General purpose utilities + +(in-package #:lml2) + +(defmacro aif (test then &optional else) + `(let ((it ,test)) + (if it ,then ,else))) + +(defmacro awhen (test-form &body body) + `(aif ,test-form + (progn ,@body))) + +(defun keyword-symbol? (x) + "Returns T if object is a symbol in the keyword package" + (and (symbolp x) + (string-equal "keyword" (package-name (symbol-package x))))) + +(defun list-to-spaced-string (list) + (format nil "~{~A~^ ~}" list)) + +(defun print-n-chars (char n stream) + (declare (fixnum n) + (optimize (speed 3) (safety 0) (space 0))) + (do ((i 0 (1+ i))) + ((= i n) char) + (declare (fixnum i)) + (write-char char stream))) + +(defun indent-spaces (n &optional (stream *standard-output*)) + "Indent n*2 spaces to output stream" + (print-n-chars #\space (+ n n) stream)) + +(defun print-file-contents (file &optional (strm *standard-output*)) + "Opens a reads a file. Returns the contents as a single string" + (when (probe-file file) + (let ((eof (cons 'eof nil))) + (with-open-file (in file :direction :input) + (do ((line (read-line in nil eof) + (read-line in nil eof))) + ((eq line eof)) + (write-string line strm) + (write-char #\newline strm)))))) + +(defun date-string (ut) + (check-type ut integer) + (multiple-value-bind (sec min hr day mon year dow daylight-p zone) + (decode-universal-time ut) + (declare (ignore daylight-p zone)) + (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" + dow day (1- mon) year hr min sec))) + +(defun lml-quit (&optional (code 0)) + "Function to exit the Lisp implementation." + #+allegro (excl:exit code) + #+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code) + #+(or cmu scl) (ext:quit code) + #+cormanlisp (win32:exitprocess code) + #+gcl (lisp:bye code) + #+lispworks (lw:quit :status code) + #+lucid (lcl:quit code) + #+sbcl (sb-ext:quit :unix-status (typecase code (number code) (null 0) (t 1))) + #+openmcl (ccl:quit code) + #+(and mcl (not openmcl)) (declare (ignore code)) + #+(and mcl (not openmcl)) (ccl:quit) + #-(or allegro clisp cmu scl cormanlisp gcl lispworks lucid sbcl mcl) + (error 'not-implemented :proc (list 'quit code))) + + +(defun lml-cwd () + "Returns the current working directory. Based on CLOCC's DEFAULT-DIRECTORY function." + #+allegro (excl:current-directory) + #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory) + #+(or cmu scl) (ext:default-directory) + #+cormanlisp (ccl:get-current-directory) + #+lispworks (hcl:get-working-directory) + #+lucid (lcl:working-directory) + #+sbcl (sb-unix:posix-getcwd/) + #+mcl (ccl:mac-default-directory) + #-(or allegro clisp cmu scl sbcl cormanlisp lispworks lucid mcl) (truename ".")) + + -- 2.34.1