r5036: *** empty log message ***

[kmrcl.git] / strings.lisp

diff --git a/strings.lisp b/strings.lisp
index b3a3d018a7cb557099df5137a89564329424472f..9d8620e1a426ebf8daa916a616ba30f7e837cc85 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -1,4 +1,4 @@
-<;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-

 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;


@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;

-;;;; $Id: strings.lisp,v 1.29 2003/05/16 08:32:10 kevin Exp $
+;;;; $Id: strings.lisp,v 1.34 2003/05/26 21:43:05 kevin Exp $

 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;


@@ -30,19 +30,19 @@
 
 (defun count-string-words (str)
   (declare (simple-string str)
 
 (defun count-string-words (str)
   (declare (simple-string str)

-          (optimize (speed 3) (safety 0)))
+          (optimize (speed 3) (safety 0) (space 0)))

   (let ((n-words 0)
        (in-word nil))
     (declare (fixnum n-words))
   (let ((n-words 0)
        (in-word nil))
     (declare (fixnum n-words))

-    (dotimes (i (length str))
-      (let ((ch (char str i)))
-       (declare (character ch))
-       (if (alphanumericp ch)
-           (unless in-word
-             (incf n-words)
-             (setq in-word t))
-         (setq in-word nil))))
-    n-words))
+    (do* ((len (length str))
+         (i 0 (1+ i)))
+       ((= i len) n-words)
+      (declare (fixnum i))
+      (if (alphanumericp (schar str i))
+         (unless in-word
+           (incf n-words)
+           (setq in-word t))
+       (setq in-word nil)))))

 
 ;; From Larry Hunter with modifications
 (defun position-char (char string start max)
 
 ;; From Larry Hunter with modifications
 (defun position-char (char string start max)


@@ -201,9 +201,7 @@ list of characters and replacement strings."
 
 (defun escape-xml-string (string)
   "Escape invalid XML characters"
 
 (defun escape-xml-string (string)
   "Escape invalid XML characters"

-  (substitute-chars-strings 
-   string '((#\& . "&amp;") (#\> . "&gt;") (#\< . "&lt;") (#\" . "&quot;"))))
-
+  (substitute-chars-strings string '((#\& . "&amp;") (#\< . "&lt;"))))

 
 (defun make-usb8-array (len)
   (make-array len :adjustable nil
 
 (defun make-usb8-array (len)
   (make-array len :adjustable nil


@@ -280,8 +278,6 @@ Leading zeros are present."
 Leading zeros are present."
   (declare (optimize (speed 3) (safety 0) (space 0))
           (type fixnum len) (type integer num))
 Leading zeros are present."
   (declare (optimize (speed 3) (safety 0) (space 0))
           (type fixnum len) (type integer num))

-  (when pchar
-    (incf len))

   (do* ((zero-code (char-code #\0))
        (result (make-string len :initial-element #\0))
        (minus? (minusp num))
   (do* ((zero-code (char-code #\0))
        (result (make-string len :initial-element #\0))
        (minus? (minusp num))


@@ -289,8 +285,6 @@ Leading zeros are present."
        (pos (1- len) (1- pos))
        (mod (mod val 10) (mod val 10)))
       ((or (zerop val) (minusp pos))
        (pos (1- len) (1- pos))
        (mod (mod val 10) (mod val 10)))
       ((or (zerop val) (minusp pos))

-       (when pchar
-        (setf (schar result 0) pchar))

        (when minus? (setf (schar result (if pchar 1 0)) #\-))
        result)
     (declare (fixnum mod zero-code pos) (simple-string result) (integer val))
        (when minus? (setf (schar result (if pchar 1 0)) #\-))
        result)
     (declare (fixnum mod zero-code pos) (simple-string result) (integer val))