Raymond Toy pushed to branch issue-326-char-casing-cleanup at cmucl / cmucl Commits: ad7b90b0 by Raymond Toy at 2024-06-03T16:16:56-07:00 Move char-titlecase and title-case-p to unicode.lisp These aren't needed for CL casing functions, so just move them as is to unicode.lisp, where they are used. - - - - - 2 changed files: - src/code/char.lisp - src/code/unicode.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -31,7 +31,6 @@ alphanumericp char= char/= char< char> char<= char>= char-equal char-not-equal char-lessp char-greaterp char-not-greaterp char-not-lessp character char-code code-char char-upcase - char-titlecase title-case-p char-downcase digit-char char-int char-name name-char codepoint-limit codepoint)) @@ -298,17 +297,6 @@ (and (> m +ascii-limit+) (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m)))))))) -(defun title-case-p (char) - "The argument must be a character object; title-case-p returns T if the - argument is a title-case character, NIL otherwise." - (declare (character char)) - (let ((m (char-code char))) - (or (< 64 m 91) - #+(and unicode (not unicode-bootstrap)) - (and (> m +ascii-limit+) - (= (unicode-category m) +unicode-category-title+))))) - - (defun both-case-p (char) "The argument must be a character object. Both-case-p returns T if the argument is an alphabetic character and if the character exists in @@ -504,20 +492,6 @@ (declare (character char)) (char-upcase char)) -(defun char-titlecase (char) - "Returns CHAR converted to title-case if that is possible." - (declare (character char)) - #-(and unicode (not unicode-bootstrap)) - (if (lower-case-p char) - (code-char (- (char-code char) 32)) - char) - #+(and unicode (not unicode-bootstrap)) - (let ((m (char-code char))) - (cond ((> m +ascii-limit+) (code-char (unicode-title m))) - ((< (char-code #\`) m (char-code #\{)) - (code-char (- m 32))) - (t char)))) - (defun char-downcase (char) "Returns CHAR converted to lower-case if that is possible." (declare (character char)) ===================================== src/code/unicode.lisp ===================================== @@ -398,6 +398,30 @@ (declare (ignore c)) (lookup (+ i (if (eql widep 1) 2 1)) (left-context i)))))))) +(defun char-titlecase (char) + "Returns CHAR converted to title-case if that is possible." + (declare (character char)) + #-(and unicode (not unicode-bootstrap)) + (if (lower-case-p char) + (code-char (- (char-code char) 32)) + char) + #+(and unicode (not unicode-bootstrap)) + (let ((m (char-code char))) + (cond ((> m +ascii-limit+) (code-char (unicode-title m))) + ((< (char-code #\`) m (char-code #\{)) + (code-char (- m 32))) + (t char)))) + +(defun title-case-p (char) + "The argument must be a character object; title-case-p returns T if the + argument is a title-case character, NIL otherwise." + (declare (character char)) + (let ((m (char-code char))) + (or (< 64 m 91) + #+(and unicode (not unicode-bootstrap)) + (and (> m +ascii-limit+) + (= (unicode-category m) +unicode-category-title+))))) + (defun string-capitalize-unicode (string &key (start 0) end (casing :simple)) "Capitalize String using the Unicode word-break algorithm to find the words in String. The beginning is capitalized depending on the View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ad7b90b066dd137718e0ce43... -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ad7b90b066dd137718e0ce43... You're receiving this email because of your account on gitlab.common-lisp.net.