Support casing characters which map into multiple code points (bug#24603)

Implement unconditional special casing rules defined in Unicode standard.

Among other things, they deal with cases when a single code point is
replaced by multiple ones because single character does not exist (e.g.
‘fi’ ligature turning into ‘FL’) or is not commonly used (e.g. ß turning
into SS).

* admin/unidata/SpecialCasing.txt: New data file pulled from Unicode
standard distribution.
* admin/unidata/README: Mention SpecialCasing.txt.

* admin/unidata/unidata-get.el (unidata-gen-table-special-casing,
unidata-gen-table-special-casing--do-load): New functions generating
‘special-uppercase’, ‘special-lowercase’ and ‘special-titlecase’
character Unicode properties built from the SpecialCasing.txt Unicode
data file.

* src/casefiddle.c (struct casing_str_buf): New structure for
representing short strings used to handle one-to-many character
mappings.

(case_character_imlp): New function which can handle one-to-many
character mappings.
(case_character, case_single_character): Wrappers for the above
functions.  The former may map one character to multiple (or no)
code points while the latter does what the former used to do (i.e.
handles one-to-one mappings only).

(do_casify_natnum, do_casify_unibyte_string,
do_casify_unibyte_region): Use case_single_character.
(do_casify_multibyte_string, do_casify_multibyte_region): Support new
features of case_character.
* (do_casify_region): Updated to reflact do_casify_multibyte_string
changes.

(casify_word): Handle situation when one character-length of a word
can change affecting where end of the word is.

(upcase, capitalize, upcase-initials): Update documentation to mention
limitations when working on characters.

* test/src/casefiddle-tests.el (casefiddle-tests-char-properties):
Add test cases for the newly introduced character properties.
(casefiddle-tests-casing): Update test cases which are now passing.

* test/lisp/char-fold-tests.el (char-fold--ascii-upcase,
char-fold--ascii-downcase): New functions which behave like old ‘upcase’
and ‘downcase’.
(char-fold--test-match-exactly): Use the new functions.  This is needed
because otherwise fi and similar characters are turned into their multi-
-character representation.

* doc/lispref/strings.texi: Describe issue with casing characters versus
strings.
* doc/lispref/nonascii.texi: Describe the new character properties.

1 files changed, 81 insertions, 0 deletions

diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 3c5119a8a3d..9ebcbe0705a 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -268,6 +268,42 @@ Property value is a character or nil.
 The value nil means that the actual property value of a character
 is the character itself."
      string)
+    (special-uppercase
+     2 unidata-gen-table-special-casing "uni-special-uppercase.el"
+     "Unicode unconditional special casing mapping.
+
+Property value is (possibly empty) string or nil.  The value nil denotes that
+`uppercase' property should be consulted instead.  A string denotes what
+sequence of characters given character maps into.
+
+This mapping includes language- and context-independent special casing rules
+defined by Unicode only.  It also does not include association which would
+duplicate information from `uppercase' property."
+     nil)
+    (special-lowercase
+     0 unidata-gen-table-special-casing "uni-special-lowercase.el"
+     "Unicode unconditional special casing mapping.
+
+Property value is (possibly empty) string or nil.  The value nil denotes that
+`lowercase' property should be consulted instead.  A string denotes what
+sequence of characters given character maps into.
+
+This mapping includes language- and context-independent special casing rules
+defined by Unicode only.  It also does not include association which would
+duplicate information from `lowercase' property."
+     nil)
+    (special-titlecase
+     1 unidata-gen-table-special-casing "uni-special-titlecase.el"
+     "Unicode unconditional special casing mapping.
+
+Property value is (possibly empty) string or nil.  The value nil denotes that
+`titlecase' property should be consulted instead.  A string denotes what
+sequence of characters given character maps into.
+
+This mapping includes language- and context-independent special casing rules
+defined by Unicode only.  It also does not include association which would
+duplicate information from `titlecase' property."
+     nil)
     (mirroring
      unidata-gen-mirroring-list unidata-gen-table-character "uni-mirrored.el"
      "Unicode bidi-mirroring characters.
@@ -1084,6 +1120,51 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
 
 
 
+
+(defvar unidata-gen-table-special-casing--cache nil
+  "Cached value for `unidata-gen-table-special-casing' function.")
+
+(defun unidata-gen-table-special-casing--do-load ()
+  (let (result)
+    (with-temp-buffer
+      (insert-file-contents (expand-file-name "SpecialCasing.txt" unidata-dir))
+      (goto-char (point-min))
+      (while (not (eobp))
+        ;; Ignore empty lines and comments.
+        (unless (or (eq (char-after) ?\n) (eq (char-after) ?#))
+          (let ((line (split-string
+                       (buffer-substring (point) (progn (end-of-line) (point)))
+                       ";" "")))
+            ;; Ignore entries with conditions, i.e. those with six values.
+            (when (= (length line) 5)
+              (let ((ch (string-to-number (pop line) 16)))
+                (setcdr (cddr line) nil) ; strip comment
+                (push
+                 (cons ch
+                       (mapcar (lambda (entry)
+                                 (mapcar (lambda (n) (string-to-number n 16))
+                                         (split-string entry)))
+                               line))
+                 result)))))
+        (forward-line)))
+    result))
+
+(defun unidata-gen-table-special-casing (prop &rest ignore)
+  (let ((table (make-char-table 'char-code-property-table))
+        (prop-idx (unidata-prop-index prop)))
+    (set-char-table-extra-slot table 0 prop)
+    (mapc (lambda (entry)
+            (let ((ch (car entry)) (v (nth prop-idx (cdr entry))))
+              ;; If character maps to a single character, the mapping is already
+              ;; covered by regular casing property.  Don’t store those.
+              (when (/= (length v) 1)
+                (set-char-table-range table ch (apply 'string v)))))
+          (or unidata-gen-table-special-casing--cache
+              (setq unidata-gen-table-special-casing--cache
+                    (unidata-gen-table-special-casing--do-load))))
+    table))
+
+
 (defun unidata-describe-general-category (val)
   (cdr (assq val
 	     '((nil . "Uknown")