Mercurial > emacs

comparison lisp/descr-text.el @ 90087:230281e520b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(describe-char-unidata-list): New variable. (describe-char-unicode-data): Use char-code-property-description. (describe-char): Add lines for describing Unicode-based character properties.
author Kenichi Handa <handa@m17n.org>
date Sun, 30 Jan 2005 11:24:10 +0000
parents f8a7a9ba3d08
children 3ebd9bdb4fe5
comparison
equal deleted inserted replaced
90086:f16730ea4562 90087:230281e520b3
212 (when properties 212 (when properties
213 (newline) 213 (newline)
214 (widget-insert "There are text properties here:\n") 214 (widget-insert "There are text properties here:\n")
215 (describe-property-list properties))))) 215 (describe-property-list properties)))))
216 216
217 (defcustom describe-char-unidata-list nil
218 "List of Unicode-based character property names shown by `describe-char'."
219 :group 'mule
220 :version "22.1"
221 :type '(set
222 (const :tag "Unicode Name" name)
223 (const :tag "Unicode general category " general-category)
224 (const :tag "Unicode canonical combining class"
225 canonical-combining-class)
226 (const :tag "Unicode bidi class" bidi-class)
227 (const :tag "Unicode decomposition mapping" decomposition)
228 (const :tag "Unicode decimal digit value" decimal-digit-value)
229 (const :tag "Unicode digit value" digit-value)
230 (const :tag "Unicode numeric value" numeric-value)
231 (const :tag "Unicode mirrored" mirrored)
232 (const :tag "Unicode old name" old-name)
233 (const :tag "Unicode ISO 10646 comment" iso-10646-comment)
234 (const :tag "Unicode simple uppercase mapping" uppercase)
235 (const :tag "Unicode simple lowercase mapping" lowercase)
236 (const :tag "Unicode simple titlecase mapping" titlecase)))
237
217 (defcustom describe-char-unicodedata-file nil 238 (defcustom describe-char-unicodedata-file nil
218 "Location of Unicode data file. 239 "Location of Unicode data file.
219 This is the UnicodeData.txt file from the Unicode consortium, used for 240 This is the UnicodeData.txt file from the Unicode consortium, used for
220 diagnostics. If it is non-nil `describe-char' will print data 241 diagnostics. If it is non-nil `describe-char' will print data
221 looked up from it. This facility is mostly of use to people doing 242 looked up from it. This facility is mostly of use to people doing
237 258
238 ;; Fixme: Check whether this needs updating for Unicode 4. 259 ;; Fixme: Check whether this needs updating for Unicode 4.
239 (defun describe-char-unicode-data (char) 260 (defun describe-char-unicode-data (char)
240 "Return a list of Unicode data for unicode CHAR. 261 "Return a list of Unicode data for unicode CHAR.
241 Each element is a list of a property description and the property value. 262 Each element is a list of a property description and the property value.
242 The list is null if CHAR isn't found in `describe-char-unicodedata-file'." 263 The list is null if CHAR isn't found in `describe-char-unicodedata-file'.
264 This function is semi-obsolete. Use `get-char-code-property'."
243 (when describe-char-unicodedata-file 265 (when describe-char-unicodedata-file
244 (unless (file-exists-p describe-char-unicodedata-file) 266 (unless (file-exists-p describe-char-unicodedata-file)
245 (error "`unicodedata-file' %s not found" describe-char-unicodedata-file)) 267 (error "`unicodedata-file' %s not found" describe-char-unicodedata-file))
246 (with-current-buffer 268 (with-current-buffer
247 ;; Find file in fundamental mode to avoid, e.g. flyspell turned 269 ;; Find file in fundamental mode to avoid, e.g. flyspell turned
287 ;; Check for <..., First>, <..., Last> 309 ;; Check for <..., First>, <..., Last>
288 (if (string-match "\\`\\(<[^,]+\\)," name) 310 (if (string-match "\\`\\(<[^,]+\\)," name)
289 (concat (match-string 1 name) ">") 311 (concat (match-string 1 name) ">")
290 name))) 312 name)))
291 (list "Category" 313 (list "Category"
292 (cdr (assoc 314 (let ((val (nth 1 fields)))
293 (nth 1 fields) 315 (or (char-code-property-description
294 '(("Lu" . "uppercase letter") 316 'general-category (intern val))
295 ("Ll" . "lowercase letter") 317 val)))
296 ("Lt" . "titlecase letter")
297 ("Mn" . "non-spacing mark")
298 ("Mc" . "spacing-combining mark")
299 ("Me" . "enclosing mark")
300 ("Nd" . "decimal digit")
301 ("Nl" . "letter number")
302 ("No" . "other number")
303 ("Zs" . "space separator")
304 ("Zl" . "line separator")
305 ("Zp" . "paragraph separator")
306 ("Cc" . "other control")
307 ("Cf" . "other format")
308 ("Cs" . "surrogate")
309 ("Co" . "private use")
310 ("Cn" . "not assigned")
311 ("Lm" . "modifier letter")
312 ("Lo" . "other letter")
313 ("Pc" . "connector punctuation")
314 ("Pd" . "dash punctuation")
315 ("Ps" . "open punctuation")
316 ("Pe" . "close punctuation")
317 ("Pi" . "initial-quotation punctuation")
318 ("Pf" . "final-quotation punctuation")
319 ("Po" . "other punctuation")
320 ("Sm" . "math symbol")
321 ("Sc" . "currency symbol")
322 ("Sk" . "modifier symbol")
323 ("So" . "other symbol")))))
324 (list "Combining class" 318 (list "Combining class"
325 (cdr (assoc 319 (let ((val (nth 1 fields)))
326 (string-to-number (nth 2 fields)) 320 (or (char-code-property-description
327 '((0 . "Spacing") 321 'canonical-combining-class (intern val))
328 (1 . "Overlays and interior") 322 val)))
329 (7 . "Nuktas")
330 (8 . "Hiragana/Katakana voicing marks")
331 (9 . "Viramas")
332 (10 . "Start of fixed position classes")
333 (199 . "End of fixed position classes")
334 (200 . "Below left attached")
335 (202 . "Below attached")
336 (204 . "Below right attached")
337 (208 . "Left attached (reordrant around \
338 single base character)")
339 (210 . "Right attached")
340 (212 . "Above left attached")
341 (214 . "Above attached")
342 (216 . "Above right attached")
343 (218 . "Below left")
344 (220 . "Below")
345 (222 . "Below right")
346 (224 . "Left (reordrant around single base \
347 character)")
348 (226 . "Right")
349 (228 . "Above left")
350 (230 . "Above")
351 (232 . "Above right")
352 (233 . "Double below")
353 (234 . "Double above")
354 (240 . "Below (iota subscript)")))))
355 (list "Bidi category" 323 (list "Bidi category"
356 (cdr (assoc 324 (let ((val (nth 1 fields)))
357 (nth 3 fields) 325 (or (char-code-property-description
358 '(("L" . "Left-to-Right") 326 'bidi-class (intern val))
359 ("LRE" . "Left-to-Right Embedding") 327 val)))
360 ("LRO" . "Left-to-Right Override")
361 ("R" . "Right-to-Left")
362 ("AL" . "Right-to-Left Arabic")
363 ("RLE" . "Right-to-Left Embedding")
364 ("RLO" . "Right-to-Left Override")
365 ("PDF" . "Pop Directional Format")
366 ("EN" . "European Number")
367 ("ES" . "European Number Separator")
368 ("ET" . "European Number Terminator")
369 ("AN" . "Arabic Number")
370 ("CS" . "Common Number Separator")
371 ("NSM" . "Non-Spacing Mark")
372 ("BN" . "Boundary Neutral")
373 ("B" . "Paragraph Separator")
374 ("S" . "Segment Separator")
375 ("WS" . "Whitespace")
376 ("ON" . "Other Neutrals")))))
377 (list 328 (list
378 "Decomposition" 329 "Decomposition"
379 (if (nth 4 fields) 330 (if (nth 4 fields)
380 (let* ((parts (split-string (nth 4 fields))) 331 (let* ((parts (split-string (nth 4 fields)))
381 (info (car parts))) 332 (info (car parts)))
382 (if (string-match "\\`<\\(.+\\)>\\'" info) 333 (if (string-match "\\`<\\(.+\\)>\\'" info)
383 (setq info (match-string 1 info)) 334 (setq info (match-string 1 info))
384 (setq info nil)) 335 (setq info nil))
385 (if info (setq parts (cdr parts))) 336 (if info (setq parts (cdr parts)))
386 ;; Maybe printing ? for unrepresentable unicodes
387 ;; here and below should be changed?
388 (setq parts (mapconcat 337 (setq parts (mapconcat
389 (lambda (arg) 338 (lambda (arg)
390 (string (or (decode-char 339 (string (string-to-number arg 16)))
391 'ucs
392 (string-to-number arg 16))
393 ??)))
394 parts " ")) 340 parts " "))
395 (concat info parts)))) 341 (concat info parts))))
396 (list "Decimal digit value" 342 (list "Decimal digit value"
397 (nth 5 fields)) 343 (nth 5 fields))
398 (list "Digit value" 344 (list "Digit value"
403 (if (equal "Y" (nth 8 fields)) 349 (if (equal "Y" (nth 8 fields))
404 "yes")) 350 "yes"))
405 (list "Old name" (nth 9 fields)) 351 (list "Old name" (nth 9 fields))
406 (list "ISO 10646 comment" (nth 10 fields)) 352 (list "ISO 10646 comment" (nth 10 fields))
407 (list "Uppercase" (and (nth 11 fields) 353 (list "Uppercase" (and (nth 11 fields)
408 (string (or (decode-char 354 (string (string-to-number
409 'ucs 355 (nth 11 fields) 16))))
410 (string-to-number
411 (nth 11 fields) 16))
412 ??))))
413 (list "Lowercase" (and (nth 12 fields) 356 (list "Lowercase" (and (nth 12 fields)
414 (string (or (decode-char 357 (string (string-to-number
415 'ucs 358 (nth 12 fields) 16))))
416 (string-to-number
417 (nth 12 fields) 16))
418 ??))))
419 (list "Titlecase" (and (nth 13 fields) 359 (list "Titlecase" (and (nth 13 fields)
420 (string (or (decode-char 360 (string (string-to-number
421 'ucs 361 (nth 13 fields) 16)))))))))))
422 (string-to-number
423 (nth 13 fields) 16))
424 ??)))))))))))
425 362
426 ;; Return information about how CHAR is displayed at the buffer 363 ;; Return information about how CHAR is displayed at the buffer
427 ;; position POS. If the selected frame is on a graphic display, 364 ;; position POS. If the selected frame is on a graphic display,
428 ;; return a cons (FONTNAME . GLYPH-CODE). Otherwise, return a string 365 ;; return a cons (FONTNAME . GLYPH-CODE). Otherwise, return a string
429 ;; describing the terminal codes for the character. 366 ;; describing the terminal codes for the character.
488 (if (not category-set) 425 (if (not category-set)
489 '("-- none --") 426 '("-- none --")
490 (mapcar #'(lambda (x) (format "%c:%s " 427 (mapcar #'(lambda (x) (format "%c:%s "
491 x (category-docstring x))) 428 x (category-docstring x)))
492 (category-set-mnemonics category-set))))) 429 (category-set-mnemonics category-set)))))
493 ,@(let ((props (aref char-code-property-table char))
494 ps)
495 (when props
496 (while props
497 (push (format "%s:" (pop props)) ps)
498 (push (format "%s;" (pop props)) ps))
499 (list (cons "Properties" (nreverse ps)))))
500 ("to input" 430 ("to input"
501 ,@(let ((key-list (and (eq input-method-function 431 ,@(let ((key-list (and (eq input-method-function
502 'quail-input-method) 432 'quail-input-method)
503 (quail-find-key char)))) 433 (quail-find-key char))))
504 (if (consp key-list) 434 (if (consp key-list)
652 (propertize " " 'display '(space :align-to 5)) 582 (propertize " " 'display '(space :align-to 5))
653 (or (cdr elt) "-- not encodable --")))) 583 (or (cdr elt) "-- not encodable --"))))
654 (insert "\nSee the variable `reference-point-alist' for " 584 (insert "\nSee the variable `reference-point-alist' for "
655 "the meaning of the rule.\n")) 585 "the meaning of the rule.\n"))
656 586
587 (if (not describe-char-unidata-list)
588 (insert "\nCharacter code properties are not shown: ")
589 (insert "\nCharacter code properties: "))
590 (widget-create 'link
591 :notify (lambda (&rest ignore)
592 (customize-variable
593 'describe-char-unidata-list))
594 "customize what to show")
595 (insert "\n")
596 (dolist (elt describe-char-unidata-list)
597 (let ((val (get-char-code-property char elt))
598 description)
599 (when val
600 (setq description (char-code-property-description elt val))
601 (if description
602 (insert (format " %s: %s (%s)\n" elt val description))
603 (insert (format " %s: %s\n" elt val))))))
604
657 (describe-text-properties pos (current-buffer)) 605 (describe-text-properties pos (current-buffer))
658 (describe-text-mode))))) 606 (describe-text-mode)))))
659 607
660 (defalias 'describe-char-after 'describe-char) 608 (defalias 'describe-char-after 'describe-char)
661 (make-obsolete 'describe-char-after 'describe-char "21.5") 609 (make-obsolete 'describe-char-after 'describe-char "21.5")