X-Git-Url: http://git.kpe.io/?p=lml2.git;a=blobdiff_plain;f=downloads.lisp;h=bac84bb967207cebff3faabb25a06f40aefccea7;hp=2b977c355b8c79ed0baf1aaa6611c022309974e6;hb=cd7657d502de822c899ad08d7e37dd6e778f3d26;hpb=a5621a5bf235313916f437a55d9998418ee26f5a diff --git a/downloads.lisp b/downloads.lisp index 2b977c3..bac84bb 100644 --- a/downloads.lisp +++ b/downloads.lisp @@ -7,162 +7,172 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Aug 2002 ;;;; -;;;; $Id: downloads.lisp,v 1.1 2003/06/20 04:12:29 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file, part of LML2, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg. +;;;; Rights of modification and redistribution are in the LICENSE file. ;;;; -;;;; LML2 users are granted the rights to distribute and use this software -;;;; as governed by the terms of the GNU General Public License v2 -;;;; (http://www.gnu.org/licenses/gpl.html) ;;;; ************************************************************************* (in-package #:lml2) -(defvar *dl-base*) -(defvar *dl-url*) -(defvar *base-name*) -(defvar *section-indent* 0) -(defvar *signed* nil) +(defstruct dl-data base url name indent signed) -(defun list-files (files) +(defun list-files (files dl-data) "List files in a directory for downloading" ;;files.sort() - (mapcar #'print-file files)) + (mapcar (lambda (f) (print-file f dl-data)) files)) -(defun strip-dl-base (file) +(defun strip-dl-base (file base) (let ((fdir (pathname-directory file)) - (bdir (pathname-directory *dl-base*))) + (bdir (pathname-directory 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))))))) - -(defun print-file (file) + (append '(:absolute) + (subseq fdir (length bdir) (length fdir))))))) + +(defun print-file (file dl-data) (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 (dl-data-base dl-data))) + (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)))) - (lml-format "~A" *dl-url* dl-name basename) + (setq size (round (/ (file-length strm) 1024)))) + (lml-format "~A" + (dl-data-url dl-data) 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)) + (setf (dl-data-signed dl-data) t) + (lml-format " [Signature]" + (dl-data-url dl-data) dl-name)) (html :br)))) (defun display-header (name url) (lml-princ "