r5315: *** empty log message ***

diff --git a/listener.lisp b/listener.lisp
index a757cc1d73541402f8e24e7c37f152e019df3c50..36d7fd3e94b018fc3af53d21137ee9604502c2d4 100644 (file)
--- a/listener.lisp
+++ b/listener.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jun 2003
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jun 2003
 ;;;;

-;;;; $Id: listener.lisp,v 1.6 2003/07/13 04:53:32 kevin Exp $
+;;;; $Id: listener.lisp,v 1.7 2003/07/16 16:01:37 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)


@@ -125,10 +125,10 @@
 ;; Low-level functions
 
 (defun next-server-name (base-name)
 ;; Low-level functions
 
 (defun next-server-name (base-name)

-  (format nil "~A-socket-server-~D" base-name (incf *listener-count*))) 
+  (format nil "~D-~A-socket-server" (incf *listener-count*) base-name)) 

 
 (defun next-worker-name (base-name)
 
 (defun next-worker-name (base-name)

-  (format nil "~A-worker-~D" base-name (incf *worker-count*)))
+  (format nil "~D-~A-worker"  (incf *worker-count*) base-name))

 
 (defun make-socket-server (listener)
   #+lispworks
 
 (defun make-socket-server (listener)
   #+lispworks

diff --git a/package.lisp b/package.lisp
index d11e68fb91e8ddba4c257bbf5bd477324e242d8b..89f583ac93c5d991e4ce7f6fac246710a9ad8f9d 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;

-;;;; $Id: package.lisp,v 1.50 2003/07/14 04:10:02 kevin Exp $
+;;;; $Id: package.lisp,v 1.51 2003/07/16 16:01:37 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
 ;;;;


@@ -60,6 +60,7 @@
    #:last-char
    #:ensure-string
    #:string-right-trim-one-char
    #:last-char
    #:ensure-string
    #:string-right-trim-one-char

+   #:string-strip-ending

    
    #:flatten
 
    
    #:flatten
 


@@ -215,6 +216,10 @@
    #:init/listener
    #:stop-all/listener
    #:listener
    #:init/listener
    #:stop-all/listener
    #:listener

+   
+   ;; fformat.lisp
+   #:fformat
+   

    ))
 
 
    ))
 
 

diff --git a/strings.lisp b/strings.lisp
index cadd1acc29c6891b8a36e269201b0957f947322d..19389e1809564f7d6961f8beb20451ba8acf273d 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -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.47 2003/07/09 19:19:19 kevin Exp $
+;;;; $Id: strings.lisp,v 1.48 2003/07/16 16:01:37 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
 ;;;;


@@ -403,9 +403,11 @@ for characters in a string"
   (declare (type (integer 0 15) n))
   (schar +hex-chars+ n))
 
   (declare (type (integer 0 15) n))
   (schar +hex-chars+ n))
 

-(defconstant +char-code-0+ (char-code #\0))
+(defconstant +char-code-lower-a+ (char-code #\a))

 (defconstant +char-code-upper-a+ (char-code #\A))
 (defconstant +char-code-upper-a+ (char-code #\A))

-(declaim (type fixnum +char-code-0+ +char-code-upper-a+))
+(defconstant +char-code-0+ (char-code #\0))
+(declaim (type fixnum +char-code-0+ +char-code-upper-a+
+              +char-code-0))

 
 (defun charhex (ch)
   "convert hex character to decimal"
 
 (defun charhex (ch)
   "convert hex character to decimal"


@@ -462,16 +464,39 @@ for characters in a string"
        (setf (schar str dpos) ch)))))
 
 
        (setf (schar str dpos) ch)))))
 
 

-(defconstant +char-code-a+ (char-code #\a))

 
 

-(defun random-string (&optional (len 10))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar +unambigous-charset+
+    "abcdefghjkmnpqrstuvwxyz123456789ABCDEFGHJKLMNPQSRTUVWXYZ")
+  (defconstant +unambigous-length+ (length +unambigous-charset+)))
+
+(defun random-char (&optional (set :lower-alpha))
+  (ecase set
+    (:lower-alpha
+     (code-char (+ +char-code-lower-a+ (random 26))))
+    (:lower-alphanumeric
+     (let ((n (random 36)))
+       (if (>= n 26)
+          (code-char (+ +char-code-0+ (- n 26)))
+        (code-char (+ +char-code-lower-a+ n)))))
+    (:upper-alpha
+     (code-char (+ +char-code-upper-a+ (random 26))))
+    (:unambigous
+     (schar +unambigous-charset+ (random +unambigous-length+)))
+    (:upper-lower-alpha
+     (let ((n (random 52)))
+       (if (>= n 26)
+          (code-char (+ +char-code-upper-a+ (- n 26)))
+        (code-char (+ +char-code-lower-a+ n)))))))
+     
+
+(defun random-string (&key (length 10) (set :lower-alpha))

   "Returns a random lower-case string."
   (declare (optimize (speed 3)))
   "Returns a random lower-case string."
   (declare (optimize (speed 3)))

-  (let ((s (make-string len)))
+  (let ((s (make-string length)))

     (declare (simple-string s))
     (declare (simple-string s))

-    (dotimes (i len s)
-      (setf (schar s i)
-           (code-char (+ +char-code-a+ (random 26)))))))
+    (dotimes (i length s)
+      (setf (schar s i) (random-char set)))))

 
 
 (defun first-char (s)
 
 
 (defun first-char (s)


@@ -503,3 +528,15 @@ for characters in a string"
       str)))
 
 
       str)))
 
 

