GitLab

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.

 	  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))

 	(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

   (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))

 	       (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

Raymond Toy pushed to branch issue-326-char-casing-cleanup at cmucl / cmucl

Commits:

2 changed files:

Changes: