X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/blobdiff_plain/a567a3bce51edcee4bd83afd9eea82ea42b2ce1f..88867b1a56e50b1a208b052dd75451143f92b7ae:/frontend.lisp diff --git a/frontend.lisp b/frontend.lisp index 46c5a36..f957601 100644 --- a/frontend.lisp +++ b/frontend.lisp @@ -1,7 +1,5 @@ ;;; -*-lisp-*- ;;; -;;; $Id$ -;;; ;;; Zone generator frontend ;;; ;;; (c) 2005 Straylight/Edgeware @@ -24,7 +22,9 @@ ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (defpackage #:zone.frontend - (:use #:common-lisp #:optparse #:net #:zone) + (:use #:common-lisp #:mdw.sys-base #:optparse #:net #:zone + #+cmu #:mop + #+sbcl #:sb-mop) (:export #:main)) (in-package #:zone.frontend) @@ -33,9 +33,28 @@ (defvar opt-zones nil (defvar opt-format :bind "Which format to use on output.") +(defun directory-exists-p (name) + + ;; Make a pathname for NAME which has the right form for a directory. + (let ((dirpath + (let ((path (pathname name))) + (if (null (pathname-name path)) + path + (make-pathname :directory + (append (or (pathname-directory path) + (list :relative)) + (list (pathname-name path))) + :name nil + :type nil + :defaults path))))) + + ;; Now check that it exists. + #+clisp (and (ext:probe-directory dirpath) (truename dirpath)) + #-clisp (probe-file dirpath))) + (eval-when (:compile-toplevel :load-toplevel) (defopthandler dir (var arg) () - (let ((path (probe-file arg))) + (let ((path (directory-exists-p arg))) (if (and path (not (pathname-name path))) (setf var path) @@ -60,20 +79,21 @@ (define-program (keyword opt-format (delete-duplicates (loop for method in - (pcl:generic-function-methods + (generic-function-methods #'zone:zone-write) for specs = - (pcl:method-specializers method) + (method-specializers method) if (typep (car specs) - 'pcl:eql-specializer) + 'eql-specializer) collect - (pcl:eql-specializer-object + (eql-specializer-object (car specs))))) "Format to use for output.") (#\z "zone" (:arg "NAME") (list opt-zones) "Write information about zone NAME."))) (defun main () + (set-command-line-arguments) (with-unix-error-reporting () (let ((files nil)) (unless (option-parse-try