From aab275e8e82b4a4a4af4749d79ca49d2dd596c1c Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 25 Nov 2002 07:45:36 +0000 Subject: [PATCH] r3474: *** empty log message *** --- debian/changelog | 6 ++ debian/control | 2 +- equal.lisp | 41 +++++++++-- kmrcl.asd | 14 +--- package.lisp | 31 ++------- web-utils-aserve.lisp | 157 ------------------------------------------ xml-utils.lisp | 5 +- 7 files changed, 53 insertions(+), 203 deletions(-) delete mode 100644 web-utils-aserve.lisp diff --git a/debian/changelog b/debian/changelog index d2fe268..d55348b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-kmrcl (1.21-1) unstable; urgency=low + + * Remore allegroserve dependant modules + + -- Kevin M. Rosenberg Sun, 24 Nov 2002 13:13:05 -0700 + cl-kmrcl (1.20.2-1) unstable; urgency=low * Remove 'load-compiled-op from .asd file diff --git a/debian/control b/debian/control index 3a4852b..9a731cb 100644 --- a/debian/control +++ b/debian/control @@ -7,7 +7,7 @@ Standards-Version: 3.5.8.0 Package: cl-kmrcl Architecture: all -Depends: ${shlibs:Depends}, common-lisp-controller, cl-aserve +Depends: ${shlibs:Depends}, common-lisp-controller Description: General Utilities for Common Lisp Programs This package includes general purpose utilities for Common Lisp programs. It is packages for Debian primarily to support more complex diff --git a/equal.lisp b/equal.lisp index b773db0..8049ed1 100644 --- a/equal.lisp +++ b/equal.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: equal.lisp,v 1.1 2002/10/12 06:10:17 kevin Exp $ +;;;; $Id: equal.lisp,v 1.2 2002/11/25 07:45:36 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -87,15 +87,42 @@ (return-from test nil))) (return-from test t))) -#+(or allegro lispworks) -(defun class-slot-names (class-name) +(defun class-slot-names (c-name) "Given a CLASS-NAME, returns a list of the slots in the class." + #+(or allegro lispworks scl) (mapcar #'clos:slot-definition-name - (clos:class-slots (find-class class-name)))) + (clos:class-slots (find-class c-name))) + #+sbcl (mapcar #'sb-pcl::slot-definition-name + (sb-pcl:class-slots (sb-pcl:find-class c-name))) + #+cmu (mapcar #'pcl::slot-definition-name + (pcl:class-slots (pcl:find-class c-name))) + #+mcl + (let* ((class (find-class class-name nil))) + (when (typep class 'standard-class) + (map 'list #'car (ccl::%class-instance-slotds class)))) + #-(or allegro lispworks cmu mcl sbcl scl) + (error "class-slot-names is not defined on this platform") + ) -#-(or allegro lispworks) -(defun class-slot-names (class-name) - (warn "class-slot-names not supported on this platform")) +(defun structure-slot-names (s-name) + "Given a STRUCTURE-NAME, returns a list of the slots in the structure." + #+allegro (class-slot-names s-name) + #+lispworks (structure:structure-class-slot-names + (find-class s-name)) + #+sbcl (mapcar #'sb-pcl::slot-definition-name + (sb-pcl:class-slots (sb-pcl:find-class s-name))) + #+cmu (mapcar #'pcl::slot-definition-name + (pcl:class-slots (pcl:find-class s-name))) + #+scl (mapcar #'kernel:dsd-name + (kernel:dd-slots + (kernel:layout-info + (kernel:class-layout (find-class s-name))))) + #+mcl (let* ((sd (gethash s-name ccl::%defstructs%)) + (slots (if sd (ccl::sd-slots sd)))) + (mapcar #'car (if (symbolp (caar slots)) slots (cdr slots)))) + #-(or allegro lispworks cmu sbcl scl mcl) + (error "structure-slot-names is not defined on this platform") + ) (defun function-to-string (obj) diff --git a/kmrcl.asd b/kmrcl.asd index 5e9f1e4..d3c69b5 100644 --- a/kmrcl.asd +++ b/kmrcl.asd @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: kmrcl.asd,v 1.21 2002/11/08 16:51:40 kevin Exp $ +;;;; $Id: kmrcl.asd,v 1.22 2002/11/25 07:45:36 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -16,10 +16,6 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -#+allegro (require :pxml) -#+(and allegro common-lisp-controller) (c-l-c::clc-require :aserve) -#+(and allegro (not common-lisp-controller)) (require :aserve) - (in-package :asdf) (defsystem :kmrcl @@ -29,7 +25,7 @@ ((:file "package") (:file "genutils" :depends-on ("package")) (:file "strings" :depends-on ("package")) - #+(or allegro lispworks) (:file "equal" :depends-on ("package")) + (:file "equal" :depends-on ("package")) (:file "buff-input" :depends-on ("genutils")) (:file "telnet-server" :depends-on ("genutils")) (:file "random" :depends-on ("package")) @@ -37,11 +33,7 @@ (:file "math" :depends-on ("package")) #+allegro (:file "attrib-class" :depends-on ("package")) (:file "web-utils" :depends-on ("package")) - (:file "xml-utils" :depends-on ("package")) - #+(or allegro aserve) (:file "web-utils-aserve" :depends-on ("strings" "genutils"))) - - #+(and common-lisp-controller (or cmu lispworks mcl)) :depends-on - #+(and common-lisp-controller (or cmu lispworks mcl)) (:aserve) + (:file "xml-utils" :depends-on ("package"))) ) diff --git a/package.lisp b/package.lisp index afb5385..8646698 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.12 2002/11/07 22:08:41 kevin Exp $ +;;;; $Id: package.lisp,v 1.13 2002/11/25 07:45:36 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -22,11 +22,7 @@ (defpackage #:kmrcl (:nicknames :kl) - (:use :common-lisp - #+(or aserve allegro) :net.html.generator - #+(or aserve allegro) :net.aserve - #+allegro :net.xml.parser - ) + (:use :common-lisp) (:export #:bind-if #:bind-when #:aif @@ -110,31 +106,14 @@ #:start-telnet-server ;; From web-utils + #:*base-url* + #:base-url! + #:make-url #:*standard-html-header* #:*standard-xhtml-header* #:*standard-xml-header* #:xml-cdata #:user-agent-ie-p - - ;; From web-utils-aserve - #:cgi-var - #:print-http - #:princ-http - #:base-url! - #:make-url - #:with-tag - #:with-tag-attribute - #:princ-http-with-color - #:princ-http-with-size - #:with-link - #:home-link - #:head - #:with-page - #:wrap-with-xml - #:parse-xml-no-ws - #:positions-xml-tag-contents - #:xml-tag-contents - #:encode-query )) diff --git a/web-utils-aserve.lisp b/web-utils-aserve.lisp deleted file mode 100644 index 6ace751..0000000 --- a/web-utils-aserve.lisp +++ /dev/null @@ -1,157 +0,0 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: web-utils-aserve.lisp -;;;; Purpose: Web utilities based on aserve functions -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 -;;;; -;;;; $Id: web-utils-aserve.lisp,v 1.10 2002/10/18 07:28:57 kevin Exp $ -;;;; -;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; KMRCL users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - - -(in-package :kmrcl) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) - - -;;; AllegroServe interaction functions - -(defun cgi-var (var req) - "Look CGI variable in AllegroServe association list" - (cdr (assoc var (net.aserve:request-query req) :test #'equal))) - -(defun princ-http (s) - (princ s *html-stream*)) - -(defun print-http (s) - (format *html-stream* "~a~%" s)) - - -;;; Tag functions - -(defmacro with-tag (tag &rest body) - "Outputs to http tag and executes body" - `(prog1 - (progn - (princ-http (format nil "<~a>" ,tag)) - ,@body) - (princ-http (format nil "" ,tag)))) - -(defmacro with-tag-attribute (tag attribute &rest body) - "Outputs to http tag + attribute and executes body" - `(prog1 - (progn - (princ-http (format nil "<~a ~a>" ,tag ,attribute)) - ,@body) - (princ-http (format nil "" ,tag)))) - -(defun princ-http-with-color (text color) - (with-tag-attribute "font" (format nil "color=\"~a\"" color) - (princ-http text))) - -(defun princ-http-with-size (text size) - (with-tag-attribute "font" (format nil "size=\"~a\"" size) - (princ-http text))) - -(defmacro with-link ((href &key (format :html)) &rest body) -; (format *html-stream* "Return to Home") -; (format *html-stream* "Return to Home") - `(case ,format - (:xml - (princ-http "") - ,@body - (princ-http "")) - (:ie-xml - (princ-http "") - ,@body - (princ-http "")) - (:html - (princ-http "") - ,@body - (princ-http "")))) - -(defun home-link (&key (format :html) (vars nil)) - (case format - (:html - (princ-http "
Return to ") - (with-link ((make-url "index.html" :vars vars)) - (princ-http "Home")) - (princ-http "
")) - ((:xml :ie-xml) - (princ-http "Return to ") - (with-link ((make-url "index.html" :vars vars :format format) :format format) - (princ-http "Home")) - (princ-http "")))) - -(defun head (title-str &key css) - (unless css - (setq css "http://b9.com/main.css")) - (net.html.generator:html - (:head - (princ-http (format nil "" css)) - (:title (:princ-safe title-str))))) - - - -;;; Page wrappers - -(defmacro with-page ((title &key css (format :xhtml)) &rest body) - (case format - (:xhtml - `(prog1 - (progn - (net.html.generator:html - (print-http *standard-xhtml-header*) - (print-http "") - (head ,title :css ,css) - (print-http "") - (prog1 - ,@body - (print-http "")))))) - (:html - `(prog1 - (progn - (net.html.generator:html - (print-http *standard-html-header*) - (head ,title :css ,css) - (print-http "") - (prog1 - ,@body - (print-http "")))))) - (:xml - `(prog1 - (progn - (net.html.generator:html - (princ-http *standard-xml-header*) - (princ-http "")) - (with-tag "pagetitle" (princ-http ,title)) - ,@body) - (princ-http ""))))) - - -;;; URL Encoding - -(defun encode-query (query) - "Escape [] from net.aserve's query-to-form-urlencoded" - (substitute-string-for-char - (substitute-string-for-char - (substitute-string-for-char - (substitute #\+ #\space query) - #\[ "%5B") - #\] "%5D") - #\" "%22")) - - diff --git a/xml-utils.lisp b/xml-utils.lisp index 2b06f9c..756d339 100644 --- a/xml-utils.lisp +++ b/xml-utils.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: xml-utils.lisp,v 1.4 2002/10/10 16:23:48 kevin Exp $ +;;;; $Id: xml-utils.lisp,v 1.5 2002/11/25 07:45:36 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -28,10 +28,13 @@ ;;; XML Extraction Functions +#| +#+allegro (require :pxml) #+allegro (defun parse-xml-no-ws (str) "Return list structure of XML string with removing whitespace strings" (remove-tree-if #'string-ws? (parse-xml str))) +|# (defun positions-xml-tag-contents (tag xmlstr &optional (start-xmlstr 0) (end-xmlstr nil)) "Returns three values: the start and end positions of contents between -- 2.34.1