Raymond Toy pushed to branch issue-323-cl-string-casing at cmucl / cmucl

Commits: 50395287 by Raymond Toy at 2024-05-31T08:28:43-07:00 Update release notes for newly closed issues

Forgot to add these in the MRs that closed the issues.

- - - - - 5a037b19 by Raymond Toy at 2024-05-31T08:56:12-07:00 String-capitalize should use char-upcase, not lisp:char-titlecase

We were using lisp:;char-titlecase to capitalize the string, but we really should use char-upcase. However, to preserve this functionality, we moved the functions to the `unicode` package.

Added a test for this.

- - - - - e6ef0eac by Raymond Toy at 2024-06-01T18:27:19-07:00 Merge branch 'master' into issue-323-cl-string-casing

- - - - -

3 changed files:

- src/code/string.lisp - src/code/unicode.lisp - src/general-info/release-21f.md

Changes:

===================================== src/code/string.lisp ===================================== @@ -676,6 +676,49 @@ (setf (schar newstring new-index) (schar string index))) newstring))))

+#+nil +(defun string-capitalize (string &key (start 0) end) + _N"Given a string, returns a copy of the string with the first + character of each ``word'' converted to upper-case, and remaining + chars in the word converted to lower case. A ``word'' is defined + to be a string of case-modifiable characters delimited by + non-case-modifiable chars." + (declare (fixnum start)) + (let* ((string (if (stringp string) string (string string))) + (slen (length string))) + (declare (fixnum slen)) + (with-one-string string start end offset + (let ((offset-slen (+ slen offset)) + (newstring (make-string slen))) + (declare (fixnum offset-slen)) + (do ((index offset (1+ index)) + (new-index 0 (1+ new-index))) + ((= index start)) + (declare (fixnum index new-index)) + (setf (schar newstring new-index) (schar string index))) + (do ((index start (1+ index)) + (new-index (- start offset) (1+ new-index)) + (newword t) + (char ())) + ((= index (the fixnum end))) + (declare (fixnum index new-index)) + (setq char (schar string index)) + (cond ((not (alphanumericp char)) + (setq newword t)) + (newword + ;;char is first case-modifiable after non-case-modifiable + (setq char (char-upcase char)) + (setq newword ())) + ;;char is case-modifiable, but not first + (t (setq char (char-downcase char)))) + (setf (schar newstring new-index) char)) + (do ((index end (1+ index)) + (new-index (- (the fixnum end) offset) (1+ new-index))) + ((= index offset-slen)) + (declare (fixnum index new-index)) + (setf (schar newstring new-index) (schar string index))) + newstring)))) + (defun string-capitalize (string &key (start 0) end) _N"Given a string, returns a copy of the string with the first character of each ``word'' converted to upper-case, and remaining @@ -719,7 +762,7 @@ newstring))))

(defun nstring-upcase (string &key (start 0) end) - "Given a string, returns that string with all lower case alphabetic + _N"Given a string, returns that string with all lower case alphabetic characters converted to uppercase." (declare (fixnum start)) (let ((save-header string)) @@ -732,7 +775,7 @@ save-header)))

(defun nstring-downcase (string &key (start 0) end) - "Given a string, returns that string with all upper case alphabetic + _N"Given a string, returns that string with all upper case alphabetic characters converted to lowercase." (declare (fixnum start)) (let ((save-header string)) @@ -744,6 +787,7 @@ (char-downcase (schar string index))))) save-header))

+#+nil (defun nstring-capitalize (string &key (start 0) end) "Given a string, returns that string with the first character of each ``word'' converted to upper-case, and remaining @@ -769,6 +813,31 @@ (setf (schar string index) (char-downcase char)))))) save-header))

+(defun nstring-capitalize (string &key (start 0) end) + _N"Given a string, returns that string with the first + character of each ``word'' converted to upper-case, and remaining + chars in the word converted to lower case. A ``word'' is defined + to be a string of case-modifiable characters delimited by + non-case-modifiable chars." + (declare (fixnum start)) + (let ((save-header string)) + (with-one-string string start end offset + (do ((index start (1+ index)) + (newword t) + (char ())) + ((= index (the fixnum end))) + (declare (fixnum index)) + (setq char (schar string index)) + (cond ((not (alphanumericp char)) + (setq newword t)) + (newword + ;;char is first case-modifiable after non-case-modifiable + (setf (schar string index) (char-upcase char)) + (setq newword ())) + (t + (setf (schar string index) (char-downcase char)))))) + save-header)) +

#+unicode (progn

===================================== src/code/unicode.lisp ===================================== @@ -641,7 +641,7 @@ (if unicode-word-break (string-capitalize-unicode string :start start :end end :casing casing) (if (eq casing :simple) - (cl:string-capitalize-simple string :start start :end end) + (string-capitalize-simple string :start start :end end) (string-capitalize-full string :start start :end end :casing casing))))

===================================== src/general-info/release-21f.md ===================================== @@ -77,6 +77,9 @@ public domain. * ~~#298~~ Add `with-float-rounding-mode` macro * ~~#299~~ Enable xoroshiro assembly routine * ~~#314~~ tanh incorrect for large args + * ~~#316~~ Support roundtrip character casing + * ~~#320~~ Motif variant not defaulted for `x86_linux_clang` config + * ~~#321~~ Rename Motif Config.x86 to Config.linux * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure:

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/163cafa40fb099dc30b7980...