From a287b1a6782d53c22fc1807e44aae62fb7094bc5 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 12 Jun 2003 02:38:53 +0000 Subject: [PATCH] r5094: *** empty log message *** --- attrib-class.lisp | 5 ++--- kmrcl.asd | 4 ++-- package.lisp | 7 +++++-- strings.lisp | 31 ++++++++++++++++++------------- web-utils.lisp | 13 ++++++------- 5 files changed, 33 insertions(+), 27 deletions(-) diff --git a/attrib-class.lisp b/attrib-class.lisp index 505a8a4..04f8840 100644 --- a/attrib-class.lisp +++ b/attrib-class.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -101,6 +101,5 @@ on example from AMOP")) slot-name instance attribute)) attr-bucket))) -(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(attributes-class slot-attributes))) + diff --git a/kmrcl.asd b/kmrcl.asd index b866b39..19fe091 100644 --- a/kmrcl.asd +++ b/kmrcl.asd @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -48,7 +48,7 @@ #+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"))) ) diff --git a/package.lisp b/package.lisp index 79306a8..a4011d7 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -47,6 +47,7 @@ #:integer-string #:fast-string-search #:string-to-list-skip-delimiter + #:string-starts-with #:flatten @@ -124,8 +125,10 @@ ;; From attrib-class.lisp #:attributes-class #:slot-attribute + #:slot-attributes + #:generalized-equal - + ;; From buffered input #:make-fields-buffer diff --git a/strings.lisp b/strings.lisp index a070731..5343f31 100644 --- a/strings.lisp +++ b/strings.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -168,7 +168,7 @@ (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)) @@ -198,7 +198,8 @@ list of characters and replacement strings." (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)) @@ -212,31 +213,31 @@ list of characters and replacement strings." (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) "~}") @@ -331,3 +332,7 @@ Leading zeros are present." (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)))) diff --git a/web-utils.lisp b/web-utils.lisp index 1614fe4..1c475a8 100644 --- a/web-utils.lisp +++ b/web-utils.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -22,22 +22,21 @@ ;;; HTML/XML constants (defvar *standard-xml-header* - #.(format nil "~%~%~%")) + #.(format nil "~%~%~%")) (defvar *standard-html-header* "") (defvar *standard-xhtml-header* - #.(format nil "~%")) + #.(format nil "~%")) ;;; 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 -- 2.34.1