X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=apache-dir.lisp;h=9cd155a5380080ef69c131f8384d32e2603f62d8;hb=036f2ad6ffbed292636d817949b1436cfd6f8fdf;hp=0791fac690a41029c7987b63618f3ce443b634a9;hpb=91da637a38b3a1f38d0bf25b2e3584b80400664f;p=lml2.git diff --git a/apache-dir.lisp b/apache-dir.lisp index 0791fac..9cd155a 100644 --- a/apache-dir.lisp +++ b/apache-dir.lisp @@ -31,51 +31,60 @@ ((: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 (sort entries - (lambda (a b) - (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp) - (aif (third a) it "") - (aif (third b) it ""))))) + (lambda (a b) + (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp) + (aif (third a) it "") + (aif (third b) it ""))))) (:modified (sort entries - (lambda (a b) - (funcall (if (eq direct :asc) #'< #'>) - (aif (fourth a) it 0) - (aif (fourth b) it 0))))) + (lambda (a b) + (funcall (if (eq direct :asc) #'< #'>) + (aif (fourth a) it 0) + (aif (fourth b) it 0))))) (:size (sort entries - (lambda (a b) - (funcall (if (eq direct :asc) #'< #'>) - (aif (fifth a) it 0) - (aif (fifth b) it 0))))) + (lambda (a b) + (funcall (if (eq direct :asc) #'< #'>) + (aif (fifth a) it 0) + (aif (fifth b) it 0))))) (:description (sort entries - (lambda (a b) - (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp) - (aif (sixth a) it "") - (aif (sixth b) it ""))))) + (lambda (a b) + (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp) + (aif (sixth a) it "") + (aif (sixth b) it ""))))) (t entries))) - + (defun write-html-apache-directory (stream title entries this-url &key parent address query-string - icon-base) + icon-base) (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)) - (dir (cond - ((and query (string-equal (cdr (first query)) "D") :desc)) - (t :asc)))) + (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)) + (dir (cond + ((and query (string-equal (cdr (first query)) "D") :desc)) + (t :asc)))) (setq entries (sort-dir-entries entries sort-field dir)) - + (html-stream stream "" @@ -89,100 +98,100 @@ ((:body :bgcolor "#FFFFFF" :text "#000000") :newline (:table - (:tr - ((:td :bgcolor "#FFFFFF" :class "title") - ((:font :size "+3" :face "Hevetica,Arial,sans-serif") - (:b (:princ title)))))) + (:tr + ((:td :bgcolor "#FFFFFF" :class "title") + ((:font :size "+3" :face "Hevetica,Arial,sans-serif") + (:b (:princ title)))))) :newline (:pre - (when icon-base - (html-stream - stream - ((:img :border "0" - :src (format nil "~Ablank.png" icon-base) - :alt " ")))) - " " - ((:a :href (format nil "~A?N=~A" this-url - (if (and (eq sort-field :name) (eq dir :asc)) - "D" "A"))) - "Name") - (:princ (format nil "~20A" "")) - " " - ((:a :href (format nil "~A?M=~A" this-url - (if (and (eq sort-field :modified) (eq dir :asc)) - "D" "A"))) - "Last modified") - " " - ((:a :href (format nil "~A?S=~A" this-url - (if (and (eq sort-field :size) (eq dir :asc)) - "D" "A"))) - "Size") - " " - ((:a :href (format nil "~A?D=~A" this-url - (if (and (eq sort-field :description) (eq dir :asc)) - "D" "A"))) - "Description") - :newline - (:princ "