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