X-Git-Url: http://git.kpe.io/?p=lml.git;a=blobdiff_plain;f=downloads.lisp;h=d78f776ffcee171a3d52b6804c186a1ba5671f34;hp=8cd2e32ec2f9c0ad6463bdff7836d4d2131041b0;hb=2dcfda178f817bec62b9f51248d96799d254d686;hpb=207af41acdbd2225c5d3210c991be8ab2835280f diff --git a/downloads.lisp b/downloads.lisp index 8cd2e32..d78f776 100644 --- a/downloads.lisp +++ b/downloads.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: downloads.cl +;;;; Name: downloads.lisp ;;;; Purpose: Generate downloads page ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Aug 2002 ;;;; -;;;; $Id: downloads.lisp,v 1.8 2003/02/03 00:43:36 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -16,8 +16,7 @@ ;;;; (http://www.gnu.org/licenses/gpl.html) ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :lml) +(in-package #:lml) (defvar *dl-base*) @@ -70,7 +69,7 @@ (defun display-footer () (when *signed* (lml-princ "

GPG Public Key

") - (lml-princ "Use this key to verify file signtatures")) + (lml-princ "Use this key to verify file signtatures")) (lml-princ "")) (defun print-sect-title (title) @@ -79,40 +78,38 @@ (defun match-base-name? (name) (let ((len-base-name (length *base-name*))) (when (>= (length name) len-base-name) - (dotimes (i len-base-name) - (declare (fixnum i)) - (unless (char= (char *base-name* i) - (char name i)) - (return-from match-base-name? nil))))) - t) + (string= name *base-name* :end1 len-base-name :end2 len-base-name)))) + +(defun match-base-name-latest? (name) + (let* ((latest (concatenate 'string *base-name* "-latest")) + (len-latest (length latest))) + (when (>= (length name) len-latest) + (string= name latest :end1 len-latest :end2 len-latest)))) (defun filter-against-base (files) - (let ((filtered '())) - (dolist (f files) - (let ((name (pathname-name f))) - (when (match-base-name? name) - (push f filtered)))) - (when filtered - (sort filtered #'(lambda (a b) (when (and a b) - (string< - (namestring a) - (namestring b)))))))) + (delete-if-not #'(lambda (f) (match-base-name? (pathname-name f))) files)) + +(defun filter-latest (files) + (delete-if #'(lambda (f) (match-base-name-latest? (pathname-name f))) files)) + +(defun sort-pathnames (list) + (sort list #'(lambda (a b) (string< (namestring a) (namestring b))))) (defun display-one-section (title pat) - (let ((files (filter-against-base (directory pat)))) + (let ((files (sort-pathnames (filter-latest + (filter-against-base (directory pat)))))) (when files (print-sect-title title) (lml-princ "
") (list-files files) (lml-princ "
")))) - (defun display-sections (sects) (when sects (let ((title (car sects)) (value (cadr sects))) (if (consp title) - (map nil #'display-sections sects) + (dolist (sect sects) (display-sections sect)) (if (consp value) (progn (print-sect-title title)