1228 |
"Return a list of Unicode data for unicode CHAR. |
"Return a list of Unicode data for unicode CHAR. |
1229 |
Each element is a list of a property description and the property value. |
Each element is a list of a property description and the property value. |
1230 |
The list is null if CHAR isn't found in `unicodedata-file'." |
The list is null if CHAR isn't found in `unicodedata-file'." |
1231 |
(if unicodedata-file |
(when unicodedata-file |
1232 |
(save-excursion |
(unless (file-exists-p unicodedata-file) |
1233 |
(set-buffer (find-file-noselect unicodedata-file)) |
(error "`unicodedata-file' %s not found" unicodedata-file)) |
1234 |
(goto-char (point-min)) |
(save-excursion |
1235 |
(let ((hex (format "%04X" char)) |
(set-buffer (find-file-noselect unicodedata-file)) |
1236 |
found first last) |
(goto-char (point-min)) |
1237 |
(if (re-search-forward (concat "^" hex) nil t) |
(let ((hex (format "%04X" char)) |
1238 |
(setq found t) |
found first last) |
1239 |
;; It's not listed explicitly. Look for ranges, e.g. CJK |
(if (re-search-forward (concat "^" hex) nil t) |
1240 |
;; ideographs, and check whether it's in one of them. |
(setq found t) |
1241 |
(while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t) |
;; It's not listed explicitly. Look for ranges, e.g. CJK |
1242 |
(>= char (setq first |
;; ideographs, and check whether it's in one of them. |
1243 |
(string-to-number (match-string 1) 16))) |
(while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t) |
1244 |
(progn |
(>= char (setq first |
1245 |
(forward-line 1) |
(string-to-number (match-string 1) 16))) |
1246 |
(looking-at "^\\([^;]+\\);[^;]+Last>;") |
(progn |
1247 |
(> char |
(forward-line 1) |
1248 |
(setq last |
(looking-at "^\\([^;]+\\);[^;]+Last>;") |
1249 |
(string-to-number (match-string 1) 16)))))) |
(> char |
1250 |
(if (and (>= char first) |
(setq last |
1251 |
(<= char last)) |
(string-to-number (match-string 1) 16)))))) |
1252 |
(setq found t))) |
(if (and (>= char first) |
1253 |
(if found |
(<= char last)) |
1254 |
(let ((fields (mapcar (lambda (elt) |
(setq found t))) |
1255 |
(if (> (length elt) 0) |
(if found |
1256 |
elt)) |
(let ((fields (mapcar (lambda (elt) |
1257 |
(cdr (split-string |
(if (> (length elt) 0) |
1258 |
(buffer-substring |
elt)) |
1259 |
(line-beginning-position) |
(cdr (split-string |
1260 |
(line-end-position)) |
(buffer-substring |
1261 |
";"))))) |
(line-beginning-position) |
1262 |
;; The length depends on whether the last field was empty. |
(line-end-position)) |
1263 |
(unless (or (= 13 (length fields)) |
";"))))) |
1264 |
(= 14 (length fields))) |
;; The length depends on whether the last field was empty. |
1265 |
(error "Invalid contents in %s" unicodedata-file)) |
(unless (or (= 13 (length fields)) |
1266 |
;; The field names and values lists are slightly |
(= 14 (length fields))) |
1267 |
;; modified from Mule-UCS unidata.el. |
(error "Invalid contents in %s" unicodedata-file)) |
1268 |
(list |
;; The field names and values lists are slightly |
1269 |
(list "Name" (let ((name (nth 0 fields))) |
;; modified from Mule-UCS unidata.el. |
1270 |
;; Check for <..., First>, <..., Last> |
(list |
1271 |
(if (string-match "\\`\\(<[^,]+\\)," name) |
(list "Name" (let ((name (nth 0 fields))) |
1272 |
(concat (match-string 1 name) ">") |
;; Check for <..., First>, <..., Last> |
1273 |
name))) |
(if (string-match "\\`\\(<[^,]+\\)," name) |
1274 |
(list "Category" |
(concat (match-string 1 name) ">") |
1275 |
(cdr (assoc |
name))) |
1276 |
(nth 1 fields) |
(list "Category" |
1277 |
'(("Lu" . "uppercase letter") |
(cdr (assoc |
1278 |
("Ll" . "lowercase letter") |
(nth 1 fields) |
1279 |
("Lt" . "titlecase letter") |
'(("Lu" . "uppercase letter") |
1280 |
("Mn" . "non-spacing mark") |
("Ll" . "lowercase letter") |
1281 |
("Mc" . "spacing-combining mark") |
("Lt" . "titlecase letter") |
1282 |
("Me" . "enclosing mark") |
("Mn" . "non-spacing mark") |
1283 |
("Nd" . "decimal digit") |
("Mc" . "spacing-combining mark") |
1284 |
("Nl" . "letter number") |
("Me" . "enclosing mark") |
1285 |
("No" . "other number") |
("Nd" . "decimal digit") |
1286 |
("Zs" . "space separator") |
("Nl" . "letter number") |
1287 |
("Zl" . "line separator") |
("No" . "other number") |
1288 |
("Zp" . "paragraph separator") |
("Zs" . "space separator") |
1289 |
("Cc" . "other control") |
("Zl" . "line separator") |
1290 |
("Cf" . "other format") |
("Zp" . "paragraph separator") |
1291 |
("Cs" . "surrogate") |
("Cc" . "other control") |
1292 |
("Co" . "private use") |
("Cf" . "other format") |
1293 |
("Cn" . "not assigned") |
("Cs" . "surrogate") |
1294 |
("Lm" . "modifier letter") |
("Co" . "private use") |
1295 |
("Lo" . "other letter") |
("Cn" . "not assigned") |
1296 |
("Pc" . "connector punctuation") |
("Lm" . "modifier letter") |
1297 |
("Pd" . "dash punctuation") |
("Lo" . "other letter") |
1298 |
("Ps" . "open punctuation") |
("Pc" . "connector punctuation") |
1299 |
("Pe" . "close punctuation") |
("Pd" . "dash punctuation") |
1300 |
("Pi" . "initial-quotation punctuation") |
("Ps" . "open punctuation") |
1301 |
("Pf" . "final-quotation punctuation") |
("Pe" . "close punctuation") |
1302 |
("Po" . "other punctuation") |
("Pi" . "initial-quotation punctuation") |
1303 |
("Sm" . "math symbol") |
("Pf" . "final-quotation punctuation") |
1304 |
("Sc" . "currency symbol") |
("Po" . "other punctuation") |
1305 |
("Sk" . "modifier symbol") |
("Sm" . "math symbol") |
1306 |
("So" . "other symbol"))))) |
("Sc" . "currency symbol") |
1307 |
(list "Combining class" |
("Sk" . "modifier symbol") |
1308 |
(cdr (assoc |
("So" . "other symbol"))))) |
1309 |
(string-to-number (nth 2 fields)) |
(list "Combining class" |
1310 |
'((0 . "Spacing") |
(cdr (assoc |
1311 |
(1 . "Overlays and interior") |
(string-to-number (nth 2 fields)) |
1312 |
(7 . "Nuktas") |
'((0 . "Spacing") |
1313 |
(8 . "Hiragana/Katakana voicing marks") |
(1 . "Overlays and interior") |
1314 |
(9 . "Viramas") |
(7 . "Nuktas") |
1315 |
(10 . "Start of fixed position classes") |
(8 . "Hiragana/Katakana voicing marks") |
1316 |
(199 . "End of fixed position classes") |
(9 . "Viramas") |
1317 |
(200 . "Below left attached") |
(10 . "Start of fixed position classes") |
1318 |
(202 . "Below attached") |
(199 . "End of fixed position classes") |
1319 |
(204 . "Below right attached") |
(200 . "Below left attached") |
1320 |
(208 . "Left attached (reordrant around \ |
(202 . "Below attached") |
1321 |
|
(204 . "Below right attached") |
1322 |
|
(208 . "Left attached (reordrant around \ |
1323 |
single base character)") |
single base character)") |
1324 |
(210 . "Right attached") |
(210 . "Right attached") |
1325 |
(212 . "Above left attached") |
(212 . "Above left attached") |
1326 |
(214 . "Above attached") |
(214 . "Above attached") |
1327 |
(216 . "Above right attached") |
(216 . "Above right attached") |
1328 |
(218 . "Below left") |
(218 . "Below left") |
1329 |
(220 . "Below") |
(220 . "Below") |
1330 |
(222 . "Below right") |
(222 . "Below right") |
1331 |
(224 . "Left (reordrant around single base \ |
(224 . "Left (reordrant around single base \ |
1332 |
character)") |
character)") |
1333 |
(226 . "Right") |
(226 . "Right") |
1334 |
(228 . "Above left") |
(228 . "Above left") |
1335 |
(230 . "Above") |
(230 . "Above") |
1336 |
(232 . "Above right") |
(232 . "Above right") |
1337 |
(233 . "Double below") |
(233 . "Double below") |
1338 |
(234 . "Double above") |
(234 . "Double above") |
1339 |
(240 . "Below (iota subscript)"))))) |
(240 . "Below (iota subscript)"))))) |
1340 |
(list "Bidi category" |
(list "Bidi category" |
1341 |
(cdr (assoc |
(cdr (assoc |
1342 |
(nth 3 fields) |
(nth 3 fields) |
1343 |
'(("L" . "Left-to-Right") |
'(("L" . "Left-to-Right") |
1344 |
("LRE" . "Left-to-Right Embedding") |
("LRE" . "Left-to-Right Embedding") |
1345 |
("LRO" . "Left-to-Right Override") |
("LRO" . "Left-to-Right Override") |
1346 |
("R" . "Right-to-Left") |
("R" . "Right-to-Left") |
1347 |
("AL" . "Right-to-Left Arabic") |
("AL" . "Right-to-Left Arabic") |
1348 |
("RLE" . "Right-to-Left Embedding") |
("RLE" . "Right-to-Left Embedding") |
1349 |
("RLO" . "Right-to-Left Override") |
("RLO" . "Right-to-Left Override") |
1350 |
("PDF" . "Pop Directional Format") |
("PDF" . "Pop Directional Format") |
1351 |
("EN" . "European Number") |
("EN" . "European Number") |
1352 |
("ES" . "European Number Separator") |
("ES" . "European Number Separator") |
1353 |
("ET" . "European Number Terminator") |
("ET" . "European Number Terminator") |
1354 |
("AN" . "Arabic Number") |
("AN" . "Arabic Number") |
1355 |
("CS" . "Common Number Separator") |
("CS" . "Common Number Separator") |
1356 |
("NSM" . "Non-Spacing Mark") |
("NSM" . "Non-Spacing Mark") |
1357 |
("BN" . "Boundary Neutral") |
("BN" . "Boundary Neutral") |
1358 |
("B" . "Paragraph Separator") |
("B" . "Paragraph Separator") |
1359 |
("S" . "Segment Separator") |
("S" . "Segment Separator") |
1360 |
("WS" . "Whitespace") |
("WS" . "Whitespace") |
1361 |
("ON" . "Other Neutrals"))))) |
("ON" . "Other Neutrals"))))) |
1362 |
(list "Decomposition" |
(list "Decomposition" |
1363 |
(if (nth 4 fields) |
(if (nth 4 fields) |
1364 |
(let* ((parts (split-string (nth 4 fields))) |
(let* ((parts (split-string (nth 4 fields))) |
1365 |
(info (car parts))) |
(info (car parts))) |
1366 |
(if (string-match "\\`<\\(.+\\)>\\'" info) |
(if (string-match "\\`<\\(.+\\)>\\'" info) |
1367 |
(setq info (match-string 1 info)) |
(setq info (match-string 1 info)) |
1368 |
(setq info nil)) |
(setq info nil)) |
1369 |
(if info (setq parts (cdr parts))) |
(if info (setq parts (cdr parts))) |
1370 |
(setq parts (mapconcat |
(setq parts (mapconcat |
1371 |
(lambda (arg) |
(lambda (arg) |
1372 |
(string (string-to-number arg 16))) |
(string (string-to-number arg 16))) |
1373 |
parts " ")) |
parts " ")) |
1374 |
(concat info parts)))) |
(concat info parts)))) |
1375 |
(list "Decimal digit value" |
(list "Decimal digit value" |
1376 |
(if (nth 5 fields) |
(if (nth 5 fields) |
1377 |
(string-to-number (nth 5 fields)))) |
(string-to-number (nth 5 fields)))) |
1378 |
(list "Digit value" |
(list "Digit value" |
1379 |
(if (nth 6 fields) |
(if (nth 6 fields) |
1380 |
(string-to-number (nth 6 fields)))) |
(string-to-number (nth 6 fields)))) |
1381 |
(list "Numeric value" |
(list "Numeric value" |
1382 |
(if (nth 7 fields) |
(if (nth 7 fields) |
1383 |
(string-to-number (nth 6 fields)))) |
(string-to-number (nth 6 fields)))) |
1384 |
(list "Mirrored" |
(list "Mirrored" |
1385 |
(if (equal "Y" (nth 8 fields)) |
(if (equal "Y" (nth 8 fields)) |
1386 |
"yes")) |
"yes")) |
1387 |
(list "Old name" (nth 9 fields)) |
(list "Old name" (nth 9 fields)) |
1388 |
(list "ISO 10646 comment" (nth 10 fields)) |
(list "ISO 10646 comment" (nth 10 fields)) |
1389 |
(list "Uppercase" (and (nth 11 fields) |
(list "Uppercase" (and (nth 11 fields) |
1390 |
(string (string-to-number |
(string (string-to-number |
1391 |
(nth 11 fields) 16)))) |
(nth 11 fields) 16)))) |
1392 |
(list "Lowercase" (and (nth 12 fields) |
(list "Lowercase" (and (nth 12 fields) |
1393 |
(string (string-to-number |
(string (string-to-number |
1394 |
(nth 12 fields) 16)))) |
(nth 12 fields) 16)))) |
1395 |
(list "Titlecase" (and (nth 13 fields) |
(list "Titlecase" (and (nth 13 fields) |
1396 |
(string (string-to-number |
(string (string-to-number |
1397 |
(nth 13 fields) 16))))))))))) |
(nth 13 fields) 16))))))))))) |
1398 |
|
|
1399 |
;;; mule-diag.el ends here |
;;; mule-diag.el ends here |