218 |
(newline) |
(newline) |
219 |
(widget-insert "There are text properties here:\n") |
(widget-insert "There are text properties here:\n") |
220 |
(describe-property-list properties))))) |
(describe-property-list properties))))) |
221 |
|
|
222 |
|
;;; We cannot use the UnicodeData.txt file as such; it is not free. |
223 |
|
;;; We can turn that info a different format and release the result |
224 |
|
;;; as free data. When that is done, we could reinstate the code below. |
225 |
|
;;; For the mean time, here is a dummy placeholder. |
226 |
|
;;; -- rms |
227 |
|
(defun describe-char-unicode-data (char) nil) |
228 |
|
|
229 |
(defcustom unicodedata-file nil |
;;; (defcustom describe-char-unicodedata-file nil |
230 |
"Location of Unicode data file. |
;;; "Location of Unicode data file. |
231 |
This is the UnicodeData.txt file from the Unicode consortium, used for |
;;; This is the UnicodeData.txt file from the Unicode consortium, used for |
232 |
diagnostics. If it is non-nil `describe-char-after' will print data |
;;; diagnostics. If it is non-nil `describe-char-after' will print data |
233 |
looked up from it. This facility is mostly of use to people doing |
;;; looked up from it. This facility is mostly of use to people doing |
234 |
multilingual development. |
;;; multilingual development. |
235 |
|
|
236 |
This is a fairly large file, not typically present on GNU systems. At |
;;; This is a fairly large file, not typically present on GNU systems. At |
237 |
the time of writing it is at |
;;; the time of writing it is at |
238 |
<URL:ftp://www.unicode.org/Public/UNIDATA/UnicodeData.txt>." |
;;; <URL:ftp://www.unicode.org/Public/UNIDATA/UnicodeData.txt>." |
239 |
:group 'mule |
;;; :group 'mule |
240 |
:version "21.5" |
;;; :version "21.5" |
241 |
:type '(choice (const :tag "None" nil) |
;;; :type '(choice (const :tag "None" nil) |
242 |
file)) |
;;; file)) |
243 |
|
|
244 |
;; We could convert the unidata file into a Lispy form once-for-all |
;;; ;; We could convert the unidata file into a Lispy form once-for-all |
245 |
;; and distribute it for loading on demand. It might be made more |
;;; ;; and distribute it for loading on demand. It might be made more |
246 |
;; space-efficient by splitting strings word-wise and replacing them |
;;; ;; space-efficient by splitting strings word-wise and replacing them |
247 |
;; with lists of symbols interned in a private obarray, e.g. |
;;; ;; with lists of symbols interned in a private obarray, e.g. |
248 |
;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A). |
;;; ;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A). |
|
|
|
|
;; Fixme: Check whether this needs updating for Unicode 4. |
|
|
(defun unicode-data (char) |
|
|
"Return a list of Unicode data for unicode CHAR. |
|
|
Each element is a list of a property description and the property value. |
|
|
The list is null if CHAR isn't found in `unicodedata-file'." |
|
|
(when unicodedata-file |
|
|
(unless (file-exists-p unicodedata-file) |
|
|
(error "`unicodedata-file' %s not found" unicodedata-file)) |
|
|
(save-excursion |
|
|
;; Find file in fundamental mode to avoid, e.g. flyspell turned |
|
|
;; on for .txt. Don't use RAWFILE arg in case of DOS line endings. |
|
|
(set-buffer (let ((auto-mode-alist)) |
|
|
(find-file-noselect unicodedata-file))) |
|
|
(goto-char (point-min)) |
|
|
(let ((hex (format "%04X" char)) |
|
|
found first last) |
|
|
(if (re-search-forward (concat "^" hex) nil t) |
|
|
(setq found t) |
|
|
;; It's not listed explicitly. Look for ranges, e.g. CJK |
|
|
;; ideographs, and check whether it's in one of them. |
|
|
(while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t) |
|
|
(>= char (setq first |
|
|
(string-to-number (match-string 1) 16))) |
|
|
(progn |
|
|
(forward-line 1) |
|
|
(looking-at "^\\([^;]+\\);[^;]+Last>;") |
|
|
(> char |
|
|
(setq last |
|
|
(string-to-number (match-string 1) 16)))))) |
|
|
(if (and (>= char first) |
|
|
(<= char last)) |
|
|
(setq found t))) |
|
|
(if found |
|
|
(let ((fields (mapcar (lambda (elt) |
|
|
(if (> (length elt) 0) |
|
|
elt)) |
|
|
(cdr (split-string |
|
|
(buffer-substring |
|
|
(line-beginning-position) |
|
|
(line-end-position)) |
|
|
";"))))) |
|
|
;; The length depends on whether the last field was empty. |
|
|
(unless (or (= 13 (length fields)) |
|
|
(= 14 (length fields))) |
|
|
(error "Invalid contents in %s" unicodedata-file)) |
|
|
;; The field names and values lists are slightly |
|
|
;; modified from Mule-UCS unidata.el. |
|
|
(list |
|
|
(list "Name" (let ((name (nth 0 fields))) |
|
|
;; Check for <..., First>, <..., Last> |
|
|
(if (string-match "\\`\\(<[^,]+\\)," name) |
|
|
(concat (match-string 1 name) ">") |
|
|
name))) |
|
|
(list "Category" |
|
|
(cdr (assoc |
|
|
(nth 1 fields) |
|
|
'(("Lu" . "uppercase letter") |
|
|
("Ll" . "lowercase letter") |
|
|
("Lt" . "titlecase letter") |
|
|
("Mn" . "non-spacing mark") |
|
|
("Mc" . "spacing-combining mark") |
|
|
("Me" . "enclosing mark") |
|
|
("Nd" . "decimal digit") |
|
|
("Nl" . "letter number") |
|
|
("No" . "other number") |
|
|
("Zs" . "space separator") |
|
|
("Zl" . "line separator") |
|
|
("Zp" . "paragraph separator") |
|
|
("Cc" . "other control") |
|
|
("Cf" . "other format") |
|
|
("Cs" . "surrogate") |
|
|
("Co" . "private use") |
|
|
("Cn" . "not assigned") |
|
|
("Lm" . "modifier letter") |
|
|
("Lo" . "other letter") |
|
|
("Pc" . "connector punctuation") |
|
|
("Pd" . "dash punctuation") |
|
|
("Ps" . "open punctuation") |
|
|
("Pe" . "close punctuation") |
|
|
("Pi" . "initial-quotation punctuation") |
|
|
("Pf" . "final-quotation punctuation") |
|
|
("Po" . "other punctuation") |
|
|
("Sm" . "math symbol") |
|
|
("Sc" . "currency symbol") |
|
|
("Sk" . "modifier symbol") |
|
|
("So" . "other symbol"))))) |
|
|
(list "Combining class" |
|
|
(cdr (assoc |
|
|
(string-to-number (nth 2 fields)) |
|
|
'((0 . "Spacing") |
|
|
(1 . "Overlays and interior") |
|
|
(7 . "Nuktas") |
|
|
(8 . "Hiragana/Katakana voicing marks") |
|
|
(9 . "Viramas") |
|
|
(10 . "Start of fixed position classes") |
|
|
(199 . "End of fixed position classes") |
|
|
(200 . "Below left attached") |
|
|
(202 . "Below attached") |
|
|
(204 . "Below right attached") |
|
|
(208 . "Left attached (reordrant around \ |
|
|
single base character)") |
|
|
(210 . "Right attached") |
|
|
(212 . "Above left attached") |
|
|
(214 . "Above attached") |
|
|
(216 . "Above right attached") |
|
|
(218 . "Below left") |
|
|
(220 . "Below") |
|
|
(222 . "Below right") |
|
|
(224 . "Left (reordrant around single base \ |
|
|
character)") |
|
|
(226 . "Right") |
|
|
(228 . "Above left") |
|
|
(230 . "Above") |
|
|
(232 . "Above right") |
|
|
(233 . "Double below") |
|
|
(234 . "Double above") |
|
|
(240 . "Below (iota subscript)"))))) |
|
|
(list "Bidi category" |
|
|
(cdr (assoc |
|
|
(nth 3 fields) |
|
|
'(("L" . "Left-to-Right") |
|
|
("LRE" . "Left-to-Right Embedding") |
|
|
("LRO" . "Left-to-Right Override") |
|
|
("R" . "Right-to-Left") |
|
|
("AL" . "Right-to-Left Arabic") |
|
|
("RLE" . "Right-to-Left Embedding") |
|
|
("RLO" . "Right-to-Left Override") |
|
|
("PDF" . "Pop Directional Format") |
|
|
("EN" . "European Number") |
|
|
("ES" . "European Number Separator") |
|
|
("ET" . "European Number Terminator") |
|
|
("AN" . "Arabic Number") |
|
|
("CS" . "Common Number Separator") |
|
|
("NSM" . "Non-Spacing Mark") |
|
|
("BN" . "Boundary Neutral") |
|
|
("B" . "Paragraph Separator") |
|
|
("S" . "Segment Separator") |
|
|
("WS" . "Whitespace") |
|
|
("ON" . "Other Neutrals"))))) |
|
|
(list |
|
|
"Decomposition" |
|
|
(if (nth 4 fields) |
|
|
(let* ((parts (split-string (nth 4 fields))) |
|
|
(info (car parts))) |
|
|
(if (string-match "\\`<\\(.+\\)>\\'" info) |
|
|
(setq info (match-string 1 info)) |
|
|
(setq info nil)) |
|
|
(if info (setq parts (cdr parts))) |
|
|
;; Maybe printing ? for unrepresentable unicodes |
|
|
;; here and below should be changed? |
|
|
(setq parts (mapconcat |
|
|
(lambda (arg) |
|
|
(string (or (decode-char |
|
|
'ucs |
|
|
(string-to-number arg 16)) |
|
|
??))) |
|
|
parts " ")) |
|
|
(concat info parts)))) |
|
|
(list "Decimal digit value" |
|
|
(nth 5 fields)) |
|
|
(list "Digit value" |
|
|
(nth 6 fields)) |
|
|
(list "Numeric value" |
|
|
(nth 7 fields)) |
|
|
(list "Mirrored" |
|
|
(if (equal "Y" (nth 8 fields)) |
|
|
"yes")) |
|
|
(list "Old name" (nth 9 fields)) |
|
|
(list "ISO 10646 comment" (nth 10 fields)) |
|
|
(list "Uppercase" (and (nth 11 fields) |
|
|
(string (or (decode-char |
|
|
'ucs |
|
|
(string-to-number |
|
|
(nth 11 fields) 16)) |
|
|
??)))) |
|
|
(list "Lowercase" (and (nth 12 fields) |
|
|
(string (or (decode-char |
|
|
'ucs |
|
|
(string-to-number |
|
|
(nth 12 fields) 16)) |
|
|
??)))) |
|
|
(list "Titlecase" (and (nth 13 fields) |
|
|
(string (or (decode-char |
|
|
'ucs |
|
|
(string-to-number |
|
|
(nth 13 fields) 16)) |
|
|
??))))))))))) |
|
249 |
|
|
250 |
|
;;; ;; Fixme: Check whether this needs updating for Unicode 4. |
251 |
|
;;; (defun describe-char-unicode-data (char) |
252 |
|
;;; "Return a list of Unicode data for unicode CHAR. |
253 |
|
;;; Each element is a list of a property description and the property value. |
254 |
|
;;; The list is null if CHAR isn't found in `describe-char-unicodedata-file'." |
255 |
|
;;; (when describe-char-unicodedata-file |
256 |
|
;;; (unless (file-exists-p describe-char-unicodedata-file) |
257 |
|
;;; (error "`unicodedata-file' %s not found" describe-char-unicodedata-file)) |
258 |
|
;;; (save-excursion |
259 |
|
;;; ;; Find file in fundamental mode to avoid, e.g. flyspell turned |
260 |
|
;;; ;; on for .txt. Don't use RAWFILE arg in case of DOS line endings. |
261 |
|
;;; (set-buffer (let ((auto-mode-alist)) |
262 |
|
;;; (find-file-noselect describe-char-unicodedata-file))) |
263 |
|
;;; (goto-char (point-min)) |
264 |
|
;;; (let ((hex (format "%04X" char)) |
265 |
|
;;; found first last) |
266 |
|
;;; (if (re-search-forward (concat "^" hex) nil t) |
267 |
|
;;; (setq found t) |
268 |
|
;;; ;; It's not listed explicitly. Look for ranges, e.g. CJK |
269 |
|
;;; ;; ideographs, and check whether it's in one of them. |
270 |
|
;;; (while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t) |
271 |
|
;;; (>= char (setq first |
272 |
|
;;; (string-to-number (match-string 1) 16))) |
273 |
|
;;; (progn |
274 |
|
;;; (forward-line 1) |
275 |
|
;;; (looking-at "^\\([^;]+\\);[^;]+Last>;") |
276 |
|
;;; (> char |
277 |
|
;;; (setq last |
278 |
|
;;; (string-to-number (match-string 1) 16)))))) |
279 |
|
;;; (if (and (>= char first) |
280 |
|
;;; (<= char last)) |
281 |
|
;;; (setq found t))) |
282 |
|
;;; (if found |
283 |
|
;;; (let ((fields (mapcar (lambda (elt) |
284 |
|
;;; (if (> (length elt) 0) |
285 |
|
;;; elt)) |
286 |
|
;;; (cdr (split-string |
287 |
|
;;; (buffer-substring |
288 |
|
;;; (line-beginning-position) |
289 |
|
;;; (line-end-position)) |
290 |
|
;;; ";"))))) |
291 |
|
;;; ;; The length depends on whether the last field was empty. |
292 |
|
;;; (unless (or (= 13 (length fields)) |
293 |
|
;;; (= 14 (length fields))) |
294 |
|
;;; (error "Invalid contents in %s" describe-char-unicodedata-file)) |
295 |
|
;;; ;; The field names and values lists are slightly |
296 |
|
;;; ;; modified from Mule-UCS unidata.el. |
297 |
|
;;; (list |
298 |
|
;;; (list "Name" (let ((name (nth 0 fields))) |
299 |
|
;;; ;; Check for <..., First>, <..., Last> |
300 |
|
;;; (if (string-match "\\`\\(<[^,]+\\)," name) |
301 |
|
;;; (concat (match-string 1 name) ">") |
302 |
|
;;; name))) |
303 |
|
;;; (list "Category" |
304 |
|
;;; (cdr (assoc |
305 |
|
;;; (nth 1 fields) |
306 |
|
;;; '(("Lu" . "uppercase letter") |
307 |
|
;;; ("Ll" . "lowercase letter") |
308 |
|
;;; ("Lt" . "titlecase letter") |
309 |
|
;;; ("Mn" . "non-spacing mark") |
310 |
|
;;; ("Mc" . "spacing-combining mark") |
311 |
|
;;; ("Me" . "enclosing mark") |
312 |
|
;;; ("Nd" . "decimal digit") |
313 |
|
;;; ("Nl" . "letter number") |
314 |
|
;;; ("No" . "other number") |
315 |
|
;;; ("Zs" . "space separator") |
316 |
|
;;; ("Zl" . "line separator") |
317 |
|
;;; ("Zp" . "paragraph separator") |
318 |
|
;;; ("Cc" . "other control") |
319 |
|
;;; ("Cf" . "other format") |
320 |
|
;;; ("Cs" . "surrogate") |
321 |
|
;;; ("Co" . "private use") |
322 |
|
;;; ("Cn" . "not assigned") |
323 |
|
;;; ("Lm" . "modifier letter") |
324 |
|
;;; ("Lo" . "other letter") |
325 |
|
;;; ("Pc" . "connector punctuation") |
326 |
|
;;; ("Pd" . "dash punctuation") |
327 |
|
;;; ("Ps" . "open punctuation") |
328 |
|
;;; ("Pe" . "close punctuation") |
329 |
|
;;; ("Pi" . "initial-quotation punctuation") |
330 |
|
;;; ("Pf" . "final-quotation punctuation") |
331 |
|
;;; ("Po" . "other punctuation") |
332 |
|
;;; ("Sm" . "math symbol") |
333 |
|
;;; ("Sc" . "currency symbol") |
334 |
|
;;; ("Sk" . "modifier symbol") |
335 |
|
;;; ("So" . "other symbol"))))) |
336 |
|
;;; (list "Combining class" |
337 |
|
;;; (cdr (assoc |
338 |
|
;;; (string-to-number (nth 2 fields)) |
339 |
|
;;; '((0 . "Spacing") |
340 |
|
;;; (1 . "Overlays and interior") |
341 |
|
;;; (7 . "Nuktas") |
342 |
|
;;; (8 . "Hiragana/Katakana voicing marks") |
343 |
|
;;; (9 . "Viramas") |
344 |
|
;;; (10 . "Start of fixed position classes") |
345 |
|
;;; (199 . "End of fixed position classes") |
346 |
|
;;; (200 . "Below left attached") |
347 |
|
;;; (202 . "Below attached") |
348 |
|
;;; (204 . "Below right attached") |
349 |
|
;;; (208 . "Left attached (reordrant around \ |
350 |
|
;;; single base character)") |
351 |
|
;;; (210 . "Right attached") |
352 |
|
;;; (212 . "Above left attached") |
353 |
|
;;; (214 . "Above attached") |
354 |
|
;;; (216 . "Above right attached") |
355 |
|
;;; (218 . "Below left") |
356 |
|
;;; (220 . "Below") |
357 |
|
;;; (222 . "Below right") |
358 |
|
;;; (224 . "Left (reordrant around single base \ |
359 |
|
;;; character)") |
360 |
|
;;; (226 . "Right") |
361 |
|
;;; (228 . "Above left") |
362 |
|
;;; (230 . "Above") |
363 |
|
;;; (232 . "Above right") |
364 |
|
;;; (233 . "Double below") |
365 |
|
;;; (234 . "Double above") |
366 |
|
;;; (240 . "Below (iota subscript)"))))) |
367 |
|
;;; (list "Bidi category" |
368 |
|
;;; (cdr (assoc |
369 |
|
;;; (nth 3 fields) |
370 |
|
;;; '(("L" . "Left-to-Right") |
371 |
|
;;; ("LRE" . "Left-to-Right Embedding") |
372 |
|
;;; ("LRO" . "Left-to-Right Override") |
373 |
|
;;; ("R" . "Right-to-Left") |
374 |
|
;;; ("AL" . "Right-to-Left Arabic") |
375 |
|
;;; ("RLE" . "Right-to-Left Embedding") |
376 |
|
;;; ("RLO" . "Right-to-Left Override") |
377 |
|
;;; ("PDF" . "Pop Directional Format") |
378 |
|
;;; ("EN" . "European Number") |
379 |
|
;;; ("ES" . "European Number Separator") |
380 |
|
;;; ("ET" . "European Number Terminator") |
381 |
|
;;; ("AN" . "Arabic Number") |
382 |
|
;;; ("CS" . "Common Number Separator") |
383 |
|
;;; ("NSM" . "Non-Spacing Mark") |
384 |
|
;;; ("BN" . "Boundary Neutral") |
385 |
|
;;; ("B" . "Paragraph Separator") |
386 |
|
;;; ("S" . "Segment Separator") |
387 |
|
;;; ("WS" . "Whitespace") |
388 |
|
;;; ("ON" . "Other Neutrals"))))) |
389 |
|
;;; (list |
390 |
|
;;; "Decomposition" |
391 |
|
;;; (if (nth 4 fields) |
392 |
|
;;; (let* ((parts (split-string (nth 4 fields))) |
393 |
|
;;; (info (car parts))) |
394 |
|
;;; (if (string-match "\\`<\\(.+\\)>\\'" info) |
395 |
|
;;; (setq info (match-string 1 info)) |
396 |
|
;;; (setq info nil)) |
397 |
|
;;; (if info (setq parts (cdr parts))) |
398 |
|
;;; ;; Maybe printing ? for unrepresentable unicodes |
399 |
|
;;; ;; here and below should be changed? |
400 |
|
;;; (setq parts (mapconcat |
401 |
|
;;; (lambda (arg) |
402 |
|
;;; (string (or (decode-char |
403 |
|
;;; 'ucs |
404 |
|
;;; (string-to-number arg 16)) |
405 |
|
;;; ??))) |
406 |
|
;;; parts " ")) |
407 |
|
;;; (concat info parts)))) |
408 |
|
;;; (list "Decimal digit value" |
409 |
|
;;; (nth 5 fields)) |
410 |
|
;;; (list "Digit value" |
411 |
|
;;; (nth 6 fields)) |
412 |
|
;;; (list "Numeric value" |
413 |
|
;;; (nth 7 fields)) |
414 |
|
;;; (list "Mirrored" |
415 |
|
;;; (if (equal "Y" (nth 8 fields)) |
416 |
|
;;; "yes")) |
417 |
|
;;; (list "Old name" (nth 9 fields)) |
418 |
|
;;; (list "ISO 10646 comment" (nth 10 fields)) |
419 |
|
;;; (list "Uppercase" (and (nth 11 fields) |
420 |
|
;;; (string (or (decode-char |
421 |
|
;;; 'ucs |
422 |
|
;;; (string-to-number |
423 |
|
;;; (nth 11 fields) 16)) |
424 |
|
;;; ??)))) |
425 |
|
;;; (list "Lowercase" (and (nth 12 fields) |
426 |
|
;;; (string (or (decode-char |
427 |
|
;;; 'ucs |
428 |
|
;;; (string-to-number |
429 |
|
;;; (nth 12 fields) 16)) |
430 |
|
;;; ??)))) |
431 |
|
;;; (list "Titlecase" (and (nth 13 fields) |
432 |
|
;;; (string (or (decode-char |
433 |
|
;;; 'ucs |
434 |
|
;;; (string-to-number |
435 |
|
;;; (nth 13 fields) 16)) |
436 |
|
;;; ??))))))))))) |
437 |
|
|
438 |
;;;###autoload |
;;;###autoload |
439 |
(defun describe-char (pos) |
(defun describe-char (pos) |
440 |
"Describe the character after POS (interactively, the character after point). |
"Describe the character after POS (interactively, the character after point). |
524 |
(encoded-string-description encoded coding) |
(encoded-string-description encoded coding) |
525 |
"not encodable")))) |
"not encodable")))) |
526 |
,@(let ((unicodedata (and unicode |
,@(let ((unicodedata (and unicode |
527 |
(unicode-data unicode)))) |
(describe-char-unicode-data unicode)))) |
528 |
(if unicodedata |
(if unicodedata |
529 |
(cons (list "Unicode data" " ") unicodedata)))))) |
(cons (list "Unicode data" " ") unicodedata)))))) |
530 |
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) |
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) |