+cl-kmrcl (1.21-1) unstable; urgency=low
+
+ * Remore allegroserve dependant modules
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Sun, 24 Nov 2002 13:13:05 -0700
+
cl-kmrcl (1.20.2-1) unstable; urgency=low
* Remove 'load-compiled-op from .asd file
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
;;;; 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
;;;;
(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)
;;;; 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
;;;;
;;;; (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
((: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"))
(: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")))
)
;;;; 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
;;;;
(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
#: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
))
+++ /dev/null
-;;;; -*- 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 "</~a>" ,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 "</~a>" ,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 <cui2 xml:href=\"qstr\">Home</cui2>")
-; (format *html-stream* "Return to <go xml:link=\"simple\" show=\"replace\" href=\"qstr/\">Home</go>")
- `(case ,format
- (:xml
- (princ-http "<xmllink xlink:type=\"simple\" xlink:href=\"")
- (princ-http ,href)
- (princ-http "\">")
- ,@body
- (princ-http "</xmllink>"))
- (:ie-xml
- (princ-http "<html:a href=\"")
- (princ-http ,href)
- (princ-http "\">")
- ,@body
- (princ-http "</html:a>"))
- (:html
- (princ-http "<a href=\"")
- (princ-http ,href)
- (princ-http "\">")
- ,@body
- (princ-http "</a>"))))
-
-(defun home-link (&key (format :html) (vars nil))
- (case format
- (:html
- (princ-http "<div class=\"homelink\">Return to ")
- (with-link ((make-url "index.html" :vars vars))
- (princ-http "Home"))
- (princ-http "</div>"))
- ((:xml :ie-xml)
- (princ-http "<homelink>Return to ")
- (with-link ((make-url "index.html" :vars vars :format format) :format format)
- (princ-http "Home"))
- (princ-http "</homelink>"))))
-
-(defun head (title-str &key css)
- (unless css
- (setq css "http://b9.com/main.css"))
- (net.html.generator:html
- (:head
- (princ-http (format nil "<link rel=\"stylesheet\" href=\"~A\" type=\"text/css\"></link>" 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 "<html xmlns=\"http://www.w3.org/1999/xhtml\">")
- (head ,title :css ,css)
- (print-http "<body>")
- (prog1
- ,@body
- (print-http "</body></html>"))))))
- (:html
- `(prog1
- (progn
- (net.html.generator:html
- (print-http *standard-html-header*)
- (head ,title :css ,css)
- (print-http "<body>")
- (prog1
- ,@body
- (print-http "</body></html>"))))))
- (:xml
- `(prog1
- (progn
- (net.html.generator:html
- (princ-http *standard-xml-header*)
- (princ-http "<pagedata xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:html=\"http://www.w3.org/TR/REC-html40\">"))
- (with-tag "pagetitle" (princ-http ,title))
- ,@body)
- (princ-http "</pagedata>")))))
-
-
-;;; 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"))
-
-
;;;; 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
;;;;
;;; 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
projects / kmrcl.git / commitdiff