;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: attrib-class.lisp,v 1.13 2003/04/29 09:23:56 kevin Exp $
+;;;; $Id: attrib-class.lisp,v 1.14 2003/06/12 02:38:39 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
slot-name instance attribute))
attr-bucket)))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(attributes-class slot-attributes)))
+
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: kmrcl.asd,v 1.30 2003/06/06 21:59:29 kevin Exp $
+;;;; $Id: kmrcl.asd,v 1.31 2003/06/12 02:38:39 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
#+kmr-mop (:file "mop" :depends-on ("macros"))
#+kmr-mop (:file "attrib-class" :depends-on ("seqs" "mop"))
(:file "equal" :depends-on ("macros" #+kmr-mop "mop"))
- (:file "web-utils" :depends-on ("macros"))
+ (:file "web-utils" :depends-on ("macros" "strings"))
(:file "xml-utils" :depends-on ("macros")))
)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: package.lisp,v 1.35 2003/06/07 05:45:14 kevin Exp $
+;;;; $Id: package.lisp,v 1.36 2003/06/12 02:38:39 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
#:integer-string
#:fast-string-search
#:string-to-list-skip-delimiter
+ #:string-starts-with
#:flatten
;; From attrib-class.lisp
#:attributes-class
#:slot-attribute
+ #:slot-attributes
+
#:generalized-equal
-
+
;; From buffered input
#:make-fields-buffer
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: strings.lisp,v 1.36 2003/06/07 05:45:14 kevin Exp $
+;;;; $Id: strings.lisp,v 1.37 2003/06/12 02:38:39 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(null (find-if #'not-whitespace? str))))
(defun replaced-string-length (str repl-alist)
- (declare (string str))
+ (declare (simple-string str))
(let* ((orig-len (length str))
(new-len orig-len))
(declare (fixnum orig-len new-len))
(if match
(let* ((subst (cdr match))
(len (length subst)))
- (declare (fixnum len))
+ (declare (fixnum len)
+ (simple-string subst))
(dotimes (j len)
(declare (fixnum j))
(setf (char new-string dpos) (char subst j))
(substitute-chars-strings string '((#\& . "&") (#\< . "<"))))
(defun make-usb8-array (len)
- (make-array len :adjustable nil
- :fill-pointer nil
- :element-type '(unsigned-byte 8)))
+ (make-array len :element-type '(unsigned-byte 8)))
(defun usb8-array-to-string (vec)
+ (declare (type (simple-array (unsigned-byte 8) (*)) vec))
(let* ((len (length vec))
(str (make-string len)))
(declare (fixnum len)
(simple-string str)
(optimize (speed 3)))
- (dotimes (i len)
+ (do ((i 0 (1+ i)))
+ ((= i len) str)
(declare (fixnum i))
- (setf (schar str i) (code-char (aref vec i))))
- str))
+ (setf (schar str i) (code-char (aref vec i))))))
(defun string-to-usb8-array (str)
+ (declare (simple-string str))
(let* ((len (length str))
(vec (make-usb8-array len)))
(declare (fixnum len)
- (type (array fixnum (*)) vec)
+ (type (simple-array (unsigned-byte 8) (*)) vec)
(optimize (speed 3)))
- (dotimes (i len)
+ (do ((i 0 (1+ i)))
+ ((= i len) vec)
(declare (fixnum i))
- (setf (aref vec i) (char-code (schar str i))))
- vec))
+ (setf (aref vec i) (char-code (schar str i))))))
(defun concat-separated-strings (separator &rest lists)
(format nil (concatenate 'string "~{~A~^" (string separator) "~}")
(nreverse results))
(declare (fixnum i j end))
(push (subseq str i j) results)))
+
+(defun string-starts-with (start str)
+ (and (>= (length str) (length start))
+ (string-equal start str :end2 (length start))))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: web-utils.lisp,v 1.10 2003/06/06 21:59:30 kevin Exp $
+;;;; $Id: web-utils.lisp,v 1.11 2003/06/12 02:38:39 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;; HTML/XML constants
(defvar *standard-xml-header*
- #.(format nil "<?xml version=\"1.0\" ?>~%<?xml-stylesheet type=\"text/css\" href=\"http://b9.com/umlsxml.css\" ?>~%~%"))
+ #.(format nil "<?xml version=\"1.0\" encoding=\"iso-8859-1\" standalone=\"yes\"?>~%<?xml-stylesheet type=\"text/css\" href=\"http://b9.com/umlsxml.css\" ?>~%~%"))
(defvar *standard-html-header* "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">")
(defvar *standard-xhtml-header*
- #.(format nil "<?xml version=\"1.0\" standalone=\"yes\"?>~%<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3c.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))
+ #.(format nil "<?xml version=\"1.0\" encoding=\"iso-8859-1\" standalone=\"yes\"?>~%<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3c.org/TR/xhtml11/DTD/xhtml11\">"))
;;; User agent functions
(defun user-agent-ie-p (agent)
"Takes a user-agent string and returns T for Internet Explorer."
- (when (or (string-equal "Microsoft" (subseq agent 0 (length "Microsoft")))
- (string-equal "Internet Explore" (subseq agent 0 (length "Internet Explore")))
- (search "MSIE" agent))
- t))
+ (or (string-starts-with "Microsoft" agent)
+ (string-starts-with "Internet Explore" agent)
+ (search "MSIE" agent)))
;;; URL Functions