Commit a3f78ebd authored by Raymond Toy's avatar Raymond Toy
Browse files

Import many unicode symbols from LISP into the UNICODE package.

 src/code/exports.lisp::
 * Import symbols

 src/code/unicode.lisp::
 * Remove LISP package prefix from all unicode-related symbols.
parent 49f041ad
...@@ -2447,6 +2447,20 @@ ...@@ -2447,6 +2447,20 @@
(:shadow "STRING-CAPITALIZE" (:shadow "STRING-CAPITALIZE"
"STRING-DOWNCASE" "STRING-DOWNCASE"
"STRING-UPCASE") "STRING-UPCASE")
(:import-from "LISP"
"CODEPOINT"
"SURROGATES"
"UNICODE-FULL-CASE-LOWER"
"UNICODE-FULL-CASE-UPPER"
"UNICODE-FULL-CASE-TITLE"
"UNICODE-CATEGORY"
"+UNICODE-CATEGORY-LOWER+"
"+UNICODE-CATEGORY-OTHER+"
"+UNICODE-CATEGORY-GRAPHIC+"
"+UNICODE-CATEGORY-UPPER+"
"+UNICODE-CATEGORY-TITLE+"
"UNICODE-UPPER"
"UNICODE-WORD-BREAK")
(:export "STRING-CAPITALIZE" (:export "STRING-CAPITALIZE"
"STRING-DOWNCASE" "STRING-DOWNCASE"
"STRING-UPCASE" "STRING-UPCASE"
......
...@@ -36,14 +36,14 @@ ...@@ -36,14 +36,14 @@
((= index (the fixnum end))) ((= index (the fixnum end)))
(declare (fixnum index)) (declare (fixnum index))
(multiple-value-bind (code wide) (multiple-value-bind (code wide)
(lisp:codepoint string index) (codepoint string index)
(when wide (incf index)) (when wide (incf index))
;; Handle ASCII specially because this is called early in ;; Handle ASCII specially because this is called early in
;; initialization, before unidata is available. ;; initialization, before unidata is available.
(cond ((< 96 code 123) (cond ((< 96 code 123)
(write-char (code-char (decf code 32)) s)) (write-char (code-char (decf code 32)) s))
((> code 127) ((> code 127)
(write-string (lisp:unicode-full-case-upper code) s)) (write-string (unicode-full-case-upper code) s))
(t (t
(multiple-value-bind (hi lo) (multiple-value-bind (hi lo)
(surrogates code) (surrogates code)
...@@ -82,14 +82,14 @@ ...@@ -82,14 +82,14 @@
((= index (the fixnum end))) ((= index (the fixnum end)))
(declare (fixnum index)) (declare (fixnum index))
(multiple-value-bind (code wide) (multiple-value-bind (code wide)
(lisp:codepoint string index) (codepoint string index)
(when wide (incf index)) (when wide (incf index))
;; Handle ASCII specially because this is called early in ;; Handle ASCII specially because this is called early in
;; initialization, before unidata is available. ;; initialization, before unidata is available.
(cond ((< 64 code 91) (cond ((< 64 code 91)
(write-char (code-char (incf code 32)) s)) (write-char (code-char (incf code 32)) s))
((> code 127) ((> code 127)
(write-string (lisp:unicode-full-case-lower code) s)) (write-string (unicode-full-case-lower code) s))
(t (t
;; Handle codes below 64 ;; Handle codes below 64
(multiple-value-bind (hi lo) (multiple-value-bind (hi lo)
...@@ -230,7 +230,7 @@ ...@@ -230,7 +230,7 @@
((char-word-break-category (c) ((char-word-break-category (c)
;; Map our unicode word break property into what this ;; Map our unicode word break property into what this
;; algorithm wants. ;; algorithm wants.
(let ((cat (lisp::unicode-word-break c))) (let ((cat (unicode-word-break c)))
(case cat (case cat
((:lf :cr :newline) ((:lf :cr :newline)
:sep) :sep)
...@@ -241,7 +241,7 @@ ...@@ -241,7 +241,7 @@
;; Given a valid index i into s, returns the left context ;; Given a valid index i into s, returns the left context
;; at i. ;; at i.
(multiple-value-bind (c widep) (multiple-value-bind (c widep)
(lisp:codepoint s i n) (codepoint s i n)
(let* ((back (let* ((back
;; If we're at a regular character or a leading ;; If we're at a regular character or a leading
;; surrogate, decrementing by 1 gets us the to ;; surrogate, decrementing by 1 gets us the to
...@@ -279,7 +279,7 @@ ...@@ -279,7 +279,7 @@
(let* ((j1 (- j 1))) (let* ((j1 (- j 1)))
(multiple-value-bind (c widep) (multiple-value-bind (c widep)
(lisp:codepoint s j1) (codepoint s j1)
(when (eql widep -1) (when (eql widep -1)
;; Back up one more if we're at the trailing ;; Back up one more if we're at the trailing
;; surrogate. ;; surrogate.
...@@ -302,7 +302,7 @@ ...@@ -302,7 +302,7 @@
(if (< i j) j n))) (if (< i j) j n)))
(otherwise n)) (otherwise n))
(multiple-value-bind (c widep) (multiple-value-bind (c widep)
(lisp:codepoint s j) (codepoint s j)
(let* ((next-j (let* ((next-j
;; The next character is either 1 or 2 code ;; The next character is either 1 or 2 code
;; units away. For a leading surrogate, it's ;; units away. For a leading surrogate, it's
...@@ -394,7 +394,7 @@ ...@@ -394,7 +394,7 @@
n) n)
(t (t
(multiple-value-bind (c widep) (multiple-value-bind (c widep)
(lisp:codepoint s i) (codepoint s i)
(declare (ignore c)) (declare (ignore c))
(lookup (+ i (if (eql widep 1) 2 1)) (left-context i)))))))) (lookup (+ i (if (eql widep 1) 2 1)) (left-context i))))))))
...@@ -416,15 +416,15 @@ ...@@ -416,15 +416,15 @@
(:simple (:simple
#'(lambda (ch) #'(lambda (ch)
(multiple-value-bind (hi lo) (multiple-value-bind (hi lo)
(lisp::surrogates (lisp::unicode-upper ch)) (surrogates (unicode-upper ch))
(write-char hi result) (write-char hi result)
(when lo (write-char lo result))))) (when lo (write-char lo result)))))
(:full (:full
#'(lambda (ch) #'(lambda (ch)
(write-string (lisp::unicode-full-case-upper ch) result))) (write-string (unicode-full-case-upper ch) result)))
(:title (:title
#'(lambda (ch) #'(lambda (ch)
(write-string (lisp::unicode-full-case-title ch) result)))))) (write-string (unicode-full-case-title ch) result))))))
(do ((start start next) (do ((start start next)
(next (string-next-word-break string start) (next (string-next-word-break string start)
(string-next-word-break string next))) (string-next-word-break string next)))
...@@ -432,7 +432,7 @@ ...@@ -432,7 +432,7 @@
(>= start end))) (>= start end)))
;; Convert the first character of the word to upper ;; Convert the first character of the word to upper
;; case, and then make the rest of the word lowercase. ;; case, and then make the rest of the word lowercase.
(funcall upper (lisp:codepoint string start)) (funcall upper (codepoint string start))
(write-string (string-downcase string :start (1+ start) (write-string (string-downcase string :start (1+ start)
:end next :end next
:casing casing) :casing casing)
...@@ -459,29 +459,29 @@ ...@@ -459,29 +459,29 @@
(or (< 47 m 58) (< 64 m 91) (< 96 m 123) (or (< 47 m 58) (< 64 m 91) (< 96 m 123)
#+(and unicode (not unicode-bootstrap)) #+(and unicode (not unicode-bootstrap))
(and (> m 127) (and (> m 127)
(<= lisp::+unicode-category-letter+ (<= +unicode-category-letter+
(lisp::unicode-category m) (unicode-category m)
(+ lisp::+unicode-category-letter+ #x0F))))) (+ +unicode-category-letter+ #x0F)))))
(upper (ch) (upper (ch)
(ecase casing (ecase casing
(:simple (:simple
#'(lambda (ch) #'(lambda (ch)
(multiple-value-bind (hi lo) (multiple-value-bind (hi lo)
(lisp::surrogates (lisp::unicode-upper ch)) (surrogates (unicode-upper ch))
(write-char hi s) (write-char hi s)
(when lo (write-char lo s))))) (when lo (write-char lo s)))))
(:full (:full
#'(lambda (ch) #'(lambda (ch)
(write-string (lisp::unicode-full-case-upper ch) s))) (write-string (unicode-full-case-upper ch) s)))
(:title (:title
#'(lambda (ch) #'(lambda (ch)
(write-string (lisp::unicode-full-case-title ch) s)))))) (write-string (unicode-full-case-title ch) s))))))
(do ((index start (1+ index)) (do ((index start (1+ index))
(newword t)) (newword t))
((= index (the fixnum end))) ((= index (the fixnum end)))
(declare (fixnum index)) (declare (fixnum index))
(multiple-value-bind (code wide) (multiple-value-bind (code wide)
(lisp:codepoint string index) (codepoint string index)
(when wide (incf index)) (when wide (incf index))
(cond ((not (alphanump code)) (cond ((not (alphanump code))
(multiple-value-bind (hi lo) (multiple-value-bind (hi lo)
...@@ -495,7 +495,7 @@ ...@@ -495,7 +495,7 @@
(setq newword ())) (setq newword ()))
(t (t
;; char is case-modifiable, but not first ;; char is case-modifiable, but not first
(write-string (lisp:unicode-full-case-lower code) s)))))) (write-string (unicode-full-case-lower code) s))))))
(write-string string s :start end :end offset-slen)))))) (write-string string s :start end :end offset-slen))))))
(defun string-capitalize (string &key (start 0) end (defun string-capitalize (string &key (start 0) end
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment