X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=files.lisp;h=fe3c4261a85004f4cd08d6245e728127ed979af5;hb=b9f59638a12167ca983c8989e48d162cc9f48772;hp=fd2366b3ff30961f8174128324b6541a2b7272d8;hpb=e741d288978f9a65554235ecb3115db8eef60b54;p=lml.git diff --git a/files.lisp b/files.lisp index fd2366b..fe3c426 100644 --- a/files.lisp +++ b/files.lisp @@ -14,8 +14,7 @@ ;;;; (http://www.gnu.org/licenses/gpl.html) ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :lml) +(in-package #:lml) (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *output-dir* nil) @@ -24,39 +23,44 @@ (defvar *html-output* *standard-output*) -(defmacro lml-file-name (file &optional (type :source)) - (let ((f file)) - (when (and (consp f) (eql (car f) 'cl:quote)) - (setq f (cadr f))) - (when (symbolp f) - (setq f (string-downcase (symbol-name f)))) - (when (stringp f) - (unless (position #\. f) - (setq f (concatenate 'string f ".html")))) - (if *sources-dir* - (make-pathname :defaults (ecase type - (:source *sources-dir*) - (:output *output-dir*)) - :name `,(pathname-name f) - :type `,(pathname-type f)) +(defun lml-file-name (f &optional (type :source)) + (when (and (consp f) (eql (car f) 'cl:quote)) + (setq f (cadr f))) + (when (symbolp f) + (setq f (string-downcase (symbol-name f)))) + (when (stringp f) + (unless (position #\. f) + (setq f (concatenate 'string f ".html")))) + (if *sources-dir* + (make-pathname :defaults (ecase type + (:source *sources-dir*) + (:output *output-dir*)) + :name (pathname-name f) + :type (pathname-type f)) (if (stringp f) - (parse-namestring f) - f)))) + (nth-value 0 (parse-namestring f)) + f))) -(defmacro with-dir ((output-dir &key sources) &body body) - (when (stringp output-dir) - (setq output-dir (parse-namestring output-dir))) - (unless sources - (setq sources output-dir)) - `(let ((*output-dir* ,output-dir) - (*sources-dir* ,sources)) - ,@body)) +(defmacro with-dir ((output &key sources) &body body) + (let ((output-dir (gensym)) + (sources-dir (gensym))) + `(let ((,output-dir ,output) + (,sources-dir ,sources)) + (when (stringp ,output-dir) + (setq ,output-dir (parse-namestring ,output-dir))) + (when (stringp ,sources-dir) + (setq ,sources-dir (parse-namestring ,sources-dir))) + (unless ,sources-dir + (setq ,sources-dir ,output-dir)) + (let ((*output-dir* ,output-dir) + (*sources-dir* ,sources-dir)) + ,@body)))) (defun lml-load-path (file) (if (probe-file file) (with-open-file (in file :direction :input) - (do ((form (read in nil 'lml::eof) (read in nil 'lml::eof))) - ((eq form 'lml::eof)) + (do ((form (read in nil 'eof) (read in nil 'eof))) + ((eq form 'eof)) (eval form))) (format *trace-output* "Warning: unable to load LML file ~S" file)))