diff options
Diffstat (limited to 'lisp/descr-text.el')
| -rw-r--r-- | lisp/descr-text.el | 199 |
1 files changed, 69 insertions, 130 deletions
diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 3c548458713..447762704ca 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -214,6 +214,27 @@ otherwise." (widget-insert "There are text properties here:\n") (describe-property-list properties))))) +(defcustom describe-char-unidata-list nil + "List of Unicode-based character property names shown by `describe-char'." + :group 'mule + :version "23.1" + :type '(set + (const :tag "Unicode Name" name) + (const :tag "Unicode general category " general-category) + (const :tag "Unicode canonical combining class" + canonical-combining-class) + (const :tag "Unicode bidi class" bidi-class) + (const :tag "Unicode decomposition mapping" decomposition) + (const :tag "Unicode decimal digit value" decimal-digit-value) + (const :tag "Unicode digit value" digit-value) + (const :tag "Unicode numeric value" numeric-value) + (const :tag "Unicode mirrored" mirrored) + (const :tag "Unicode old name" old-name) + (const :tag "Unicode ISO 10646 comment" iso-10646-comment) + (const :tag "Unicode simple uppercase mapping" uppercase) + (const :tag "Unicode simple lowercase mapping" lowercase) + (const :tag "Unicode simple titlecase mapping" titlecase))) + (defcustom describe-char-unicodedata-file nil "Location of Unicode data file. This is the UnicodeData.txt file from the Unicode consortium, used for @@ -239,7 +260,8 @@ the time of writing it is at (defun describe-char-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 `describe-char-unicodedata-file'." +The list is null if CHAR isn't found in `describe-char-unicodedata-file'. +This function is semi-obsolete. Use `get-char-code-property'." (when describe-char-unicodedata-file (unless (file-exists-p describe-char-unicodedata-file) (error "`unicodedata-file' %s not found" describe-char-unicodedata-file)) @@ -289,91 +311,20 @@ The list is null if CHAR isn't found in `describe-char-unicodedata-file'." (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"))))) + (let ((val (nth 1 fields))) + (or (char-code-property-description + 'general-category (intern val)) + val))) (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)"))))) + (let ((val (nth 1 fields))) + (or (char-code-property-description + 'canonical-combining-class (intern val)) + val))) (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"))))) + (let ((val (nth 1 fields))) + (or (char-code-property-description + 'bidi-class (intern val)) + val))) (list "Decomposition" (if (nth 4 fields) @@ -383,14 +334,9 @@ character)") (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)) - ??))) + (string (string-to-number arg 16))) parts " ")) (concat info parts)))) (list "Decimal digit value" @@ -405,23 +351,14 @@ character)") (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)) - ??)))) + (string (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)) - ??)))) + (string (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)) - ??))))))))))) + (string (string-to-number + (nth 13 fields) 16))))))))))) ;; Return information about how CHAR is displayed at the buffer ;; position POS. If the selected frame is on a graphic display, @@ -457,16 +394,12 @@ as well as widgets, buttons, overlays, and text properties." (multibyte-p enable-multibyte-characters) (overlays (mapcar #'(lambda (o) (overlay-properties o)) (overlays-at pos))) - item-list max-width unicode) + item-list max-width code) - (if (or (< char 256) - (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos))) - (get-char-property pos 'untranslated-utf-8)) - (setq unicode (or (get-char-property pos 'untranslated-utf-8) - (encode-char char 'ucs)))) + (setq code (encode-char char charset)) (setq item-list `(("character" - ,(format "%s (0%o, %d, 0x%x%s)" + ,(format "%s (0%o, %d, 0x%x)" (apply 'propertize (if (not multibyte-p) (single-key-description char) (if (< char 128) @@ -474,18 +407,14 @@ as well as widgets, buttons, overlays, and text properties." (string-to-multibyte (char-to-string char)))) (text-properties-at pos)) - char char char - (if unicode - (format ", U+%04X" unicode) - ""))) - ("charset" + char char char)) + ("preferred charset" ,(symbol-name charset) ,(format "(%s)" (charset-description charset))) ("code point" - ,(let ((split (split-char char))) - (if (= (charset-dimension charset) 1) - (format "%d" (nth 1 split)) - (format "%d %d" (nth 1 split) (nth 2 split))))) + ,(if (integerp code) + (format (if (< code 256) "0x%02X" "0x%04X") code) + (format "0x%04X%04X" (car code) (cdr code)))) ("syntax" ,(let ((syntax (syntax-after pos))) (with-temp-buffer @@ -498,13 +427,6 @@ as well as widgets, buttons, overlays, and text properties." (mapcar #'(lambda (x) (format "%c:%s " x (category-docstring x))) (category-set-mnemonics category-set))))) - ,@(let ((props (aref char-code-property-table char)) - ps) - (when props - (while props - (push (format "%s:" (pop props)) ps) - (push (format "%s;" (pop props)) ps)) - (list (cons "Properties" (nreverse ps))))) ("to input" ,@(let ((key-list (and (eq input-method-function 'quail-input-method) @@ -571,8 +493,7 @@ as well as widgets, buttons, overlays, and text properties." (if display (format "terminal code %s" display) "not encodable for terminal")))))) - ,@(let ((unicodedata (and unicode - (describe-char-unicode-data unicode)))) + ,@(let ((unicodedata (describe-char-unicode-data char))) (if unicodedata (cons (list "Unicode data" " ") unicodedata))))) (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) @@ -663,6 +584,24 @@ as well as widgets, buttons, overlays, and text properties." (insert "\nSee the variable `reference-point-alist' for " "the meaning of the rule.\n")) + (if (not describe-char-unidata-list) + (insert "\nCharacter code properties are not shown: ") + (insert "\nCharacter code properties: ")) + (widget-create 'link + :notify (lambda (&rest ignore) + (customize-variable + 'describe-char-unidata-list)) + "customize what to show") + (insert "\n") + (dolist (elt describe-char-unidata-list) + (let ((val (get-char-code-property char elt)) + description) + (when val + (setq description (char-code-property-description elt val)) + (if description + (insert (format " %s: %s (%s)\n" elt val description)) + (insert (format " %s: %s\n" elt val)))))) + (describe-text-properties pos (current-buffer)) (describe-text-mode))))) |