;;;; Programmer: Kevin M. Rosenberg based on Matthew Danish's code
;;;; Date Started: Nov 2002
;;;;
-;;;; $Id: api.lisp,v 1.1 2002/11/08 06:00:12 kevin Exp $
+;;;; $Id: api.lisp,v 1.2 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 2002 Matthew Danish
;;;; (http://www.gnu.org/licenses/gpl.html)
;;;; *************************************************************************
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :lml)
+(in-package #:lml)
;;; Copyright (c) 2002 Matthew Danish.
;;; All rights reserved.
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: base.lisp,v 1.15 2003/05/26 14:53:33 kevin Exp $
+;;;; $Id: base.lisp,v 1.16 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://www.gnu.org/licenses/gpl.html)
;;;; *************************************************************************
-(declaim (optimize (debug 3) (speed 3) (safety 3) (compilation-speed 0)))
-(in-package :lml)
+(in-package lml)
(defun html4-prologue-string ()
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">")
;;;; *************************************************************************
;;;; 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: downloads.lisp,v 1.9 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (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*)
(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)
(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 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 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-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)
;;;; (http://www.gnu.org/licenses/gpl.html)
;;;; *************************************************************************
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :lml)
+(in-package #:lml)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *output-dir* nil)
(defun lml-load-path (file)
(if (probe-file file)
(with-open-file (in file :direction :input)
- (do ((form (read in nil 'lml::eof) (read in nil 'lml::eof)))
- ((eq form 'lml::eof))
+ (do ((form (read in nil 'eof) (read in nil 'eof)))
+ ((eq form 'eof))
(eval form)))
(format *trace-output* "Warning: unable to load LML file ~S" file)))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: lml.asd,v 1.14 2003/04/19 03:56:40 kevin Exp $
+;;;; $Id: lml.asd,v 1.15 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://www.gnu.org/licenses/gpl.html)
;;;; *************************************************************************
-(in-package :asdf)
+(in-package #:cl-user)
+(defpackage #:lml-system (:use #:asdf #:cl))
+(in-package #:lml-system)
-(defsystem :lml
- :name "cl-lml"
+(defsystem lml
+ :name "lml"
:author "Kevin M. Rosenberg <kevin@rosenberg.net>"
- :version "2.4.0"
+ :version "2.4"
:maintainer "Kevin M. Rosenberg <kmr@debian.org>"
:licence "GNU General Public License"
:description "Lisp Markup Language"
(:file "downloads" :depends-on ("base"))
))
-
-
-
+(defmethod perform ((o test-op) (c (eql (find-system 'lml))))
+ (operate 'load-op 'lml-tests)
+ (operate 'test-op 'lml-tests))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: package.lisp,v 1.5 2003/05/26 14:53:33 kevin Exp $
+;;;; $Id: package.lisp,v 1.6 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://www.gnu.org/licenses/gpl.html)
;;;; *************************************************************************
-(in-package :cl-user)
+(in-package cl-user)
-(defpackage #:lisp-markup-language
+(defpackage lisp-markup-language
(:use #:common-lisp)
(:nicknames #:lml)
(:export
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: read-macro.lisp,v 1.1 2003/04/27 17:53:16 kevin Exp $
+;;;; $Id: read-macro.lisp,v 1.2 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://www.gnu.org/licenses/gpl.html)
;;;; *************************************************************************
-(declaim (optimize (debug 3) (speed 3) (safety 3) (compilation-speed 0)))
-(in-package :lml)
+(in-package #:lml)
(set-macro-character #\[
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: stdsite.cl
+;;;; Name: stdsite.lisp
;;;; Purpose: Functions to create my standard style sites
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: stdsite.lisp,v 1.3 2003/01/24 08:51:41 kevin Exp $
+;;;; $Id: stdsite.lisp,v 1.4 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;; content.lml_
;;; footer.lml_
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :lml)
+(in-package #:lml)
(defmacro std-head (title &body body)
`(head
-;;; $Id: utils.lisp,v 1.7 2003/03/12 17:01:48 kevin Exp $
+;;; $Id: utils.lisp,v 1.8 2003/06/06 21:59:30 kevin Exp $
;;;;
;;;; General purpose utilities
-(in-package :lml)
-
+(in-package #:lml)
(defmacro aif (test then &optional else)
`(let ((it ,test))
(string-equal "keyword" (package-name (symbol-package x)))))
(defun list-to-spaced-string (list)
- (if (consp list)
- (format nil "~A~{ ~A~}" (first list) (rest list))
- ""))
+ (format nil "~{~A~^ ~}" list))
+(defun print-n-chars (char n stream)
+ (declare (fixnum n)
+ (optimize (speed 3) (safety 0) (space 0)))
+ (do ((i 0 (1+ i)))
+ ((= i n) char)
+ (declare (fixnum i))
+ (write-char char stream)))
+
(defun indent-spaces (n &optional (stream *standard-output*))
"Indent n*2 spaces to output stream"
- (let ((fmt (format nil "~~~DT" (+ n n))))
- (format stream fmt)))
+ (print-n-chars #\space (+ n n) stream))
(defun print-file-contents (file &optional (strm *standard-output*))
"Opens a reads a file. Returns the contents as a single string"
(do ((line (read-line in nil 'eof)
(read-line in nil 'eof)))
((eql line 'eof))
- (format strm "~A~%" line)))))
+ (write-string line strm)
+ (write-char #\newline strm)))))
(defun date-string (ut)
- (if (typep ut 'integer)
- (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
- (decode-universal-time ut)
- (declare (ignore daylight-p zone))
- (format nil "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~2,'0d:~2,'0d:~2,'0d"
- dow
- day
- (1- mon)
- year
- hr min sec))))
+ (check-type ut integer)
+ (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
+ (decode-universal-time ut)
+ (declare (ignore daylight-p zone))
+ (format nil "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~2,'0d:~2,'0d:~2,'0d"
+ dow day (1- mon) year hr min sec)))
(defun lml-quit (&optional (code 0))
- "Function to exit the Lisp implementation. Copied from CLOCC's QUIT function."
+ "Function to exit the Lisp implementation."
#+allegro (excl:exit code)
#+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code)
#+(or cmu scl) (ext:quit code)
#+mcl (ccl:mac-default-directory)
#-(or allegro clisp cmu scl sbcl cormanlisp lispworks lucid mcl) (truename "."))
-
+
projects / lml.git / commitdiff