From: Kevin M. Rosenberg Date: Tue, 3 Feb 2004 18:32:50 +0000 (+0000) Subject: r8596: lml2 rework X-Git-Tag: v2.5.5~28 X-Git-Url: http://git.kpe.io/?p=lml.git;a=commitdiff_plain;h=49fe736edf268d7939ad36a550a232d7602d4cf9 r8596: lml2 rework --- diff --git a/2/apache-dir.lisp b/2/apache-dir.lisp index 0791fac..31c9d5c 100644 --- a/2/apache-dir.lisp +++ b/2/apache-dir.lisp @@ -31,6 +31,15 @@ ((:a :href link) (:princ (string-maybe-shorten name *apache-name-width*)))) (write-name-trailing-spaces stream name)) +(defun universal-time-to-apache-date (utime) + (multiple-value-bind + (second minute hour day-of-month month year day-of-week daylight-p zone) + (decode-universal-time utime) + (declare (ignore second day-of-week daylight-p zone)) + (format nil + (formatter "~2,'0D-~3/kmrcl::monthname/-~4,'0D ~2,'0D:~2,'0D") + day-of-month month year hour minute))) + (defun sort-dir-entries (entries sort-field direct) (case sort-field (:name @@ -65,17 +74,17 @@ (let* ((query (when query-string (split-uri-query-string query-string))) (sort-field (if query (cond - ((string-equal (caar query) "N") :name) - ((string-equal (caar query) "M") :modified) - ((string-equal (caar query) "S") :size) - ((string-equal (caar query) "D") :description) - (t :name)) - :name)) + ((string-equal (caar query) "N") :name) + ((string-equal (caar query) "M") :modified) + ((string-equal (caar query) "S") :size) + ((string-equal (caar query) "D") :description) + (t :name)) + :name)) (dir (cond - ((and query (string-equal (cdr (first query)) "D") :desc)) - (t :asc)))) + ((and query (string-equal (cdr (first query)) "D") :desc)) + (t :asc)))) (setq entries (sort-dir-entries entries sort-field dir)) - + (html-stream stream "" @@ -151,13 +160,13 @@ (case (car entry) (:dir (format nil "~Afolder.png" icon-base)) (:text (format nil "~Atext.png" icon-base)) - (t (format nil "~Af.png" icon-base))] + (t (format nil "~Af.png" icon-base))) :alt (case (car entry) (:dir "[DIR]") (:text "[TXT]") (t "[FIL]")))))) - " " + " " (write-name-link stream (second entry) (third entry)) " " (:princ (universal-time-to-apache-date (fourth entry))) diff --git a/2/debian/control b/2/debian/control index 3674500..d2e4531 100644 --- a/2/debian/control +++ b/2/debian/control @@ -7,7 +7,7 @@ Standards-Version: 3.6.0 Package: cl-lml2 Architecture: all -Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37) +Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37), cl-kmrcl Description: Lisp Markup Language LML2 provides a markup language for generation XHTML web pages. . diff --git a/2/doc/readme.lml b/2/doc/readme.lml index 1c9fa43..3fe668f 100644 --- a/2/doc/readme.lml +++ b/2/doc/readme.lml @@ -30,6 +30,11 @@ "The home page for LML2 is " ((:a :href "http://lml2.b9.com/") "http://lml2.b9.com/") ".") + + (:h2 "Prerequisites") + (:ul + (:li ((:a :href "http://cliki.net/asdf") "ASDF")) + (:li ((:a :href "http://cliki.net/kmrcl") "KMRCL"))) (:h2 "Differences between LML2 and LML") (:p "The syntax and HTML generation for LML2 are based on Franz's htmlgen macro. Personally, I like the syntax of LML better than LML2, but there are advantages of Franz's approach:") diff --git a/2/lml2.asd b/2/lml2.asd index d40d7fd..9d95bde 100644 --- a/2/lml2.asd +++ b/2/lml2.asd @@ -28,6 +28,8 @@ :licence "GNU General Public License" :description "Lisp Markup Language" :long-description "LML2 provides creation of XHTML for Lisp programs." + + :depends-on (kmrcl) :components ((:file "package") diff --git a/2/package.lisp b/2/package.lisp index e7bd839..a1a4420 100644 --- a/2/package.lisp +++ b/2/package.lisp @@ -17,7 +17,7 @@ (in-package #:cl-user) (defpackage #:lisp-markup-language-2 - (:use #:common-lisp) + (:use #:common-lisp #:kmrcl) (:nicknames #:lml2) (:export diff --git a/2/utils.lisp b/2/utils.lisp index 2d2a9d8..16f3e26 100644 --- a/2/utils.lisp +++ b/2/utils.lisp @@ -16,71 +16,14 @@ (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 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))) - + (kmrcl: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 ".")) - - -#+ignore -(defun fformat (&rest args) - (declare (dynamic-extent args)) - (apply (if (find-package 'kmrcl) - (symbol-function (intern (symbol-name #:fformat) - (symbol-name #:kmrcl))) - #'format) - args)) + "Returns the current working directory." + (kmrcl:cwd)) (defmacro fformat (stream control-string &rest args) (if stream