From 91e3d8f38e4ccdfbfb9c351e05b487ee899c9e47 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 19 Jul 2003 20:32:48 +0000 Subject: [PATCH] r5339: *** empty log message *** --- package.lisp | 4 +++- strings.lisp | 23 ++++++++++++++++++++++- symbols.lisp | 4 ++-- 3 files changed, 27 insertions(+), 4 deletions(-) diff --git a/package.lisp b/package.lisp index 89f583a..68cd413 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.51 2003/07/16 16:01:37 kevin Exp $ +;;;; $Id: package.lisp,v 1.52 2003/07/19 20:32:48 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -61,6 +61,8 @@ #:ensure-string #:string-right-trim-one-char #:string-strip-ending + #:string-maybe-shorten + #:shrink-vector #:flatten diff --git a/strings.lisp b/strings.lisp index 19389e1..6ec3f5c 100644 --- a/strings.lisp +++ b/strings.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: strings.lisp,v 1.48 2003/07/16 16:01:37 kevin Exp $ +;;;; $Id: strings.lisp,v 1.49 2003/07/19 20:32:48 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -540,3 +540,24 @@ for characters in a string" (return-from string-strip-ending (subseq str 0 (- len (length ending)))))))) + +(defun string-maybe-shorten (str maxlen) + (let ((len (length str))) + (if (<= len maxlen) + str + (concatenate 'string (subseq str 0 (- maxlen 3)) "...")))) + + +(defun shrink-vector (str size) + #+allegro + (excl::.primcall 'sys::shrink-svector str size) + #+sbcl + (sb-kernel:shrink-vector str size) + #+cmu + (lisp::shrink-vector str size) + #+lispworks + (system::shrink-vector$vector str size) + #+(or allegro cmu sbcl lispworks) + str + #-(or allegro cmu sbcl lispworks) + (subseq str 0 size)) diff --git a/symbols.lisp b/symbols.lisp index 5a8a348..a619327 100644 --- a/symbols.lisp +++ b/symbols.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: symbols.lisp,v 1.3 2003/07/16 16:01:37 kevin Exp $ +;;;; $Id: symbols.lisp,v 1.4 2003/07/19 20:32:48 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -46,7 +46,7 @@ ;;; Symbol functions (eval-when (:compile-toplevel :load-toplevel :execute) - (when (char= #\a (symbol-name '#:a)) + (when (char= #\a (schar (symbol-name '#:a) 0)) (pushnew :lowercase-reader *features*))) (defun string-default-case (str) -- 2.34.1