From 49c2a2dc4fb062822c9edf9187d73bd6c251e7b9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 14 May 2004 05:02:18 +0000 Subject: [PATCH] (describe-char-unicode-data, describe-char-unicodedata-file): Re-enable the unicode code now that the licensing issues have been cleared in the unicode-4 license. (describe-text-properties-1): Remove unused `overlay' var. (describe-char): Remove unused var `buffer'. --- lisp/descr-text.el | 425 ++++++++++++++++++++++----------------------- 1 file changed, 208 insertions(+), 217 deletions(-) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 61ddf928f7..75ce294dad 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -183,7 +183,6 @@ otherwise." (defun describe-text-properties-1 (pos output-buffer) (let* ((properties (text-properties-at pos)) (overlays (overlays-at pos)) - overlay (wid-field (get-char-property pos 'field)) (wid-button (get-char-property pos 'button)) (wid-doc (get-char-property pos 'widget-doc)) @@ -225,221 +224,214 @@ otherwise." (widget-insert "There are text properties here:\n") (describe-property-list properties))))) -;;; We cannot use the UnicodeData.txt file as such; it is not free. -;;; We can turn that info a different format and release the result -;;; as free data. When that is done, we could reinstate the code below. -;;; For the mean time, here is a dummy placeholder. -;;; -- rms -(defun describe-char-unicode-data (char) nil) - -;;; (defcustom describe-char-unicodedata-file nil -;;; "Location of Unicode data file. -;;; This is the UnicodeData.txt file from the Unicode consortium, used for -;;; diagnostics. If it is non-nil `describe-char-after' will print data -;;; looked up from it. This facility is mostly of use to people doing -;;; multilingual development. - -;;; This is a fairly large file, not typically present on GNU systems. At -;;; the time of writing it is at -;;; ." -;;; :group 'mule -;;; :version "21.5" -;;; :type '(choice (const :tag "None" nil) -;;; file)) - -;;; ;; We could convert the unidata file into a Lispy form once-for-all -;;; ;; and distribute it for loading on demand. It might be made more -;;; ;; space-efficient by splitting strings word-wise and replacing them -;;; ;; with lists of symbols interned in a private obarray, e.g. -;;; ;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A). - -;;; ;; Fixme: Check whether this needs updating for Unicode 4. -;;; (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'." -;;; (when describe-char-unicodedata-file -;;; (unless (file-exists-p describe-char-unicodedata-file) -;;; (error "`unicodedata-file' %s not found" describe-char-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 describe-char-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" describe-char-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)) -;;; ??))))))))))) +(defcustom describe-char-unicodedata-file nil + "Location of Unicode data file. +This is the UnicodeData.txt file from the Unicode consortium, used for +diagnostics. If it is non-nil `describe-char-after' will print data +looked up from it. This facility is mostly of use to people doing +multilingual development. + +This is a fairly large file, not typically present on GNU systems. At +the time of writing it is at +." + :group 'mule + :version "21.4" + :type '(choice (const :tag "None" nil) + file)) + +;; We could convert the unidata file into a Lispy form once-for-all +;; and distribute it for loading on demand. It might be made more +;; space-efficient by splitting strings word-wise and replacing them +;; with lists of symbols interned in a private obarray, e.g. +;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A). + +;; Fixme: Check whether this needs updating for Unicode 4. +(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'." + (when describe-char-unicodedata-file + (unless (file-exists-p describe-char-unicodedata-file) + (error "`unicodedata-file' %s not found" describe-char-unicodedata-file)) + (with-current-buffer + ;; 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. + (let ((auto-mode-alist)) + (find-file-noselect describe-char-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" describe-char-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)) + ??))))))))))) ;; Return information about how CHAR is displayed at the buffer ;; position POS. If the selected frame is on a graphic display, @@ -466,7 +458,6 @@ as well as widgets, buttons, overlays, and text properties." (error "No character follows specified position")) (let* ((char (char-after pos)) (charset (char-charset char)) - (buffer (current-buffer)) (composition (find-composition pos nil nil t)) (component-chars nil) (display-table (or (window-display-table) -- 2.20.1