+(defun string-strip-ending (str endings)
+  (if (stringp endings)
+      (setq endings (list endings)))
+  (let ((len (length str)))
+    (dolist (ending endings str)
+      (when (and (>= len (length ending))
+                (string-equal ending
+                              (subseq str (- len
+                                             (length ending)))))
+       (return-from string-strip-ending
+         (subseq str 0 (- len (length ending))))))))
+       

diff --git a/symbols.lisp b/symbols.lisp
index 7ec505f699e90d5df674d5543dc8ea222238ffea..5a8a3485cfb9f6582301bf44bd286a2fe03bf481 100644 (file)
--- a/symbols.lisp
+++ b/symbols.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;

-;;;; $Id: symbols.lisp,v 1.2 2003/06/06 21:59:30 kevin Exp $
+;;;; $Id: symbols.lisp,v 1.3 2003/07/16 16:01:37 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
 ;;;;


@@ -45,6 +45,18 @@
 
 ;;; Symbol functions
 
 
 ;;; Symbol functions
 

+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (char= #\a (symbol-name '#:a))
+    (pushnew :lowercase-reader *features*)))
+
+(defun string-default-case (str)
+   #+(and (not case-sensitive) (not lowercase-reader))
+   (string-upcase str)
+   #+(and (not case-sensitive) lowercase-reader)
+   (string-downcase str)
+   #+case-sensitive
+   str)
+

 (defun concat-symbol-pkg (pkg &rest args)
   (declare (dynamic-extent args))
   (flet ((stringify (arg)
 (defun concat-symbol-pkg (pkg &rest args)
   (declare (dynamic-extent args))
   (flet ((stringify (arg)


@@ -54,8 +66,7 @@
              (symbol
               (symbol-name arg)))))
     (let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
              (symbol
               (symbol-name arg)))))
     (let ((str (apply #'concatenate 'string (mapcar #'stringify args))))

-      (intern #-case-sensitive (string-upcase str)
-             #+case-sensitive str
+      (intern (string-default-case str)

              (if pkg pkg *package*)))))
 
 
              (if pkg pkg *package*)))))
 
 


@@ -66,9 +77,7 @@
   "Returns keyword for a name"
   (etypecase name
     (keyword name)
   "Returns keyword for a name"
   (etypecase name
     (keyword name)

-    (string (intern #-case-sensitive (string-upcase name)
-                   #+case-sensitive name
-                   :keyword))
+    (string (intern (string-default-case name) :keyword))

     (symbol (intern (symbol-name name) :keyword))))
 
 (defun show (&optional (what :variables) (package *package*))
     (symbol (intern (symbol-name name) :keyword))))
 
 (defun show (&optional (what :variables) (package *package*))

diff --git a/tests.lisp b/tests.lisp
index 2c944aa508f3048bebf26a7eca4cc03be3a52c75..c917615b40b0030ea1bfa72a42c9f95998136dee 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -7,7 +7,7 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;

-;;;; $Id: tests.lisp,v 1.21 2003/07/01 22:16:40 kevin Exp $
+;;;; $Id: tests.lisp,v 1.22 2003/07/16 16:01:37 kevin Exp $

 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;


@@ -178,6 +178,12 @@
 (deftest duqs.4 (decode-uri-query-string "abc+d") "abc d")
 (deftest duqs.5 (decode-uri-query-string "abc%20d") "abc d")
 
 (deftest duqs.4 (decode-uri-query-string "abc+d") "abc d")
 (deftest duqs.5 (decode-uri-query-string "abc%20d") "abc d")
 

+(deftest sse.1 (string-strip-ending "" nil) "")
+(deftest sse.2 (string-strip-ending "abc" nil) "abc")
+(deftest sse.3 (string-strip-ending "abc" "ab") "abc")
+(deftest sse.4 (string-strip-ending "abc" '("ab")) "abc")
+(deftest sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
+

 ;;; MOP Testing
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 ;;; MOP Testing
 
 (eval-when (:compile-toplevel :load-toplevel :execute)