X-Git-Url: http://git.kpe.io/?p=lml.git;a=blobdiff_plain;f=downloads.lisp;h=1005086716212078df37f04b997567b7d30187be;hp=d78f776ffcee171a3d52b6804c186a1ba5671f34;hb=5da5fb17e3c3e1c3a2fa289666e0f50dc3b223c4;hpb=f87e11ae126e3cb6ef60c0d0da93f9afdcd6e1f6 diff --git a/downloads.lisp b/downloads.lisp index d78f776..1005086 100644 --- a/downloads.lisp +++ b/downloads.lisp @@ -32,32 +32,32 @@ (defun strip-dl-base (file) (let ((fdir (pathname-directory file)) - (bdir (pathname-directory *dl-base*))) + (bdir (pathname-directory *dl-base*))) (make-pathname :name (pathname-name file) :type (pathname-type file) - :directory + :directory (when (> (length fdir) (length bdir)) - (append '(:absolute) - (subseq fdir (length bdir) (length fdir))))))) - + (append '(:absolute) + (subseq fdir (length bdir) (length fdir))))))) + (defun print-file (file) (let ((size 0) - (modtime (date-string (file-write-date file))) - (basename (namestring - (make-pathname :name (pathname-name file) - :type (pathname-type file)))) - (dl-name (strip-dl-base file)) - (sig-path (concatenate 'string (namestring file) ".asc"))) + (modtime (date-string (file-write-date file))) + (basename (namestring + (make-pathname :name (pathname-name file) + :type (pathname-type file)))) + (dl-name (strip-dl-base file)) + (sig-path (concatenate 'string (namestring file) ".asc"))) (when (plusp (length basename)) (with-open-file (strm file :direction :input) - (setq size (round (/ (file-length strm) 1024)))) + (setq size (round (/ (file-length strm) 1024)))) (lml-format "~A" *dl-url* dl-name basename) (lml-princ "") (lml-format " (~A, ~:D KB)" modtime size) (when (probe-file sig-path) - (setq *signed* t) - (lml-format " [Signature]" *dl-url* dl-name)) + (setq *signed* t) + (lml-format " [Signature]" *dl-url* dl-name)) (br)))) (defun display-header (name url) @@ -71,7 +71,7 @@ (lml-princ "

GPG Public Key

") (lml-princ "Use this key to verify file signtatures")) (lml-princ "")) - + (defun print-sect-title (title) (lml-format "~A" *section-indent* title *section-indent*)) @@ -82,7 +82,7 @@ (defun match-base-name-latest? (name) (let* ((latest (concatenate 'string *base-name* "-latest")) - (len-latest (length latest))) + (len-latest (length latest))) (when (>= (length name) len-latest) (string= name latest :end1 len-latest :end2 len-latest)))) @@ -97,7 +97,7 @@ (defun display-one-section (title pat) (let ((files (sort-pathnames (filter-latest - (filter-against-base (directory pat)))))) + (filter-against-base (directory pat)))))) (when files (print-sect-title title) (lml-princ "
") @@ -107,23 +107,23 @@ (defun display-sections (sects) (when sects (let ((title (car sects)) - (value (cadr sects))) + (value (cadr sects))) (if (consp title) - (dolist (sect sects) (display-sections sect)) - (if (consp value) - (progn - (print-sect-title title) - (incf *section-indent*) - (display-sections value) - (decf *section-indent*)) - (display-one-section title value)))))) - + (dolist (sect sects) (display-sections sect)) + (if (consp value) + (progn + (print-sect-title title) + (incf *section-indent*) + (display-sections value) + (decf *section-indent*)) + (display-one-section title value)))))) + (defun display-page (pkg-name pkg-base dl-base dl-url sects) (let ((*section-indent* 3) - (*dl-base* dl-base) - (*dl-url* dl-url) - (*base-name* pkg-base) - (*signed* nil)) + (*dl-base* dl-base) + (*dl-url* dl-url) + (*base-name* pkg-base) + (*signed* nil)) (display-header pkg-name dl-url) (map nil #'display-sections sects) (display-footer))) @@ -131,38 +131,38 @@ (defun std-dl-page (pkg-name pkg-base dl-base dl-url) (let ((base (parse-namestring dl-base))) (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild)) - (zip-path (make-pathname :defaults base :type "zip" :name :wild)) - (doc-path (make-pathname :defaults base :type "pdf" :name :wild))) + (zip-path (make-pathname :defaults base :type "zip" :name :wild)) + (doc-path (make-pathname :defaults base :type "pdf" :name :wild))) (display-page pkg-name pkg-base dl-base dl-url - `(("Manual" ,doc-path) - ("Source Code" - (("Unix (.tar.gz)" ,tgz-path) - ("Windows (.zip)" ,zip-path)))))))) - + `(("Manual" ,doc-path) + ("Source Code" + (("Unix (.tar.gz)" ,tgz-path) + ("Windows (.zip)" ,zip-path)))))))) + (defun full-dl-page (pkg-name pkg-base dl-base dl-url) (let ((base (parse-namestring dl-base))) (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild)) - (zip-path (make-pathname :defaults base :type "zip" :name :wild)) - (doc-path (make-pathname :defaults base :type "pdf" :name :wild)) - (deb-path (merge-pathnames - (make-pathname :directory '(:relative "linux-debian") - :type :wild :name :wild) - base)) - (rpm-path (merge-pathnames - (make-pathname :directory '(:relative "linux-rpm") - :type :wild :name :wild) - base)) - (w32-path (merge-pathnames - (make-pathname :directory '(:relative "win32") - :type :wild :name :wild) - base))) + (zip-path (make-pathname :defaults base :type "zip" :name :wild)) + (doc-path (make-pathname :defaults base :type "pdf" :name :wild)) + (deb-path (merge-pathnames + (make-pathname :directory '(:relative "linux-debian") + :type :wild :name :wild) + base)) + (rpm-path (merge-pathnames + (make-pathname :directory '(:relative "linux-rpm") + :type :wild :name :wild) + base)) + (w32-path (merge-pathnames + (make-pathname :directory '(:relative "win32") + :type :wild :name :wild) + base))) (display-page pkg-name pkg-base dl-base dl-url - `(("Manual" ,doc-path) - ("Source Code" - (("Unix (.tar.gz)" ,tgz-path) - ("Windows (.zip)" ,zip-path))) - ("Binaries" - (("Linux Binaries" - (("Debian Linux" ,deb-path) - ("RedHat Linux" ,rpm-path))) - ("Windows Binaries" ,w32-path)))))))) + `(("Manual" ,doc-path) + ("Source Code" + (("Unix (.tar.gz)" ,tgz-path) + ("Windows (.zip)" ,zip-path))) + ("Binaries" + (("Linux Binaries" + (("Debian Linux" ,deb-path) + ("RedHat Linux" ,rpm-path))) + ("Windows Binaries" ,w32-path))))))))