r8224: add entities argument to dtd-prologue

[lml.git] / downloads.lisp

diff --git a/downloads.lisp b/downloads.lisp
index 8cd2e32ec2f9c0ad6463bdff7836d4d2131041b0..d78f776ffcee171a3d52b6804c186a1ba5671f34 100644 (file)
--- 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 "<h3>GPG Public Key</h3>")
-    (lml-princ "Use this <a href=\"https://www.b9.com/key.asc\">key</a> to verify file signtatures"))
+    (lml-princ "Use this <a href=\"https://www.b9.com/kevin.gpg.asc\">key</a> to verify file signtatures"))
   (lml-princ "</div>"))
   
 (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 "<div style=\"padding-left: 20pt;\">")
       (list-files files)
       (lml-princ "</div>"))))
 
-
 (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)