From 79ce9975800c5c9e968c5db342add2d01a5cd83b Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Wed, 16 Jul 2003 16:02:21 +0000
Subject: [PATCH] r5315: *** empty log message ***

---
 listener.lisp |  6 +++---
 package.lisp  |  7 ++++++-
 strings.lisp  | 55 ++++++++++++++++++++++++++++++++++++++++++---------
 symbols.lisp  | 21 ++++++++++++++------
 tests.lisp    |  8 +++++++-
 5 files changed, 77 insertions(+), 20 deletions(-)

diff --git a/listener.lisp b/listener.lisp
index a757cc1..36d7fd3 100644
--- a/listener.lisp
+++ b/listener.lisp
@@ -7,7 +7,7 @@
 ;;;; 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)
@@ -125,10 +125,10 @@
 ;; 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)
-  (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
diff --git a/package.lisp b/package.lisp
index d11e68f..89f583a 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; 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
 ;;;;
@@ -60,6 +60,7 @@
    #:last-char
    #:ensure-string
    #:string-right-trim-one-char
+   #:string-strip-ending
    
    #:flatten
 
@@ -215,6 +216,10 @@
    #:init/listener
    #:stop-all/listener
    #:listener
+   
+   ;; fformat.lisp
+   #:fformat
+   
    ))
 
 
diff --git a/strings.lisp b/strings.lisp
index cadd1ac..19389e1 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -7,7 +7,7 @@
 ;;;; 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
 ;;;;
@@ -403,9 +403,11 @@ for characters in a string"
   (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))
-(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"
@@ -462,16 +464,39 @@ for characters in a string"
 	(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)))
-  (let ((s (make-string len)))
+  (let ((s (make-string length)))
     (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)
@@ -503,3 +528,15 @@ for characters in a string"
       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 7ec505f..5a8a348 100644
--- a/symbols.lisp
+++ b/symbols.lisp
@@ -7,7 +7,7 @@
 ;;;; 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
 ;;;;
@@ -45,6 +45,18 @@
 
 ;;; 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)
@@ -54,8 +66,7 @@
              (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*)))))
 
 
@@ -66,9 +77,7 @@
   "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*))
diff --git a/tests.lisp b/tests.lisp
index 2c944aa..c917615 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -7,7 +7,7 @@
 ;;;; 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
 ;;;;
@@ -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 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)
-- 
2.34.1