/[emacs]/emacs/lisp/international/mule-diag.el
ViewVC logotype

Diff of /emacs/lisp/international/mule-diag.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.68.2.14 by fx, Sun Aug 18 13:27:46 2002 UTC revision 1.68.2.15 by fx, Sat Oct 5 18:52:52 2002 UTC
# Line 1228  looked up from it." Line 1228  looked up from it."
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

Legend:
Removed from v.1.68.2.14  
changed lines
  Added in v.1.68.2.15

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26