+++ /dev/null
-.bin
-*.fasl*
-*.fas
-*.x86f
-*.ufsl
-*.dfsl
-*.fsl
-*.cfsl
-*.x86f
-*.sparcf
-
+++ /dev/null
-2006-11-07 Kevin M. Rosenberg <kevin@rosenberg.net>
- * Version 1.6.1
- * apache-dir.lisp: Image source link fix -- thanks to Matthew Kennedy
-
-2006-11-07 Kevin M. Rosenberg <kevin@rosenberg.net>
- * Version 1.6.0
- * stdstite.lisp, files.lisp: Add optional final and rightcol files
-
-
-2006-01-17 Kevin M. Rosenberg <kevin@rosenberg.net>
- * cl-lml2.asd: Apply modified patch from Gary King
- so that asdf:test-op always performs test.
-
-2005-09-03 Kevin M. Rosenberg <kevin@rosenberg.net>
- * files.lisp: Apply patch from Gary King to
- identify output files
-
-2003-07-21 Kevin M. Rosenberg <kevin@rosenberg.net>
- * htmlgen.lisp:
- - Add code walker to combine sequential write-string
- calls
-
-2003-07-15 Kevin M. Rosenberg <kevin@rosenberg.net>
- * htmlgen.lisp:
- - Finished removal of if* macro
- - Added attribute processing tags
- (:if :when :optional :format :fformat)
- - Ensured that attribute values are quoted
- (html ((:div width 5))) => <div width="5"></div>
- * lml2.asd: Remove ifstar.lisp
- * tests.lisp:
- - Port tests from first LML package
- - Add tests for new features
-
-
+++ /dev/null
-LML2 is written and Copyright (c) 2000-2003 by Kevin M. Rosenberg
-with portions Copyright (c) 1986-2003 by Franz, Inc.
-
-LML is licensed under the terms of the Lisp Lesser GNU Public
-License, known as the LLGPL. The LLGPL consists of a preamble (see
-below) and the Lessor GNU Public License 2.1 (LGPL-2.1). Where these
-conflict, the preamble takes precedence. LML2 is referenced in the
-preamble as the "LIBRARY."
-
-LML2 is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE.
-
-
-
-Preamble to the Gnu Lesser General Public License
--------------------------------------------------
-Copyright (c) 2000 Franz Incorporated, Berkeley, CA 94704
-
-The concept of the GNU Lesser General Public License version 2.1
-("LGPL") has been adopted to govern the use and distribution of
-above-mentioned application. However, the LGPL uses terminology that
-is more appropriate for a program written in C than one written in
-Lisp. Nevertheless, the LGPL can still be applied to a Lisp program if
-certain clarifications are made. This document details those
-clarifications. Accordingly, the license for the open-source Lisp
-applications consists of this document plus the LGPL. Wherever there
-is a conflict between this document and the LGPL, this document takes
-precedence over the LGPL.
-
-A "Library" in Lisp is a collection of Lisp functions, data and
-foreign modules. The form of the Library can be Lisp source code (for
-processing by an interpreter) or object code (usually the result of
-compilation of source code or built with some other
-mechanisms). Foreign modules are object code in a form that can be
-linked into a Lisp executable. When we speak of functions we do so in
-the most general way to include, in addition, methods and unnamed
-functions. Lisp "data" is also a general term that includes the data
-structures resulting from defining Lisp classes. A Lisp application
-may include the same set of Lisp objects as does a Library, but this
-does not mean that the application is necessarily a "work based on the
-Library" it contains.
-
-The Library consists of everything in the distribution file set before
-any modifications are made to the files. If any of the functions or
-classes in the Library are redefined in other files, then those
-redefinitions ARE considered a work based on the Library. If
-additional methods are added to generic functions in the Library,
-those additional methods are NOT considered a work based on the
-Library. If Library classes are subclassed, these subclasses are NOT
-considered a work based on the Library. If the Library is modified to
-explicitly call other functions that are neither part of Lisp itself
-nor an available add-on module to Lisp, then the functions called by
-the modified Library ARE considered a work based on the Library. The
-goal is to ensure that the Library will compile and run without
-getting undefined function errors.
-
-It is permitted to add proprietary source code to the Library, but it
-must be done in a way such that the Library will still run without
-that proprietary code present. Section 5 of the LGPL distinguishes
-between the case of a library being dynamically linked at runtime and
-one being statically linked at build time. Section 5 of the LGPL
-states that the former results in an executable that is a "work that
-uses the Library." Section 5 of the LGPL states that the latter
-results in one that is a "derivative of the Library", which is
-therefore covered by the LGPL. Since Lisp only offers one choice,
-which is to link the Library into an executable at build time, we
-declare that, for the purpose applying the LGPL to the Library, an
-executable that results from linking a "work that uses the Library"
-with the Library is considered a "work that uses the Library" and is
-therefore NOT covered by the LGPL.
-
-Because of this declaration, section 6 of LGPL is not applicable to
-the Library. However, in connection with each distribution of this
-executable, you must also deliver, in accordance with the terms and
-conditions of the LGPL, the source code of Library (or your derivative
-thereof) that is incorporated into this executable.
-
-
-
- GNU LESSER GENERAL PUBLIC LICENSE
- Version 2.1, February 1999
-
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-[This is the first released version of the Lesser GPL. It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-Licenses are intended to guarantee your freedom to share and change
-free software--to make sure the software is free for all its users.
-
- This license, the Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it. You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations
-below.
-
- When we speak of free software, we are referring to freedom of use,
-not price. Our General Public Licenses are designed to make sure that
-you have the freedom to distribute copies of free software (and charge
-for this service if you wish); that you receive source code or can get
-it if you want it; that you can change the software and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
- To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-rights. These restrictions translate to certain responsibilities for
-you if you distribute copies of the library or if you modify it.
-
- For example, if you distribute copies of the library, whether gratis
-or for a fee, you must give the recipients all the rights that we gave
-you. You must make sure that they, too, receive or can get the source
-code. If you link other code with the library, you must provide
-complete object files to the recipients, so that they can relink them
-with the library after making changes to the library and recompiling
-it. And you must show them these terms so they know their rights.
-
- We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
- To protect each distributor, we want to make it very clear that
-there is no warranty for the free library. Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-^L
- Finally, software patents pose a constant threat to the existence of
-any free program. We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder. Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
- Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License. This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License. We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
- When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library. The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom. The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
- We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License. It also provides other free software developers Less
-of an advantage over competing non-free programs. These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries. However, the Lesser license provides advantages in certain
-special circumstances.
-
- For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it
-becomes a de-facto standard. To achieve this, non-free programs must
-be allowed to use the library. A more frequent case is that a free
-library does the same job as widely used non-free libraries. In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
- In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software. For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
- Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
- The precise terms and conditions for copying, distribution and
-modification follow. Pay close attention to the difference between a
-"work based on the library" and a "work that uses the library". The
-former contains code derived from the library, whereas the latter must
-be combined with the library in order to run.
-^L
- GNU LESSER GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License").
-Each licensee is addressed as "you".
-
- A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
- The "Library", below, refers to any such software library or work
-which has been distributed under these terms. A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language. (Hereinafter, translation is
-included without limitation in the term "modification".)
-
- "Source code" for a work means the preferred form of the work for
-making modifications to it. For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control
-compilation and installation of the library.
-
- Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it). Whether that is true depends on what the Library does
-and what the program that uses the Library does.
-
- 1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
-
- You may charge a fee for the physical act of transferring a copy,
-and you may at your option offer warranty protection in exchange for a
-fee.
-\f
- 2. You may modify your copy or copies of the Library or any portion
-of it, thus forming a work based on the Library, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) The modified work must itself be a software library.
-
- b) You must cause the files modified to carry prominent notices
- stating that you changed the files and the date of any change.
-
- c) You must cause the whole of the work to be licensed at no
- charge to all third parties under the terms of this License.
-
- d) If a facility in the modified Library refers to a function or a
- table of data to be supplied by an application program that uses
- the facility, other than as an argument passed when the facility
- is invoked, then you must make a good faith effort to ensure that,
- in the event an application does not supply such function or
- table, the facility still operates, and performs whatever part of
- its purpose remains meaningful.
-
- (For example, a function in a library to compute square roots has
- a purpose that is entirely well-defined independent of the
- application. Therefore, Subsection 2d requires that any
- application-supplied function or table used by this function must
- be optional: if the application does not supply it, the square
- root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library. To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License. (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.) Do not make any other change in
-these notices.
-^L
- Once this change is made in a given copy, it is irreversible for
-that copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
- This option is useful when you wish to copy part of the code of
-the Library into a program that is not a library.
-
- 4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable form
-under the terms of Sections 1 and 2 above provided that you accompany
-it with the complete corresponding machine-readable source code, which
-must be distributed under the terms of Sections 1 and 2 above on a
-medium customarily used for software interchange.
-
- If distribution of object code is made by offering access to copy
-from a designated place, then offering equivalent access to copy the
-source code from the same place satisfies the requirement to
-distribute the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library". Such a
-work, in isolation, is not a derivative work of the Library, and
-therefore falls outside the scope of this License.
-
- However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library". The executable is therefore covered by this License.
-Section 6 states terms for distribution of such executables.
-
- When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is not.
-Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library. The
-threshold for this to be true is not precisely defined by law.
-
- If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and small inline
-functions (ten lines or less in length), then the use of the object
-file is unrestricted, regardless of whether it is legally a derivative
-work. (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
- Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section 6.
-Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-^L
- 6. As an exception to the Sections above, you may also combine or
-link a "work that uses the Library" with the Library to produce a
-work containing portions of the Library, and distribute that work
-under terms of your choice, provided that the terms permit
-modification of the work for the customer's own use and reverse
-engineering for debugging such modifications.
-
- You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License. You must supply a copy of this License. If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License. Also, you must do one
-of these things:
-
- a) Accompany the work with the complete corresponding
- machine-readable source code for the Library including whatever
- changes were used in the work (which must be distributed under
- Sections 1 and 2 above); and, if the work is an executable linked
- with the Library, with the complete machine-readable "work that
- uses the Library", as object code and/or source code, so that the
- user can modify the Library and then relink to produce a modified
- executable containing the modified Library. (It is understood
- that the user who changes the contents of definitions files in the
- Library will not necessarily be able to recompile the application
- to use the modified definitions.)
-
- b) Use a suitable shared library mechanism for linking with the
- Library. A suitable mechanism is one that (1) uses at run time a
- copy of the library already present on the user's computer system,
- rather than copying library functions into the executable, and (2)
- will operate properly with a modified version of the library, if
- the user installs one, as long as the modified version is
- interface-compatible with the version that the work was made with.
-
- c) Accompany the work with a written offer, valid for at least
- three years, to give the same user the materials specified in
- Subsection 6a, above, for a charge no more than the cost of
- performing this distribution.
-
- d) If distribution of the work is made by offering access to copy
- from a designated place, offer equivalent access to copy the above
- specified materials from the same place.
-
- e) Verify that the user has already received a copy of these
- materials or that you have already sent this user a copy.
-
- For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it. However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
- It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system. Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-^L
- 7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
- a) Accompany the combined library with a copy of the same work
- based on the Library, uncombined with any other library
- facilities. This must be distributed under the terms of the
- Sections above.
-
- b) Give prominent notice with the combined library of the fact
- that part of it is a work based on the Library, and explaining
- where to find the accompanying uncombined form of the same work.
-
- 8. You may not copy, modify, sublicense, link with, or distribute
-the Library except as expressly provided under this License. Any
-attempt otherwise to copy, modify, sublicense, link with, or
-distribute the Library is void, and will automatically terminate your
-rights under this License. However, parties who have received copies,
-or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
- 9. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Library or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
- 10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties with
-this License.
-^L
- 11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all. For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply, and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License
-may add an explicit geographical distribution limitation excluding those
-countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time.
-Such new versions will be similar in spirit to the present version,
-but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation. If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-^L
- 14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission. For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this. Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
- NO WARRANTY
-
- 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
- END OF TERMS AND CONDITIONS
-^L
- How to Apply These Terms to Your New Libraries
-
- If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change. You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms
-of the ordinary General Public License).
-
- To apply these terms, attach the following notices to the library.
-It is safest to attach them to the start of each source file to most
-effectively convey the exclusion of warranty; and each file should
-have at least the "copyright" line and a pointer to where the full
-notice is found.
-
-
- <one line to give the library's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
+++ /dev/null
-See doc/readme.html for a brief introduction
-
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: lml2.asd
-;;;; Purpose: ASDF definition file for Lisp Markup Language Version 2
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Aug 2002
-;;;;
-;;;; $Id: lml2.asd 7061 2003-09-07 06:34:45Z kevin $
-;;;;
-;;;; 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)
-
-(defparameter *apache-name-width* 24)
-
-(defun write-name-trailing-spaces (stream name)
- (let* ((spaces (- *apache-name-width* (length name))))
- (when (plusp spaces)
- (print-n-chars #\space spaces stream))))
-
-(defun write-name-link (stream link name)
- (html-stream
- stream
- ((:a :href link) (:princ (string-maybe-shorten name *apache-name-width*))))
- (write-name-trailing-spaces stream name))
-
-(defun universal-time-to-apache-date (utime)
- (multiple-value-bind
- (second minute hour day-of-month month year day-of-week daylight-p zone)
- (decode-universal-time utime)
- (declare (ignore second day-of-week daylight-p zone))
- (format nil
- (formatter "~2,'0D-~3/kmrcl::monthname/-~4,'0D ~2,'0D:~2,'0D")
- day-of-month month year hour minute)))
-
-(defun sort-dir-entries (entries sort-field direct)
- (case sort-field
- (:name
- (sort entries
- (lambda (a b)
- (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp)
- (aif (third a) it "")
- (aif (third b) it "")))))
- (:modified
- (sort entries
- (lambda (a b)
- (funcall (if (eq direct :asc) #'< #'>)
- (aif (fourth a) it 0)
- (aif (fourth b) it 0)))))
- (:size
- (sort entries
- (lambda (a b)
- (funcall (if (eq direct :asc) #'< #'>)
- (aif (fifth a) it 0)
- (aif (fifth b) it 0)))))
- (:description
- (sort entries
- (lambda (a b)
- (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp)
- (aif (sixth a) it "")
- (aif (sixth b) it "")))))
- (t
- entries)))
-
-(defun write-html-apache-directory (stream title entries this-url &key parent address query-string
- icon-base)
- (let* ((query (when query-string (split-uri-query-string query-string)))
- (sort-field (if query
- (cond
- ((string-equal (caar query) "N") :name)
- ((string-equal (caar query) "M") :modified)
- ((string-equal (caar query) "S") :size)
- ((string-equal (caar query) "D") :description)
- (t :name))
- :name))
- (dir (cond
- ((and query (string-equal (cdr (first query)) "D") :desc))
- (t :asc))))
- (setq entries (sort-dir-entries entries sort-field dir))
-
- (html-stream
- stream
- "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/REC-html40/loose.dtd\">"
- :newline
- (:html
- :newline
- (:head
- :newline
- (:title (:princ title)))
- :newline
- ((:body :bgcolor "#FFFFFF" :text "#000000")
- :newline
- (:table
- (:tr
- ((:td :bgcolor "#FFFFFF" :class "title")
- ((:font :size "+3" :face "Hevetica,Arial,sans-serif")
- (:b (:princ title))))))
- :newline
- (:pre
- (when icon-base
- (html-stream
- stream
- ((:img :border "0"
- :src (format nil "~Ablank.png" icon-base)
- :alt " "))))
- " "
- ((:a :href (format nil "~A?N=~A" this-url
- (if (and (eq sort-field :name) (eq dir :asc))
- "D" "A")))
- "Name")
- (:princ (format nil "~20A" ""))
- " "
- ((:a :href (format nil "~A?M=~A" this-url
- (if (and (eq sort-field :modified) (eq dir :asc))
- "D" "A")))
- "Last modified")
- " "
- ((:a :href (format nil "~A?S=~A" this-url
- (if (and (eq sort-field :size) (eq dir :asc))
- "D" "A")))
- "Size")
- " "
- ((:a :href (format nil "~A?D=~A" this-url
- (if (and (eq sort-field :description) (eq dir :asc))
- "D" "A")))
- "Description")
- :newline
- (:princ "<hr noshade align=\"left\" width=\"80%\">")
- :newline
- (when parent
- (html-stream
- stream
- (when icon-base
- (html-stream
- stream
- ((:img :border "0"
- :src (format nil "~Aback.png" icon-base)
- :alt "[DIR]"))))
- " "
- (write-name-link stream (first parent) (second parent))
- " "
- (print-n-chars #\space 17 stream)
- " -"
- :newline))
- (dolist (entry entries)
- (html-stream
- stream
- (when icon-base
- (html-stream
- stream
- ((:img :border "0"
- :src
- (case (car entry)
- (:dir (format nil "~Afolder.png" icon-base))
- (:text (format nil "~Atext.png" icon-base))
- (t (format nil "~Af.png" icon-base)))
- :alt
- (case (car entry)
- (:dir "[DIR]")
- (:text "[TXT]")
- (t "[FIL]"))))))
- " "
- (write-name-link stream (second entry) (third entry))
- " "
- (:princ (universal-time-to-apache-date (fourth entry)))
- (:princ
- (cond
- ((or (eq :dir (first entry))
- (null (fifth entry)))
- " -")
- ((< (fifth entry) (* 1024 1024))
- (format nil "~5,' Dk" (round (fifth entry) 1024)))
- ((< (fifth entry) (* 1024 1024 1024))
- (format nil "~5,' Dm" (round (fifth entry) (* 1024 1024))))
- (t
- (format nil "~5,' Dg" (round (fifth entry) (* 1024 1024 1024))))
- ))
- " "
- (:princ
- (if (sixth entry)
- (sixth entry)
- ""))
- :newline)))
- (:princ "<hr noshade align=\"left\" width=\"80%\">")
- :newline
- (when address
- (html-stream
- stream
- (:address address))))))))
-
+++ /dev/null
-;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: base.lisp
-;;;; Purpose: Lisp Markup Language functions
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Aug 2002
-;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-(in-package #:lml2)
-
-
-(defun lml-format (str &rest args)
- (when (streamp *html-stream*)
- (if args
- (apply #'format *html-stream* str args)
- (write-string str *html-stream*))))
-
-(defun lml-princ (s)
- (princ s *html-stream*))
-
-(defun lml-print (s)
- (format *html-stream* "~A~%" s))
-
-(defun lml-write-char (char)
- (write-char char *html-stream*))
-
-(defun lml-write-string (str)
- (write-string str *html-stream*))
-
-(defun lml-print-date (date)
- (lml-write-string (date-string date)))
-
-(defun xml-header-stream (stream &key (version "1.0") (standalone :unspecified)
- (encoding :unspecified))
- (format stream "<?xml version=\"~A\"~A~A ?>"
- version
- (if (eq standalone :unspecified)
- ""
- (format nil " standalone=\"~A\"" standalone))
- (if (eq encoding :unspecified)
- ""
- (format nil " encoding=\"~A\"" encoding))))
-
-(defun dtd-prologue (&optional (format :xhtml11) &key entities)
- (case format
- ((:xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional :xhtml10-frameset :xml)
- (lml-write-string +xml-prologue-string+)
- (lml-write-char #\newline)
- (case format
- ((:xhtml11 :xhtml)
- (lml-write-string +xhtml11-dtd-string+))
- (:xhtml10-strict
- (lml-write-string +xhtml10-strict-dtd-string+))
- (:xhtml10-transitional
- (lml-write-string +xhtml10-transitional-dtd-string+))
- (:xhtml10-frameset
- (lml-write-string +xhtml10-frameset-dtd-string+)))
- (when entities
- (lml-write-char #\space)
- (lml-write-char #\[)
- (lml-write-char #\Newline)
- (lml-write-string entities)
- (lml-write-char #\Newline)
- (lml-write-char #\]))
- (lml-write-char #\>))
- (:html
- (lml-write-string +html4-dtd-string+)))
- (lml-write-char #\newline))
-
-
-(defmacro html-file-page ((out-file &key (format :xhtml11))
- &body body)
- `(with-open-file (*html-stream*
- (lml-file-name ',out-file :output)
- :direction :output
- :if-exists :supersede)
- (dtd-prologue ,format)
- (html
- ((:html :xmlns "http://www.w3.org/1999/xhtml")
- ,@body))))
-
-
-(defmacro alink (url desc)
- `(html
- ((:a :href ,url) ,desc)))
-
-(defmacro alink-c (class url desc)
- `(html
- ((:a :class ,class :href ,url) ,desc)))
+++ /dev/null
-;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: data.lisp
-;;;; Purpose: Lisp Markup Language functions
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Aug 2002
-;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-(in-package #:lml2)
-
-(defvar *html-stream* *standard-output*)
-
-(defvar *print-spaces* nil)
-(defvar *indent* 0)
-
-(defvar +xml-prologue-string+
- "<?xml version=\"1.0\" encoding=\"iso-8859-1\" standalone=\"yes\"?>")
-
-(defvar +html4-dtd-string+
- "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">")
-
-(defvar +xhtml11-dtd-string+
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\"")
-
-(defvar +xhtml10-strict-dtd-string+
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml10/DTD/xhtml10-strict.dtd\"")
-
-(defvar +xhtml10-transitional-dtd-string+
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml10/DTD/xhtml10-transitional.dtd\"")
-
-(defvar +xhtml10-frameset-dtd-string+
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" \"http://www.w3.org/TR/xhtml10/DTD/xhtml10-frameset.dtd\"")
+++ /dev/null
-cl-lml2 (1.6.1-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 7 Nov 2006 23:00:15 -0700
-
-cl-lml2 (1.6.0-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 7 Nov 2006 11:25:42 -0700
-
-cl-lml2 (1.5.6-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Mon, 6 Nov 2006 23:26:48 -0700
-
-cl-lml2 (1.5.5-2) unstable; urgency=low
-
- * Add lml2-tests.asd file (closes: 361172). Thanks to Chun Tian
-
- -- Kevin M. Rosenberg <kmr@debian.org> Wed, 12 Apr 2006 09:46:42 -0600
-
-cl-lml2 (1.5.5-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 17 Jan 2006 14:32:39 -0700
-
-cl-lml2 (1.5.4-2) unstable; urgency=low
-
- * New upstream URI
-
- -- Kevin M. Rosenberg <kmr@debian.org> Sat, 17 Sep 2005 15:32:36 -0600
-
-cl-lml2 (1.5.4-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Sat, 3 Sep 2005 10:11:12 -0600
-
-cl-lml2 (1.5.3-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Fri, 28 Jan 2005 19:22:30 -0700
-
-cl-lml2 (1.5.2-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Fri, 28 Jan 2005 19:09:07 -0700
-
-cl-lml2 (1.5.1-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Fri, 11 Jun 2004 16:42:16 -0600
-
-cl-lml2 (1.5.0-1) unstable; urgency=low
-
- * New upstream with apache-dir module
-
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 3 Feb 2004 11:14:59 -0700
-
-cl-lml2 (1.4.2-1) unstable; urgency=low
-
- * Add entities keyword to doctype output
-
- -- Kevin M. Rosenberg <kmr@debian.org> Sun, 16 Nov 2003 02:53:47 -0700
-
-cl-lml2 (1.4.1-1) unstable; urgency=low
-
- * Improve code walker
-
- -- Kevin M. Rosenberg <kmr@debian.org> Sun, 16 Nov 2003 02:53:28 -0700
-
-cl-lml2 (1.4-1) unstable; urgency=low
-
- * Add code walker to collapse sequential constant strings
-
- -- Kevin M. Rosenberg <kmr@debian.org> Mon, 21 Jul 2003 10:31:40 -0600
-
-cl-lml2 (1.3-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 15 Jul 2003 12:18:46 -0600
-
-cl-lml2 (1.2.0-1) unstable; urgency=low
-
- * New upstream:
- - use function parameters rather than special variables in downloads.lisp
- - Remove old gpl copyright statements from files. License in LLGPL
-
- -- Kevin M. Rosenberg <kmr@debian.org> Sat, 12 Jul 2003 11:46:47 -0600
-
-cl-lml2 (1.1.4-1) unstable; urgency=low
-
- * Fix readme.lml
-
- -- Kevin M. Rosenberg <kmr@debian.org> Thu, 10 Jul 2003 14:09:35 -0600
-
-cl-lml2 (1.1.3-1) unstable; urgency=low
-
- * More documentation improvments
-
- -- Kevin M. Rosenberg <kmr@debian.org> Wed, 25 Jun 2003 15:39:37 -0600
-
-cl-lml2 (1.1.2-1) unstable; urgency=low
-
- * Improve documentation
-
- -- Kevin M. Rosenberg <kmr@debian.org> Wed, 25 Jun 2003 15:23:32 -0600
-
-cl-lml2 (1.1.1-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 24 Jun 2003 11:37:17 -0600
-
-cl-lml2 (1.1-1) unstable; urgency=low
-
- * New upstream
-
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 24 Jun 2003 10:42:03 -0600
-
-cl-lml2 (1.0-1) unstable; urgency=low
-
- * First release
-
- -- Kevin M. Rosenberg <kmr@debian.org> Mon, 16 Jun 2003 23:52:59 -0600
+++ /dev/null
-Source: cl-lml2
-Section: devel
-Priority: optional
-Maintainer: Kevin M. Rosenberg <kmr@debian.org>
-Build-Depends: debhelper (>> 4.0.0)
-Standards-Version: 3.7.2.2
-
-Package: cl-lml2
-Architecture: all
-Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37), cl-kmrcl
-Description: Lisp Markup Language
- LML2 provides a markup language for generation XHTML web pages.
- .
- The usage of LML2 is incompatible the the original LML version. However,
- the two versions may be used along side each other.
-
+++ /dev/null
-Debian Copyright Section
-========================
-
-Upstream Source URL: http://files.b9.com/lml2
-Upstream Authors: Kevin M. Rosenberg <kevin@rosenberg.net>
- John Federaro, Franz Inc
-Debian Maintainer: Kevin M. Rosenberg <kmr@debian.org>
-
-
-Upstream Copyright Statement
-============================
-LML is written and Copyright (c) 2000-2003 by Kevin M. Rosenberg
-with portions Copyright (c) 1986-2003 by Franz, Inc.
-
-LML is licensed under the terms of the Lisp Lesser GNU Public
-License, known as the LLGPL. The LLGPL consists of a preamble (see
-below) and the Lessor GNU Public License 2.1 (LGPL-2.1). Where these
-conflict, the preamble takes precedence. LML2 is referenced in the
-preamble as the "LIBRARY." The LGPL-2.1 is stored on a Debian system
-in the file /usr/share/common-licenses/LGPL-2.1.
-
-LML2 is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE.
-
-
-
-Preamble to the Gnu Lesser General Public License
--------------------------------------------------
-Copyright (c) 2000 Franz Incorporated, Berkeley, CA 94704
-
-The concept of the GNU Lesser General Public License version 2.1
-("LGPL") has been adopted to govern the use and distribution of
-above-mentioned application. However, the LGPL uses terminology that
-is more appropriate for a program written in C than one written in
-Lisp. Nevertheless, the LGPL can still be applied to a Lisp program if
-certain clarifications are made. This document details those
-clarifications. Accordingly, the license for the open-source Lisp
-applications consists of this document plus the LGPL. Wherever there
-is a conflict between this document and the LGPL, this document takes
-precedence over the LGPL.
-
-A "Library" in Lisp is a collection of Lisp functions, data and
-foreign modules. The form of the Library can be Lisp source code (for
-processing by an interpreter) or object code (usually the result of
-compilation of source code or built with some other
-mechanisms). Foreign modules are object code in a form that can be
-linked into a Lisp executable. When we speak of functions we do so in
-the most general way to include, in addition, methods and unnamed
-functions. Lisp "data" is also a general term that includes the data
-structures resulting from defining Lisp classes. A Lisp application
-may include the same set of Lisp objects as does a Library, but this
-does not mean that the application is necessarily a "work based on the
-Library" it contains.
-
-The Library consists of everything in the distribution file set before
-any modifications are made to the files. If any of the functions or
-classes in the Library are redefined in other files, then those
-redefinitions ARE considered a work based on the Library. If
-additional methods are added to generic functions in the Library,
-those additional methods are NOT considered a work based on the
-Library. If Library classes are subclassed, these subclasses are NOT
-considered a work based on the Library. If the Library is modified to
-explicitly call other functions that are neither part of Lisp itself
-nor an available add-on module to Lisp, then the functions called by
-the modified Library ARE considered a work based on the Library. The
-goal is to ensure that the Library will compile and run without
-getting undefined function errors.
-
-It is permitted to add proprietary source code to the Library, but it
-must be done in a way such that the Library will still run without
-that proprietary code present. Section 5 of the LGPL distinguishes
-between the case of a library being dynamically linked at runtime and
-one being statically linked at build time. Section 5 of the LGPL
-states that the former results in an executable that is a "work that
-uses the Library." Section 5 of the LGPL states that the latter
-results in one that is a "derivative of the Library", which is
-therefore covered by the LGPL. Since Lisp only offers one choice,
-which is to link the Library into an executable at build time, we
-declare that, for the purpose applying the LGPL to the Library, an
-executable that results from linking a "work that uses the Library"
-with the Library is considered a "work that uses the Library" and is
-therefore NOT covered by the LGPL.
-
-Because of this declaration, section 6 of LGPL is not applicable to
-the Library. However, in connection with each distribution of this
-executable, you must also deliver, in accordance with the terms and
-conditions of the LGPL, the source code of Library (or your derivative
-thereof) that is incorporated into this executable.
-
+++ /dev/null
-#! /bin/sh
-set -e
-
-LISP_PKG=lml2
-
-# summary of how this script can be called:
-# * <postinst> `configure' <most-recently-configured-version>
-# * <old-postinst> `abort-upgrade' <new version>
-# * <conflictor's-postinst> `abort-remove' `in-favour' <package>
-# <new-version>
-# * <deconfigured's-postinst> `abort-deconfigure' `in-favour'
-# <failed-install-package> <version> `removing'
-# <conflicting-package> <version>
-# for details, see http://www.debian.org/doc/debian-policy/ or
-# the debian-policy package
-#
-# quoting from the policy:
-# Any necessary prompting should almost always be confined to the
-# post-installation script, and should be protected with a conditional
-# so that unnecessary prompting doesn't happen if a package's
-# installation fails and the `postinst' is called with `abort-upgrade',
-# `abort-remove' or `abort-deconfigure'.
-
-case "$1" in
- configure)
- /usr/sbin/register-common-lisp-source ${LISP_PKG}
-
- ;;
-
- abort-upgrade|abort-remove|abort-deconfigure)
-
- ;;
-
- *)
- echo "postinst called with unknown argument \`$1'" >&2
- exit 1
- ;;
-esac
-
-# dh_installdeb will replace this with shell code automatically
-# generated by other debhelper scripts.
-
-#DEBHELPER#
-
-exit 0
-
-
+++ /dev/null
-#! /bin/sh
-set -e
-
-# package name according to lisp
-LISP_PKG=lml2
-
-# summary of how this script can be called:
-# * <prerm> `remove'
-# * <old-prerm> `upgrade' <new-version>
-# * <new-prerm> `failed-upgrade' <old-version>
-# * <conflictor's-prerm> `remove' `in-favour' <package> <new-version>
-# * <deconfigured's-prerm> `deconfigure' `in-favour'
-# <package-being-installed> <version> `removing'
-# <conflicting-package> <version>
-# for details, see http://www.debian.org/doc/debian-policy/ or
-# the debian-policy package
-
-
-case "$1" in
- remove|upgrade|deconfigure)
- /usr/sbin/unregister-common-lisp-source ${LISP_PKG}
- ;;
- failed-upgrade)
- ;;
- *)
- echo "prerm called with unknown argument \`$1'" >&2
- exit 1
- ;;
-esac
-
-# dh_installdeb will replace this with shell code automatically
-# generated by other debhelper scripts.
-
-#DEBHELPER#
-
-exit 0
-
-
+++ /dev/null
-#!/usr/bin/make -f
-
-pkg := lml2
-debpkg := cl-lml2
-
-clc-source := usr/share/common-lisp/source
-clc-systems := usr/share/common-lisp/systems
-clc-lml2 := $(clc-source)/$(pkg)
-
-doc-dir := usr/share/doc/$(debpkg)
-
-configure: configure-stamp
-configure-stamp:
- dh_testdir
- # Add here commands to configure the package.
- touch configure-stamp
-
-
-build: build-stamp
-
-build-stamp: configure-stamp
- dh_testdir
- # Add here commands to compile the package.
- touch build-stamp
-
-clean:
- dh_testdir
- dh_testroot
- rm -f build-stamp configure-stamp
- # Add here commands to clean up after the build process.
- rm -f debian/cl-lml2.postinst.* debian/cl-lml2.prerm.*
- dh_clean
-
-install: build
- dh_testdir
- dh_testroot
- dh_clean -k
- # Add here commands to install the package into debian/lml2.
- dh_installdirs $(clc-systems) $(clc-lml2) $(doc-dir)
- dh_install lml2.asd lml2-tests.asd $(shell echo *.lisp) $(clc-lml2)
- dh_link $(clc-lml2)/lml2.asd $(clc-systems)/lml2.asd
- dh_link $(clc-lml2)/lml2-tests.asd $(clc-systems)/lml2-tests.asd
-
-# Build architecture-independent files here.
-binary-indep: build install
-
-
-# Build architecture-dependent files here.
-binary-arch: build install
- dh_testdir
- dh_testroot
-# dh_installdebconf
- dh_installdocs doc/readme.html
- dh_installexamples doc/Makefile doc/make.lisp $(shell echo doc/*.lml)
-# dh_installmenu
-# dh_installlogrotate
-# dh_installemacsen
-# dh_installpam
-# dh_installmime
-# dh_installinit
-# dh_installcron
-# dh_installman
-# dh_installinfo
-# dh_undocumented
- dh_installchangelogs ChangeLog
- dh_strip
- dh_compress
- dh_fixperms
-# dh_makeshlibs
- dh_installdeb
-# dh_perl
- dh_shlibdeps
- dh_gencontrol
- dh_md5sums
- dh_builddeb
-
-binary: binary-indep binary-arch
-.PHONY: build clean binary-indep binary-arch binary install configure
-
+++ /dev/null
-#!/bin/bash -e
-
-dup lml2 -Ufiles.b9.com -D/home/ftp/lml2 -C"(umask 022; cd /opt/apache/htdocs/lml2; make install)" -su $*
+++ /dev/null
-.PHONY: site all clean
-
-all: site
-
-site:
- sbcl --load `pwd`/make.lisp
-
-clean:
- @rm -f *~ \#*\# .\#* memdump
-
+++ /dev/null
-#+cmu (setq ext:*gc-verbose* nil)
-
-(require :lml2)
-(in-package :lml2)
-(let ((cwd (parse-namestring (lml-cwd))))
- (process-dir cwd))
-(lml-quit)
+++ /dev/null
-<?xml version="1.0" encoding="iso-8859-1" standalone="yes"?>
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml"><head><title>LML2 README</title><meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /><meta name="Copyright" content="Kevin Rosenberg 2002 <kevin@rosenberg.net>" /><meta name="description" content="Lisp Markup Language Documentation" /><meta name="author" content="Kevin Rosenberg" /><meta name="keywords" content="Common Lisp, HTML, Markup Langauge" /></head><body><h1>LML2 Documentation</h1><h2>Overview</h2><p><a href="http://lml2.b9.com">LML2</a> is a Common Lisp package for generating HTML and XHTML documents. LML2 is based on:</p><ul><li><a href="http://lml.b9.com">LML</a> by <a href="mailto:kevin@rosenberg.net">Kevin Rosenberg</a></li><li>htmlgen by <a href="http://www.franz.com">Franz, Inc.</a></li></ul><p>The home page for LML2 is <a href="http://lml2.b9.com/">http://lml2.b9.com/</a>.</p><h2>Prerequisites</h2><ul><li><a href="http://cliki.net/asdf">ASDF</a></li><li><a href="http://cliki.net/kmrcl">KMRCL</a></li></ul><h2>Differences between LML2 and LML</h2><p>The syntax and HTML generation for LML2 are based on Franz's htmlgen macro. Personally, I like the syntax of LML better than LML2, but there are advantages of Franz's approach:</p><ul><li>Faster compilation and runtime HTML generation</li><li>Behavior of tags is extensible</li></ul><h2>Differences between LML2 and htmlgen</h2><ul><li>LML2 is XHTML compatible with close tags so that (html :hr) now produces '<hr />'</li><li>Lowercase tag names so that (html ((:p class 'a))) now produces '<p class="a"></p></li><li>Addition of new tags such as :insert-file, :nbsp, :jscript</li><li>Removal of the if* macro from the htmlgen.lisp source code</li><li>Incorporation of LML's standard site macro and other helper functions.</li><li>Addition of special attribute tags (:if :when :optional :format :format</li><li>Automatic quoting of attribute values for non-string values</li><li>Post macroexpansion code walker to collape sequential write-string calls</li></ul><h2>Installation</h2><p>The easiest way to install LML is to use the <a href="http://www.debian.org/">Debian</a> GNU/Linux operating system. You can then use the command <tt>apt-get install cl-lml2</tt> to automatically download and install the LML2 package.</p><p>On a non-Debian system, you need to have <a href="http://cclan.sourceforge.net/">ASDF</a> installed to load the system definition file. You will need to change the source
- pathname in the system file to match the location where you have installed LML.</p><h2>Usage</h2><p>Currently, there is no documentation on the functions provided by LML2. However, the source code is instructive and there are example files included in the LML2 package.</p><h2>Examples</h2><table border="1" cellpadding="3"><tbody><tr><td colspan="2" style="color:#000;background-color:#ccc;font-weight:bold;">Iteration</td></tr><tr><td><pre>(html
- (:i "The square of the first five integers are: ")
- (:b (loop as x from 1 to 5
- doing (html (:princ (* x x))))))</pre></td><td><i>The square of the first five integers are: </i><b> 1 4 9 16 25</b></td></tr></tbody></table><hr /><p>View this page's <a href="http://lml2.b9.com/">LML2</a> <a href="readme.lml">source</a>.</p></body></html>
\ No newline at end of file
+++ /dev/null
-;;; -*- Mode: Lisp -*-
-
-(in-package #:lml2)
-
-(html-file-page ("readme")
- (html
- (:head
- (:title "LML2 README")
- ((:meta :http-equiv "Content-Type" :content "text/html; charset=iso-8859-1"))
- ((:meta :name "Copyright" :content "Kevin Rosenberg 2002 <kevin@rosenberg.net>"))
- ((:meta :name "description" :content "Lisp Markup Language Documentation"))
- ((:meta :name "author" :content "Kevin Rosenberg"))
- ((:meta :name "keywords" :content "Common Lisp, HTML, Markup Langauge")))
-
- (:body
- (:h1 "LML2 Documentation")
- (:h2 "Overview")
- (:p
- ((:a :href "http://lml2.b9.com") "LML2")
- " is a Common Lisp package for generating HTML and XHTML documents."
- " LML2 is based on:")
-
- (:ul
- (:li ((:a :href "http://lml.b9.com") "LML") " by "
- ((:a :href "mailto:kevin@rosenberg.net") "Kevin Rosenberg"))
- (:li "htmlgen by "
- ((:a :href "http://www.franz.com") "Franz, Inc.")))
-
- (:p
- "The home page for LML2 is "
- ((:a :href "http://lml2.b9.com/") "http://lml2.b9.com/")
- ".")
-
- (:h2 "Prerequisites")
- (:ul
- (:li ((:a :href "http://cliki.net/asdf") "ASDF"))
- (:li ((:a :href "http://cliki.net/kmrcl") "KMRCL")))
-
- (:h2 "Differences between LML2 and LML")
- (:p "The syntax and HTML generation for LML2 are based on Franz's htmlgen macro. Personally, I like the syntax of LML better than LML2, but there are advantages of Franz's approach:")
- (:ul
- (:li "Faster compilation and runtime HTML generation")
- (:li "Behavior of tags is extensible"))
-
- (:h2 "Differences between LML2 and htmlgen")
- (:ul
- (:li "LML2 is XHTML compatible with close tags so that (html :hr) now produces '<hr />'")
- (:li "Lowercase tag names so that (html ((:p class 'a))) now produces '<p class=\"a\"></p>")
- (:li "Addition of new tags such as :insert-file, :nbsp, :jscript")
- (:li "Removal of the if* macro from the htmlgen.lisp source code")
- (:li "Incorporation of LML's standard site macro and other helper functions.")
- (:li "Addition of special attribute tags (:if :when :optional :format :format")
- (:li "Automatic quoting of attribute values for non-string values")
- (:li "Post macroexpansion code walker to collape sequential write-string calls"))
-
- (:h2 "Installation")
- (:p
- "The easiest way to install LML is to use the "
- ((:a :href "http://www.debian.org/") "Debian")
- " GNU/Linux operating system. You can then use the command "
- (:tt "apt-get install cl-lml2")
- " to automatically download and install the LML2 package.")
- (:p
- "On a non-Debian system, you need to have "
- ((:a :href "http://cclan.sourceforge.net/") "ASDF")
- " installed to load the system definition file. You will need to change the source
- pathname in the system file to match the location where you have installed LML.")
-
- (:h2 "Usage")
- (:p
- "Currently, there is no documentation on the functions provided by LML2. However, the source code is instructive and there are example files included in the LML2 package.")
-
- (:h2 "Examples")
- ((:table :border 1 :cellpadding 3)
- (:tbody
- (:tr
- ((:td :colspan 2 :style "color:#000;background-color:#ccc;font-weight:bold;")
- "Iteration"))
- (:tr
- (:td
- (:pre
-"(html
- (:i \"The square of the first five integers are: \")
- (:b (loop as x from 1 to 5
- doing (html " " (:princ (* x x))))))"))
- (:td
- (:i "The square of the first five integers are: ")
- (:b (loop as x from 1 to 5
- doing (html " " (:princ (* x x)))))))
- ))
- :hr
- (:p
- "View this page's "
- ((:a :href "http://lml2.b9.com/") "LML2")
- " "
- ((:a :href "readme.lml") "source")
- ".")
- )))
+++ /dev/null
-;;;; -*- 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$
-;;;;
-;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-(in-package #:lml2)
-
-
-(defstruct dl-data base url name indent signed)
-
-(defun list-files (files dl-data)
- "List files in a directory for downloading"
- ;;files.sort()
- (mapcar (lambda (f) (print-file f dl-data)) files))
-
-(defun strip-dl-base (file base)
- (let ((fdir (pathname-directory file))
- (bdir (pathname-directory 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 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 (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 href=\"~A~A\">~A</a>"
- (dl-data-url dl-data) dl-name basename)
- (lml-princ "<span class=\"modtime\">")
- (lml-format " (~A, <b>~:D <span style=\"font-size:90%;\">KB</span></b>)</span>" modtime size)
- (when (probe-file sig-path)
- (setf (dl-data-signed dl-data) t)
- (lml-format " [<a href=\"~A~A.asc\">Signature</a>]"
- (dl-data-url dl-data) dl-name))
- (html :br))))
-
-(defun display-header (name url)
- (lml-princ "<h1>Download</h1>")
- (lml-princ "<div class=\"mainbody\">")
- (lml-format "<h3>Browse ~A Download Site</h3>" name)
- (let ((*print-circle* nil))
- (lml-format "<a style=\"padding-left:20pt;\" href=\"~A\">~A</a>" url url)))
-
-(defun display-footer (dl-data)
- (when (dl-data-signed dl-data)
- (lml-princ "<h3>GPG Public Key</h3>")
- (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 dl-data)
- (lml-format "<h~D>~A</h~D>"
- (dl-data-indent dl-data) title (dl-data-indent dl-data)))
-
-(defun match-base-name? (name base-name)
- (let ((len-base-name (length base-name)))
- (when (>= (length name) len-base-name)
- (string= name base-name :end1 len-base-name :end2 len-base-name))))
-
-(defun match-base-name-latest? (name base-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 base-name)
- (delete-if-not
- (lambda (f) (match-base-name? (pathname-name f) base-name))
- files))
-
-(defun filter-latest (files base-name)
- (delete-if
- (lambda (f) (match-base-name-latest? (pathname-name f) base-name))
- files))
-
-(defun sort-pathnames (list)
- (sort list (lambda (a b) (string< (namestring a) (namestring b)))))
-
-(defun display-one-section (title pat dl-data)
- (let ((files (sort-pathnames
- (filter-latest
- (filter-against-base (directory pat) (dl-data-name dl-data))
- (dl-data-name dl-data)))))
- (when files
- (print-sect-title title dl-data)
- (lml-princ "<div style=\"padding-left: 20pt;\">")
- (list-files files dl-data)
- (lml-princ "</div>"))))
-
-(defun display-sections (sects dl-data)
- (when sects
- (let ((title (car sects))
- (value (cadr sects)))
- (if (consp title)
- (dolist (sect sects)
- (display-sections sect dl-data))
- (if (consp value)
- (progn
- (print-sect-title title dl-data)
- (incf (dl-data-indent dl-data))
- (display-sections value dl-data)
- (decf (dl-data-indent dl-data)))
- (display-one-section title value dl-data))))))
-
-(defun display-page (pkg-name pkg-base dl-base dl-url sects)
- (let ((dl-data (make-dl-data :indent 3
- :base dl-base
- :url dl-url
- :name pkg-base
- :signed nil)))
- (display-header pkg-name dl-url)
- (dolist (sect sects)
- (display-sections sect dl-data))
- (display-footer dl-data)))
-
-(defun std-dl-page (pkg-name pkg-base dl-base dl-url)
- (let ((base (parse-namestring dl-base)))
- (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild))
- (zip-path (make-pathname :defaults base :type "zip" :name :wild))
- (doc-path (make-pathname :defaults base :type "pdf" :name :wild)))
- (display-page pkg-name pkg-base dl-base dl-url
- `(("Manual" ,doc-path)
- ("Source Code"
- (("Unix (.tar.gz)" ,tgz-path)
- ("Windows (.zip)" ,zip-path))))))))
-
-(defun full-dl-page (pkg-name pkg-base dl-base dl-url)
- (let ((base (parse-namestring dl-base)))
- (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild))
- (zip-path (make-pathname :defaults base :type "zip" :name :wild))
- (doc-path (make-pathname :defaults base :type "pdf" :name :wild))
- (deb-path (merge-pathnames
- (make-pathname :directory '(:relative "linux-debian")
- :type :wild :name :wild)
- base))
- (rpm-path (merge-pathnames
- (make-pathname :directory '(:relative "linux-rpm")
- :type :wild :name :wild)
- base))
- (w32-path (merge-pathnames
- (make-pathname :directory '(:relative "win32")
- :type :wild :name :wild)
- base)))
- (display-page pkg-name pkg-base dl-base dl-url
- `(("Manual" ,doc-path)
- ("Source Code"
- (("Unix (.tar.gz)" ,tgz-path)
- ("Windows (.zip)" ,zip-path)))
- ("Binaries"
- (("Linux Binaries"
- (("Debian Linux" ,deb-path)
- ("RedHat Linux" ,rpm-path)))
- ("Windows Binaries" ,w32-path))))))))
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: files.lisp
-;;;; Purpose: File and directory functions for LML
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Aug 2002
-;;;;
-;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-(in-package #:lml2)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *output-dir* nil)
- (defvar *sources-dir* nil)
- )
-
-(defun lml-file-name (f &optional (type :source))
- (when (and (consp f) (eql (car f) 'cl:quote))
- (setq f (cadr f)))
- (when (symbolp f)
- (setq f (string-downcase (symbol-name f))))
- (when (stringp f)
- (unless (position #\. f)
- (setq f (concatenate 'string f ".html"))))
- (if (or (and (eq type :source) *sources-dir*)
- (and (eq type :output) *output-dir*))
- (merge-pathnames
- (make-pathname :name (pathname-name f)
- :type (pathname-type f)
- :directory (pathname-directory f))
- (ecase type
- (:source *sources-dir*)
- (:output *output-dir*)))
- (if (stringp f)
- (parse-namestring f)
- f)))
-
-(defmacro with-dir ((output &key sources) &body body)
- (let ((output-dir (gensym))
- (sources-dir (gensym)))
- `(let ((,output-dir ,output)
- (,sources-dir ,sources))
- (when (stringp ,output-dir)
- (setq ,output-dir (parse-namestring ,output-dir)))
- (when (stringp ,sources-dir)
- (setq ,sources-dir (parse-namestring ,sources-dir)))
- (unless ,sources-dir
- (setq ,sources-dir ,output-dir))
- (let ((*output-dir* ,output-dir)
- (*sources-dir* ,sources-dir))
- ,@body))))
-
-(defun lml-load-path (file &key optional)
- (if (probe-file file)
- (with-open-file (in file :direction :input)
- (do ((form (read in nil 'eof) (read in nil 'eof)))
- ((eq form 'eof))
- (eval form)))
- (unless optional
- (format *trace-output* "Warning: unable to load LML file ~S" file))))
-
-(defun process-dir (dir &key sources)
- (with-dir (dir :sources sources)
- (let ((lml-files (directory
- (make-pathname :defaults *sources-dir*
- :name :wild
- :type "lml"))))
- (dolist (file lml-files)
- (format *trace-output* "~&; Processing ~A~%" file)
- (lml-load-path file)))))
-
-(defun lml-load (file &key optional)
- (lml-load-path (eval `(lml-file-name ,file :source)) :optional optional))
-
-(defun insert-file (file)
- (print-file-contents file *html-stream*))
+++ /dev/null
-;; -*- mode: common-lisp; package: lml2 -*-
-;;
-;; $Id$
-;;
-;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA
-;; copyright (c) 2003 Kevin Rosenberg
-;;
-;; Main changes from Allegro version:
-;; - Support XHTML end tags
-;; - lowercase symbol names for attributes
-;; - Add custom tags such as :jscript, :insert-file, :load-file, :nbsp
-;; - removal of if* macro
-;; - Add attribute conditions
-;; - Automatic conversion to strings for attribute values
-;; - Convert some comments to function doc strings
-;;
-;; This code is free software; you can redistribute it and/or
-;; modify it under the terms of the version 2.1 of
-;; the GNU Lesser General Public License as published by
-;; the Free Software Foundation, as clarified by the LLGPL
-
-
-(in-package #:lml2)
-
-
-(defstruct (html-process (:type list) (:constructor
- make-html-process (key has-inverse
- macro special
- print
- name-attr
- )))
- key ; keyword naming this tag
- has-inverse ; t if the / form is used
- macro ; the macro to define this
- special ; if true then call this to process the keyword and return
- ; the macroexpansion
- print ; function used to handle this in html-print
- name-attr ; attribute symbols which can name this object for subst purposes
- )
-
-
-(defparameter *html-process-table*
- (make-hash-table :test #'equal) ; #'eq is accurate but want to avoid rehashes
- )
-
-(defmacro html (&rest forms &environment env)
- (post-process-html-forms
- (process-html-forms forms env)))
-
-(defun post-process-html-forms (input-forms)
- "KMR: Walk through forms and combine write-strings"
- (let (res strs last-stream)
- (flet ((flush-strings ()
- (when strs
- (push `(write-string ,strs ,last-stream) res)
- (setq strs nil)
- (setq last-stream nil))))
- (do* ((forms input-forms (cdr forms))
- (form (car forms) (car forms)))
- ((null forms)
- (flush-strings)
- (nreverse res))
- (cond
- ((atom form)
- (flush-strings)
- (push form res))
- ((and (eq (car form) 'cl:write-string)
- (stringp (cadr form)))
- (if strs
- (if (eq last-stream (third form))
- (setq strs (concatenate 'string strs (second form)))
- (progn
- (flush-strings)
- (setq strs (second form))
- (setq last-stream (third form))))
- (progn
- (setq strs (second form))
- (setq last-stream (third form)))))
- (t
- (flush-strings)
- (push (post-process-html-forms form) res)))))))
-
-
-(defmacro html-out-stream-check (stream)
- ;; ensure that a real stream is passed to this function
- (let ((s (gensym)))
- `(let ((,s ,stream))
- (unless (streamp ,s)
- (error "html-stream must be passed a stream object, not ~s" ,s))
- ,s)))
-
-
-(defmacro html-stream (stream &rest forms)
- ;; set output stream and emit html
- `(let ((*html-stream* (html-out-stream-check ,stream))) (html ,@forms)))
-
-
-(defun process-html-forms (forms env)
- (let (res)
- (flet ((do-ent (ent args argsp body)
- ;; ent is an html-process object associated with the
- ;; html tag we're processing
- ;; args is the list of values after the tag in the form
- ;; ((:tag &rest args) ....)
- ;; argsp is true if this isn't a singleton tag (i.e. it has
- ;; a body) .. (:tag ...) or ((:tag ...) ...)
- ;; body is the body if any of the form
- ;;
- (let (spec)
- (cond
- ((setq spec (html-process-special ent))
- ;; do something different
- (push (funcall spec ent args argsp body) res))
- ((null argsp)
- ;; singleton tag, just do the set
- (push `(,(html-process-macro ent) :set) res)
- nil)
- (t
- (cond ((equal args '(:unset))
- ;; ((:tag :unset)) is a special case.
- ;; that allows us to close off singleton tags
- ;; printed earlier.
- (push `(,(html-process-macro ent) :unset) res)
- nil)
- (t
- ;; some args
- (push `(,(html-process-macro ent)
- ,args
- ,(process-html-forms body env))
- res)
- nil)))))))
-
-
- (do* ((xforms forms (cdr xforms))
- (form (car xforms) (car xforms)))
- ((null xforms))
-
- (setq form (macroexpand form env))
-
- (if (atom form)
- (cond
- ((keywordp form)
- (let ((ent (gethash form *html-process-table*)))
- (if (null ent)
- (error "unknown html keyword ~s" form)
- (do-ent ent nil nil nil))))
- ((stringp form)
- ;; turn into a print of it
- (push `(write-string ,form *html-stream*) res))
- (t
- (push form res)))
- (let ((first (car form)))
- (cond
- ((keywordp first)
- ;; (:xxx . body) form
- (let ((ent (gethash first
- *html-process-table*)))
- (if (null ent)
- (error "unknown html keyword ~s" form)
- (do-ent ent nil t (cdr form)))))
- ((and (consp first) (keywordp (car first)))
- ;; ((:xxx args ) . body)
- (let ((ent (gethash (car first)
- *html-process-table*)))
- (if (null ent)
- (error "unknown html keyword ~s" form)
- (do-ent ent (cdr first) t (cdr form)))))
- (t
- (push form res)))))))
- `(progn ,@(nreverse res))))
-
-
-(defun html-atom-check (args open close body)
- (when (and args (atom args))
- (let ((ans (case args
- (:set `(write-string ,open *html-stream*))
- (:unset `(write-string ,close *html-stream*))
- (t (error "illegal arg ~s to ~s" args open)))))
- (if (and ans body)
- (error "can't have a body form with this arg: ~s" args)
- ans))))
-
-(defun html-body-form (open close body)
- ;; used when args don't matter
- `(progn (write-string ,open *html-stream*)
- ,@body
- (write-string ,close *html-stream*)))
-
-
-(defun attribute-name-string (name)
- (etypecase name
- (symbol (string-downcase (symbol-name name)))
- (string name)))
-
-(defun process-attributes (args)
- (flet ((write-attribute-name-forms (name)
- `((write-char #\space *html-stream*)
- (write-string ,(attribute-name-string name)
- *html-stream*)))
- (write-separator-forms ()
- '((write-char #\= *html-stream*)
- (write-char #\" *html-stream*))))
- (do* ((xx args (cddr xx))
- (res)
- (name (first xx) (first xx))
- (value (second xx) (second xx)))
- ((null xx)
- (nreverse res))
- (case name
- (:fformat
- (unless (and (listp value)
- (>= (length value) 2))
- (error ":fformat must be given a list at least 2 elements"))
- (mapcar (lambda (f) (push f res))
- (write-attribute-name-forms (first value)))
- (mapcar (lambda (f) (push f res))
- (write-separator-forms))
- (push `(fformat *html-stream* ,(second value) ,@(cddr value))
- res)
- (push `(write-char #\" *html-stream*) res))
- (:format
- (unless (and (listp value) (>= (length value) 2))
- (error ":format must be given a list at least 2 elements"))
- (mapcar (lambda (f) (push f res))
- (write-attribute-name-forms (first value)))
- (push `(prin1-safe-http-string
- (format nil ,(second value) ,@(cddr value)))
- res))
- (:optional
- (let ((eval-if (gensym "EVAL-IF-")))
- (push `(let ((,eval-if ,(second value)))
- (when ,eval-if
- ,@(write-attribute-name-forms (first value))
- (prin1-safe-http-string ,eval-if)))
- res)))
- (:if
- (unless (and (listp value)
- (>= (length value) 3)
- (<= (length value) 4))
- (error ":if must be given a list with 3 and 4 elements"))
- (let ((eval-if (gensym "EVAL-IF-")))
- (push `(let ((,eval-if ,(second value)))
- ,@(write-attribute-name-forms (first value))
- (prin1-safe-http-string
- (if ,eval-if
- ,(third value)
- ,(fourth value))))
- res)))
- (:when
- (unless (and (listp value)
- (= (length value) 3))
- (error ":when must be given a list with 3 elements"))
- (push `(when ,(second value)
- ,@(write-attribute-name-forms (first value))
- (prin1-safe-http-string ,(third value)))
- res))
- (t
- (mapcar (lambda (f) (push f res))
- (write-attribute-name-forms name))
- (push `(prin1-safe-http-string ,value) res))))))
-
-(defun html-body-key-form (string-code has-inv args body)
- ;; do what's needed to handle given keywords in the args
- ;; then do the body
- (when (and args (atom args))
- ;; single arg
- (return-from html-body-key-form
- (case args
- (:set (if has-inv
- `(write-string ,(format nil "<~a>" string-code)
- *html-stream*)
- `(write-string ,(format nil "<~a />" string-code)
- *html-stream*)))
- (:unset (when has-inv
- `(write-string ,(format nil "</~a>" string-code)
- *html-stream*)))
- (t (error "illegal arg ~s to ~s" args string-code)))))
-
- (unless (evenp (length args))
- (warn "arg list ~s isn't even" args))
-
-
- (if args
- `(progn (write-string ,(format nil "<~a" string-code)
- *html-stream*)
-
- ,@(process-attributes args)
-
- ,(unless has-inv `(write-string " /" *html-stream*))
- (write-string ">" *html-stream*)
- ,@body
- ,(when (and body has-inv)
- `(write-string ,(format nil "</~a>" string-code)
- *html-stream*)))
- (if has-inv
- `(progn (write-string ,(format nil "<~a>" string-code)
- *html-stream*)
- ,@body
- ,(when body
- `(write-string ,(format nil "</~a>" string-code)
- *html-stream*)))
- `(progn (write-string ,(format nil "<~a />" string-code)
- *html-stream*)))))
-
-
-
-(defun princ-http (val)
- ;; print the given value to the http stream using ~a
- (format *html-stream* "~a" val))
-
-(defun prin1-http (val)
- ;; print the given value to the http stream using ~s
- (format *html-stream* "~s" val))
-
-
-(defun princ-safe-http (val)
- (emit-safe *html-stream* (format nil "~a" val)))
-
-(defun prin1-safe-http (val)
- (emit-safe *html-stream* (format nil "~s" val)))
-
-
-(defun prin1-safe-http-string (val)
- ;; used only in a parameter value situation
- ;;
- ;; if the parameter value is the symbol with the empty print name
- ;; then turn this into a singleton object. Thus || is differnent
- ;; than "".
- ;;
- ;; print the contents inside a string double quotes (which should
- ;; not be turned into "'s
- ;; symbols are turned into their name
- ;;
- ;; non-string and non-symbols are written to a string and quoted
-
- (unless (and (symbolp val)
- (equal "" (symbol-name val)))
- (write-char #\= *html-stream*)
- (when (not (or (stringp val)
- (symbolp val)))
- (setq val (write-to-string val)))
- (if (or (stringp val)
- (and (symbolp val)
- (setq val (string-downcase
- (symbol-name val)))))
- (progn
- (write-char #\" *html-stream*)
- (emit-safe *html-stream* val)
- (write-char #\" *html-stream*))
- (prin1-safe-http val))))
-
-
-(defun emit-safe (stream string)
- "Send the string to the http response stream watching out for
- special html characters and encoding them appropriately."
- (do* ((i 0 (1+ i))
- (start i)
- (end (length string)))
- ((>= i end)
- (when (< start i)
- (write-sequence string stream :start start :end i)))
-
- (let* ((ch (schar string i))
- (cvt (case ch
- (#\< "<")
- (#\> ">")
- (#\& "&")
- (#\" """))))
- (when cvt
- ;; must do a conversion, emit previous chars first
- (when (< start i)
- (write-sequence string stream :start start :end i))
- (write-string cvt stream)
- (setq start (1+ i))))))
-
-
-
-(defun html-print-list (list-of-forms stream &key unknown)
- ;; html print a list of forms
- (dolist (x list-of-forms)
- (html-print-subst x nil stream unknown)))
-
-
-(defun html-print-list-subst (list-of-forms subst stream &key unknown)
- ;; html print a list of forms
- (dolist (x list-of-forms)
- (html-print-subst x subst stream unknown)))
-
-
-(defun html-print (form stream &key unknown)
- (html-print-subst form nil stream unknown))
-
-
-(defun html-print-subst (form subst stream unknown)
- ;; Print the given lhtml form to the given stream
- (assert (streamp stream))
-
-
- (let* ((attrs)
- (attr-name)
- (name)
- (possible-kwd (cond
- ((atom form) form)
- ((consp (car form))
- (setq attrs (cdar form))
- (caar form))
- (t (car form))))
- print-handler
- ent)
- (when (keywordp possible-kwd)
- (if (null (setq ent (gethash possible-kwd *html-process-table*)))
- (if unknown
- (return-from html-print-subst
- (funcall unknown form stream))
- (error "unknown html tag: ~s" possible-kwd))
- ;; see if we should subst
- (when (and subst
- attrs
- (setq attr-name (html-process-name-attr ent))
- (setq name (getf attrs attr-name))
- (setq attrs (html-find-value name subst)))
- (return-from html-print-subst
- (if (functionp (cdr attrs))
- (funcall (cdr attrs) stream)
- (html-print-subst
- (cdr attrs)
- subst
- stream
- unknown)))))
-
- (setq print-handler
- (html-process-print ent)))
-
- (cond
- ((atom form)
- (cond
- ((keywordp form)
- (funcall print-handler ent :set nil nil nil nil stream))
- ((stringp form)
- (write-string form stream))
- (t
- (princ form stream))))
- (ent
- (funcall print-handler
- ent
- :full
- (when (consp (car form)) (cdr (car form)))
- form
- subst
- unknown
- stream))
- (t
- (error "Illegal form: ~s" form)))))
-
-
-(defun html-find-value (key subst)
- ; find the (key . value) object in the subst list.
- ; A subst list is an assoc list ((key . value) ....)
- ; but instead of a (key . value) cons you may have an assoc list
- ;
- (let ((to-process nil)
- (alist subst))
- (loop
- (do* ((entlist alist (cdr entlist))
- (ent (car entlist) (car entlist)))
- ((null entlist) (setq alist nil))
- (cond
- ((consp (car ent))
- ;; this is another alist
- (when (cdr entlist)
- (push (cdr entlist) to-process))
- (setq alist ent)
- (return)) ; exit do*
- ((equal key (car ent))
- (return-from html-find-value ent))))
-
- (when (null alist)
- ;; we need to find a new alist to process
- (if to-process
- (setq alist (pop to-process))
- (return))))))
-
-(defun html-standard-print (ent cmd args form subst unknown stream)
- ;; the print handler for the normal html operators
- (ecase cmd
- (:set ; just turn it on
- (format stream "<~a>" (html-process-key ent)))
- (:full ; set, do body and then unset
- (let (iter)
- (if args
- (cond
- ((and (setq iter (getf args :iter))
- (setq iter (html-find-value iter subst)))
- ;; remove the iter and pre
- (setq args (copy-list args))
- (remf args :iter)
- (funcall (cdr iter)
- (cons (cons (caar form)
- args)
- (cdr form))
- subst
- stream)
- (return-from html-standard-print))
- (t
- (format stream "<~a" (html-process-key ent))
- (do ((xx args (cddr xx)))
- ((null xx))
- ; assume that the arg is already escaped
- ; since we read it
- ; from the parser
- (format stream " ~a=\"~a\"" (car xx) (cadr xx)))
- (format stream ">")))
- (format stream "<~a>" (html-process-key ent)))
- (dolist (ff (cdr form))
- (html-print-subst ff subst stream unknown)))
- (when (html-process-has-inverse ent)
- ;; end the form
- (format stream "</~a>" (html-process-key ent))))))
-
-
-
-
-
-
-
-
-;; -- defining how html tags are handled. --
-;;
-;; most tags are handled in a standard way and the def-std-html
-;; macro is used to define such tags
-;;
-;; Some tags need special treatment and def-special-html defines
-;; how these are handled. The tags requiring special treatment
-;; are the pseudo tags we added to control operations
-;; in the html generator.
-;;
-;;
-;; tags can be found in three ways:
-;; :br - singleton, no attributes, no body
-;; (:b "foo") - no attributes but with a body
-;; ((:a href="foo") "balh") - attributes and body
-;;
-
-
-
-(defmacro def-special-html (kwd fcn print-fcn)
- ;; kwd - the tag we're defining behavior for.
- ;; fcn - function to compute the macroexpansion of a use of this
- ;; tag. args to fcn are:
- ;; ent - html-process object holding info on this tag
- ;; args - list of attribute-values following tag
- ;; argsp - true if there is a body in this use of the tag
- ;; body - list of body forms.
- ;; print-fcn - function to print an lhtml form with this tag
- ;; args to fcn are:
- ;; ent - html-process object holding info on this tag
- ;; cmd - one of :set, :unset, :full
- ;; args - list of attribute-value pairs
- ;; subst - subsitution list
- ;; unknown - function to call for unknown tags
- ;; stream - stream to write to
- ;;
- `(setf (gethash ,kwd *html-process-table*)
- (make-html-process ,kwd nil nil ,fcn ,print-fcn nil)))
-
-
-(defmacro named-function (name &body body)
- (declare (ignore name))
- `(function ,@body))
-
-
-(def-special-html :newline
- (named-function html-newline-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- (when body
- (error "can't have a body with :newline -- body is ~s" body))
- `(terpri *html-stream*)))
-
- (named-function html-newline-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore args ent unknown subst))
- (if (eq cmd :set)
- (terpri stream)
- (error ":newline in an illegal place: ~s" form)))))
-
-(def-special-html :princ
- (named-function html-princ-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- `(progn ,@(mapcar #'(lambda (bod)
- `(princ-http ,bod))
- body))))
-
- (named-function html-princ-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore args ent unknown subst))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (format stream "~a" (cadr form))
- (error ":princ must be given an argument")))))
-
-(def-special-html :princ-safe
- (named-function html-princ-safe-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- `(progn ,@(mapcar #'(lambda (bod)
- `(princ-safe-http ,bod))
- body))))
- (named-function html-princ-safe-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore args ent unknown subst))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (emit-safe stream (format nil "~a" (cadr form)))
- (error ":princ-safe must be given an argument")))))
-
-(def-special-html :prin1
- (named-function html-prin1-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- `(progn ,@(mapcar #'(lambda (bod)
- `(prin1-http ,bod))
- body))))
- (named-function html-prin1-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore ent args unknown subst))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (format stream "~s" (cadr form))
- (error ":prin1 must be given an argument")))))
-
-(def-special-html :prin1-safe
- (named-function html-prin1-safe-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- `(progn ,@(mapcar #'(lambda (bod)
- `(prin1-safe-http ,bod))
- body))))
- (named-function html-prin1-safe-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore args ent subst unknown))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (emit-safe stream (format nil "~s" (cadr form)))
- (error ":prin1-safe must be given an argument")))))
-
-(def-special-html :comment
- (named-function html-comment-function
- (lambda (ent args argsp body)
- ;; must use <!-- --> syntax
- (declare (ignore ent args argsp))
- `(progn (write-string "<!--" *html-stream*)
- (html ,@body)
- (write-string "-->" *html-stream*))))
- (named-function html-comment-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore ent cmd args subst unknown))
- (format stream "<!--~a-->" (cadr form)))))
-
-
-
-(defmacro def-std-html (kwd has-inverse name-attrs)
- (let ((mac-name (intern (format nil "~a-~a" :with-html kwd)))
- (string-code (string-downcase (string kwd))))
- `(progn (setf (gethash ,kwd *html-process-table*)
- (make-html-process ,kwd ,has-inverse
- ',mac-name
- nil
- #'html-standard-print
- ',name-attrs))
- (defmacro ,mac-name (args &rest body)
- (html-body-key-form ,string-code ,has-inverse args body)))))
-
-
-
-(def-std-html :a t nil)
-(def-std-html :abbr t nil)
-(def-std-html :acronym t nil)
-(def-std-html :address t nil)
-(def-std-html :applet t nil)
-(def-std-html :area nil nil)
-
-(def-std-html :b t nil)
-(def-std-html :base nil nil)
-(def-std-html :basefont nil nil)
-(def-std-html :bdo t nil)
-(def-std-html :bgsound nil nil)
-(def-std-html :big t nil)
-(def-std-html :blink t nil)
-(def-std-html :blockquote t nil)
-(def-std-html :body t nil)
-(def-std-html :br nil nil)
-(def-std-html :button nil nil)
-
-(def-std-html :caption t nil)
-(def-std-html :center t nil)
-(def-std-html :cite t nil)
-(def-std-html :code t nil)
-(def-std-html :col nil nil)
-(def-std-html :colgroup nil nil)
-
-(def-std-html :dd t nil)
-(def-std-html :del t nil)
-(def-std-html :dfn t nil)
-(def-std-html :dir t nil)
-(def-std-html :div t nil)
-(def-std-html :dl t nil)
-(def-std-html :dt t nil)
-
-(def-std-html :em t nil)
-(def-std-html :embed t nil)
-
-(def-std-html :fieldset t nil)
-(def-std-html :font t nil)
-(def-std-html :form t :name)
-(def-std-html :frame t nil)
-(def-std-html :frameset t nil)
-
-(def-std-html :h1 t nil)
-(def-std-html :h2 t nil)
-(def-std-html :h3 t nil)
-(def-std-html :h4 t nil)
-(def-std-html :h5 t nil)
-(def-std-html :h6 t nil)
-(def-std-html :head t nil)
-(def-std-html :hr nil nil)
-(def-std-html :html t nil)
-
-(def-std-html :i t nil)
-(def-std-html :iframe t nil)
-(def-std-html :ilayer t nil)
-(def-std-html :img nil :id)
-(def-std-html :input nil nil)
-(def-std-html :ins t nil)
-(def-std-html :isindex nil nil)
-
-(def-std-html :kbd t nil)
-(def-std-html :keygen nil nil)
-
-(def-std-html :label t nil)
-(def-std-html :layer t nil)
-(def-std-html :legend t nil)
-(def-std-html :li t nil)
-(def-std-html :link nil nil)
-(def-std-html :listing t nil)
-
-(def-std-html :map t nil)
-(def-std-html :marquee t nil)
-(def-std-html :menu t nil)
-(def-std-html :meta nil nil)
-(def-std-html :multicol t nil)
-
-(def-std-html :nobr t nil)
-(def-std-html :noembed t nil)
-(def-std-html :noframes t nil)
-(def-std-html :noscript t nil)
-
-(def-std-html :object t nil)
-(def-std-html :ol t nil)
-(def-std-html :optgroup t nil)
-(def-std-html :option t nil)
-
-(def-std-html :p t nil)
-(def-std-html :param t nil)
-(def-std-html :plaintext nil nil)
-(def-std-html :pre t nil)
-
-(def-std-html :q t nil)
-
-(def-std-html :s t nil)
-(def-std-html :samp t nil)
-(def-std-html :script t nil)
-(def-std-html :select t nil)
-(def-std-html :server t nil)
-(def-std-html :small t nil)
-(def-std-html :spacer nil nil)
-(def-std-html :span t :id)
-(def-std-html :strike t nil)
-(def-std-html :strong t nil)
-(def-std-html :style t nil)
-(def-std-html :sub t nil)
-(def-std-html :sup t nil)
-
-(def-std-html :table t :name)
-(def-std-html :tbody t nil)
-(def-std-html :td t nil)
-(def-std-html :textarea t nil)
-(def-std-html :tfoot t nil)
-(def-std-html :th t nil)
-(def-std-html :thead t nil)
-(def-std-html :title t nil)
-(def-std-html :tr t nil)
-(def-std-html :tt t nil)
-
-(def-std-html :u t nil)
-(def-std-html :ul t nil)
-
-(def-std-html :var t nil)
-
-(def-std-html :wbr nil nil)
-
-(def-std-html :xmp t nil)
-
-
-
-
-;;; KMR Local Additions
-
-(def-special-html :jscript
- (named-function html-comment-function
- (lambda (ent args argsp body)
- ;; must use <!-- --> syntax
- (declare (ignore ent args argsp))
- `(progn
- #+ignore
- (write-string "<script language=\"JavaScript\" type=\"text/javascript\">" *html-stream*)
- (write-string "<script type=\"text/javascript\">" *html-stream*)
- (write-char #\newline *html-stream*)
- (write-string "// <![CDATA[" *html-stream*)
- (write-char #\newline *html-stream*)
- (html ,@body)
- (write-char #\newline *html-stream*)
- (write-string "// ]]>" *html-stream*)
- (write-char #\newline *html-stream*)
- (write-string "</script>" *html-stream*))))
- (named-function html-comment-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore ent cmd args subst unknown))
- (format stream "<script language=\"JavaScript\" type=\"text/javascript\">~%// <![CDATA[~%~A~%// ]]>~%</script>"
- (cadr form)))))
-
-(def-special-html :nbsp
- (named-function html-nbsp-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- (when body
- (error "can't have a body with :nbsp -- body is ~s" body))
- `(write-string " " *html-stream*)))
-
- (named-function html-nbsp-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore args ent unknown subst))
- (if (eq cmd :set)
- (write-string " " stream)
- (error ":nbsp in an illegal place: ~s" form)))))
-
-
-(def-special-html :load-file
- (named-function html-nbsp-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- (unless body
- (error "must have a body with :load-file"))
- `(progn ,@(mapcar #'(lambda (bod)
- `(lml-load ,bod))
- body))))
-
- (named-function html-nbsp-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore ent unknown subst stream args))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (lml-load (cadr form))
- (error ":load-file must be given an argument")))))
-
-(def-special-html :insert-file
- (named-function html-nbsp-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- (unless body
- (error "must have a body with :insert-file"))
- `(progn ,@(mapcar #'(lambda (bod)
- `(insert-file ,bod))
- body))))
-
- (named-function html-nbsp-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore ent unknown subst stream args))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (insert-file (cadr form))
- (error ":insert-file must be given an argument")))))
-
-(def-special-html :write-string
- (named-function html-write-string-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- (if (= (length body) 1)
- `(write-string ,(car body) *html-stream*)
- `(progn ,@(mapcar #'(lambda (bod)
- `(write-string ,bod *html-stream*))
- body)))))
-
- (named-function html-write-string-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore args ent unknown subst))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (write-string (cadr form) stream)
- (error ":write-string must be given an argument")))))
-
-(def-special-html :write-char
- (named-function html-write-char-function
- (lambda (ent args argsp body)
- (declare (ignore ent args argsp))
- `(progn ,@(mapcar #'(lambda (bod)
- `(write-char ,bod *html-stream*))
- body))))
-
- (named-function html-write-char-print-function
- (lambda (ent cmd args form subst unknown stream)
- (declare (ignore args ent unknown subst))
- (assert (eql 2 (length form)))
- (if (eq cmd :full)
- (write-char (cadr form) stream)
- (error ":write-char must be given an argument")))))
-
-
-
+++ /dev/null
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: lml2-tests.asd
-;;;; Purpose: ASDF system definitionf for lml2 testing package
-;;;; Author: Kevin M. Rosenberg
-;;;; Date Started: Apr 2003
-;;;;
-;;;; $Id$
-;;;; *************************************************************************
-
-(defpackage #:lml2-tests-system
- (:use #:asdf #:cl))
-(in-package #:lml2-tests-system)
-
-(defsystem lml2-tests
- :depends-on (:rt :lml2)
- :in-order-to ((test-op (load-op lml2-tests)))
- :components ((:file "tests")))
-
-(defmethod perform ((o test-op) (c (eql (find-system 'lml2-tests))))
- (or (funcall (intern (symbol-name '#:do-tests)
- (find-package '#:regression-test)))
- (error "test-op failed")))
-
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: lml2.asd
-;;;; Purpose: ASDF definition file for Lisp Markup Language Version 2
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Aug 2002
-;;;;
-;;;; $Id$
-;;;;
-;;;; 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 #:cl-user)
-(defpackage #:lml2-system (:use #:asdf #:cl))
-(in-package #:lml2-system)
-
-(defsystem lml2
- :name "lml2"
- :author "Kevin M. Rosenberg <kevin@rosenberg.net>"
- :version "1.0"
- :maintainer "Kevin M. Rosenberg <kmr@debian.org>"
- :licence "GNU General Public License"
- :description "Lisp Markup Language"
- :long-description "LML2 provides creation of XHTML for Lisp programs."
-
- :depends-on (kmrcl)
-
- :components
- ((:file "package")
- (:file "data" :depends-on ("package"))
- (:file "htmlgen" :depends-on ("data"))
- (:file "utils" :depends-on ("package"))
- (:file "files" :depends-on ("utils" "htmlgen"))
- (:file "base" :depends-on ("files"))
- #+ignore (:file "read-macro" :depends-on ("base"))
- (:file "stdsite" :depends-on ("base"))
- (:file "downloads" :depends-on ("base"))
- (:file "apache-dir" :depends-on ("base"))
- ))
-
-(defmethod perform ((o test-op) (c (eql (find-system 'lml2))))
- (operate 'load-op 'lml2-tests)
- (operate 'test-op 'lml2-tests))
-
-(defmethod operation-done-p ((o test-op) (c (eql (find-system 'lml2-tests))))
- (values nil))
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: package.lisp
-;;;; Purpose: Package file for Lisp Markup Language 2
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: June 2003
-;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-(in-package #:cl-user)
-
-(defpackage #:lisp-markup-language-2
- (:use #:common-lisp #:kmrcl)
- (:nicknames #:lml2)
- (:export
-
- ;; data.lisp
- #:*html-stream*
-
- ;; base.lisp
- #:html-file-page
- #:dtd-prologue
- #:lml-format
- #:lml-print
- #:lml-princ
- #:lml-write-char
- #:lml-write-string
- #:lml-print-date
- #:alink
- #:alink-c
-
- ;; htmlgen.lisp
- #:html #:html-print #:html-print-subst #:html-print-list #:html-print-list-subst
- #:html-stream #:*html-stream*
-
-
- ;; files.lisp
- #:with-dir
- #:process-dir
- #:lml-load
- #:insert-file
-
- ;; stdsite.lisp
- #:print-std-page
- #:std-page
- #:std-body
- #:std-head
- #:titled-pre-section
-
- ;; downloads.lisp
- #:std-dl-page
- #:full-dl-page
-
- ;; utils.lisp
- #:lml-quit
- #:lml-cwd
-
- ;; apache-dir
- #:write-html-apache-directory
-))
+++ /dev/null
-;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: read-macro.lisp
-;;;; Purpose: Lisp Markup Language functions
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Aug 2002
-;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-(in-package #:lml2)
-
-(defun new-string ()
- (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character))
-
-(set-macro-character #\[
- #'(lambda (stream char)
- (declare (ignore char))
- (let ((forms '())
- (curr-string (new-string))
- (paren-level 0)
- (got-comma nil))
- (declare (type fixnum paren-level))
- (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
- ((eql ch #\]))
- (if got-comma
- (if (eql ch #\()
- ;; Starting top-level ,(
- (progn
- #+cmu
- (setf curr-string (coerce curr-string `(simple-array character (*))))
-
- (push `(lml2-princ ,curr-string) forms)
- (setq curr-string (new-string))
- (setq got-comma nil)
- (vector-push #\( curr-string)
- (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
- ((and (eql ch #\)) (zerop paren-level)))
- (when (eql ch #\])
- (format *trace-output* "Syntax error reading #\]")
- (return nil))
- (case ch
- (#\(
- (incf paren-level))
- (#\)
- (decf paren-level)))
- (vector-push-extend ch curr-string))
- (vector-push-extend #\) curr-string)
- (let ((eval-string (read-from-string curr-string))
- (res (gensym)))
- (push
- `(let ((,res ,eval-string))
- (when ,res
- (lml2-princ ,res)))
- forms))
- (setq curr-string (new-string)))
- ;; read comma, then non #\( char
- (progn
- (unless (eql ch #\,)
- (setq got-comma nil))
- (vector-push-extend #\, curr-string) ;; push previous command
- (vector-push-extend ch curr-string)))
- ;; previous character is not a comma
- (if (eql ch #\,)
- (setq got-comma t)
- (progn
- (setq got-comma nil)
- (vector-push-extend ch curr-string)))))
-
- #+cmu
- (setf curr-string (coerce curr-string `(simple-array character (*))))
-
- (push `(lml2-princ ,curr-string) forms)
- `(progn ,@(nreverse forms)))))
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: stdsite.lisp
-;;;; Purpose: Functions to create my standard style sites
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Aug 2002
-;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-
-;;; A "standard site" is a format for a certain style of web page.
-;;; It is based on the LML2 package.
-;;; A stdsite page expects to include the following files:
-;;; header.lml_
-;;; banner.lml_
-;;; content.lml_
-;;; footer.lml_
-;;; These files are optional
-;;; final.lml_
-;;; rightcol.lml_
-
-(in-package #:lml2)
-
-(defmacro std-head (title &body body)
- `(html
- (:head
- (:title (:princ ,title))
- (lml-load "header.lml_")
- ,@body)))
-
-
-(defun std-footer (file)
- (html
- ((:div :class "disclaimsec")
- (let ((src-file (make-pathname
- :defaults *sources-dir*
- :type "lml"
- :name (pathname-name file))))
- (when (probe-file src-file)
- (html
- ((:div :class "lastmod")
- (lml-format "Last modified: ~A" (date-string (file-write-date src-file)))))))
- (lml-load "footer.lml_"))))
-
-
-(defmacro std-body (file &body body)
- `(html
- (:body
- (lml-load "banner.lml_")
- ((:table :class "stdbodytable" :border "0" :cellpadding "3")
- (:tbody
- ((:tr :valign "top")
- ((:td :class "stdcontentcell")
- (lml-load "contents.lml_"))
- ((:td :valign "top")
- ,@body
- (std-footer ,file))
- ((:td :valign "top")
- (lml-load "rightcol.lml_" :optional t)))))
- (lml-load "final.lml_" :optional t))))
-
-
-(defmacro print-std-page (file title format &body body)
- `(progn
- (dtd-prologue ,format)
- (html
- ((:html :xmlns "http://www.w3.org/1999/xhtml")
- (std-head ,title)
- (std-body ,file ,@body)))))
-
-(defmacro std-page ((out-file title &key (format :xhtml11))
- &body body)
- `(let ((*indent* 0))
- (with-open-file (*html-stream* (lml-file-name ',out-file :output)
- :direction :output
- :if-exists :supersede)
- (print-std-page (lml-file-name ',out-file :source) ,title ,format ,@body))))
-
-(defmacro titled-pre-section (title &body body)
- `(progn
- (html
- (:h1 ,title)
- ((:pre "style" "padding-left:30pt;")
- ,@body))))
-
-
-
+++ /dev/null
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: tests.lisp
-;;;; Purpose: tests file
-;;;; Author: Kevin M. Rosenberg
-;;;; Date Started: Oct 2006
-;;;;
-;;;; $Id$
-;;;;
-;;;; Copyright (c) 2006 by Kevin Rosenberg.
-;;;; *************************************************************************
-
-(in-package #:cl)
-(defpackage #:gmparse-tests
- (:use #:gmparse #:cl #:rtest))
-(in-package #:gmparse-tests)
-
-(rem-all-tests)
-
+++ /dev/null
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: utils.lisp
-;;;; Purpose: General purpose utilities
-;;;; Author: Kevin M. Rosenberg
-;;;; Date Started: June 2002
-;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of LML2, is copyrighted and open-source software.
-;;;; Rights of modification and redistribution are in the LICENSE file.
-;;;;
-;;;; *************************************************************************
-
-(in-package #:lml2)
-
-
-(defun lml-quit (&optional (code 0))
- "Function to exit the Lisp implementation."
- (kmrcl:quit code))
-
-(defun lml-cwd ()
- "Returns the current working directory."
- (kmrcl:cwd))
-
-(defmacro fformat (stream control-string &rest args)
- (if stream
- `(funcall (formatter ,control-string) ,stream ,@args)
- `(format nil ,control-string ,@args)))
-
projects / lml.git / commitdiff