X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=2%2Fdownloads.lisp;fp=2%2Fdownloads.lisp;h=2b977c355b8c79ed0baf1aaa6611c022309974e6;hb=096b456fe920373f3b54fbe47f10f3e41c4fe925;hp=0000000000000000000000000000000000000000;hpb=9191a298494fa0128d7633518d63c566622bee63;p=lml.git diff --git a/2/downloads.lisp b/2/downloads.lisp new file mode 100644 index 0000000..2b977c3 --- /dev/null +++ b/2/downloads.lisp @@ -0,0 +1,168 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: downloads.lisp +;;;; Purpose: Generate downloads page +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: Aug 2002 +;;;; +;;;; $Id: downloads.lisp,v 1.1 2003/06/20 04:12:29 kevin Exp $ +;;;; +;;;; This file, part of LML2, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; +;;;; 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) + +(defun list-files (files) + "List files in a directory for downloading" + ;;files.sort() + (mapcar #'print-file files)) + +(defun strip-dl-base (file) + (let ((fdir (pathname-directory file)) + (bdir (pathname-directory *dl-base*))) + (make-pathname + :name (pathname-name file) + :type (pathname-type file) + :directory + (when (> (length fdir) (length bdir)) + (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"))) + (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) + (lml-princ "") + (lml-format " (~A, ~:D KB)" modtime size) + (when (probe-file sig-path) + (setq *signed* t) + (lml-format " [Signature]" *dl-url* dl-name)) + (html :br)))) + +(defun display-header (name url) + (lml-princ "