;;; descr-text.el --- describe text mode
;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Maintainer: FSF
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(t t))
(insert pp)
(insert-text-button
- "show" 'action `(lambda (&rest ignore)
+ "[Show]" 'action `(lambda (&rest ignore)
(with-output-to-temp-buffer
"*Pp Eval Output*"
(princ ',pp)))
(describe-text-category ',value))
'help-echo "mouse-2, RET: describe this category"))
((memq key '(face font-lock-face mouse-face))
- (insert (concat "`" (format "%S" value) "'")))
+ (insert-text-button
+ (format "%S" value)
+ 'type 'help-face 'help-args (list value)))
((widgetp value)
(describe-text-widget value))
(t
;; Buttons
(when (and button (not (widgetp wid-button)))
(newline)
- (insert "Here is a " (format "%S" button-type)
- " button labeled `" button-label "'.\n\n"))
+ (insert "Here is a `" (format "%S" button-type)
+ "' button labeled `" button-label "'.\n\n"))
;; Overlays
(when overlays
(newline)
\f
(defcustom describe-char-unicodedata-file nil
"Location of Unicode data file.
-This is the UnicodeData.txt file from the Unicode consortium, used for
+This is the UnicodeData.txt file from the Unicode Consortium, used for
diagnostics. If it is non-nil `describe-char' 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 the URL
+This is a fairly large file, not typically present on GNU systems.
+At the time of writing it is at the URL
`http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'."
:group 'mule
:version "22.1"
(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))
+ (with-current-buffer (get-buffer-create " *Unicode Data*")
+ (when (zerop (buffer-size))
+ ;; Don't use -literally in case of DOS line endings.
+ (insert-file-contents describe-char-unicodedata-file))
(goto-char (point-min))
(let ((hex (format "%04X" char))
found first last)
\f
;;;###autoload
-(defun describe-char (pos &optional buf)
+(defun describe-char (pos)
"Describe the character after POS (interactively, the character after point).
The information includes character code, charset and code points in it,
syntax, category, how the character is encoded in a file,
character composition information (if relevant),
as well as widgets, buttons, overlays, and text properties."
(interactive "d")
- (let ((help-buffer (help-buffer)))
- (with-current-buffer (if buf buf (current-buffer))
(if (>= pos (point-max))
(error "No character follows specified position"))
(let* ((char (char-after pos))
,(let ((split (split-char char)))
`(insert-text-button
,(if (= (charset-dimension charset) 1)
- (format "%d" (nth 1 split))
- (format "%d %d" (nth 1 split)
+ (format "#x%02X" (nth 1 split))
+ (format "#x%02X #x%02X" (nth 1 split)
(nth 2 split)))
'action (lambda (&rest ignore)
(list-charset-chars ',charset)
key-list " or ")
"with"
`(insert-text-button
- ,(symbol-name current-input-method)
+ ,current-input-method
'type 'help-input-method
'help-args '(,current-input-method))))))
("buffer code"
(setq char (aref disp-vector i))
(aset disp-vector i
(cons char (describe-char-display
- pos (logand char #x7ffff)))))
+ pos (glyph-char char)))))
(format "by display table entry [%s] (see below)"
(mapconcat
#'(lambda (x)
- (format "?%c" (logand (car x) #x7ffff)))
+ (format "?%c" (glyph-char (car x))))
disp-vector " ")))
(composition
(let ((from (car composition))
((and (< char 32) (not (memq char '(9 10))))
'escape-glyph)))))
(if face (list (list "hardcoded face"
- (concat "`" (symbol-name face) "'")))))
+ `(insert-text-button
+ ,(symbol-name face)
+ 'type 'help-face 'help-args '(,face))))))
,@(let ((unicodedata (and unicode
(describe-char-unicode-data unicode))))
(if unicodedata
(setq max-width (apply #'max (mapcar #'(lambda (x)
(if (cadr x) (length (car x)) 0))
item-list)))
- (help-setup-xref
- (list #'describe-char pos (if buf buf (current-buffer)))
- (interactive-p))
- (with-output-to-temp-buffer help-buffer
+ (help-setup-xref nil (interactive-p))
+ (with-output-to-temp-buffer (help-buffer)
(with-current-buffer standard-output
(set-buffer-multibyte multibyte-p)
(let ((formatter (format "%%%ds:" max-width)))
(progn
(insert "these fonts (glyph codes):\n")
(dotimes (i (length disp-vector))
- (insert (logand (car (aref disp-vector i)) #x7ffff) ?:
+ (insert (glyph-char (car (aref disp-vector i))) ?:
(propertize " " 'display '(space :align-to 5))
(if (cdr (aref disp-vector i))
(format "%s (#x%02X)" (cadr (aref disp-vector i))
(cddr (aref disp-vector i)))
"-- no font --")
"\n")
- (when (> (car (aref disp-vector i)) #x7ffff)
- (let* ((face-id (lsh (car (aref disp-vector i)) -19))
- (face (car (delq nil (mapcar
- (lambda (face)
- (and (eq (face-id face)
- face-id) face))
- (face-list))))))
- (when face
- (insert (propertize " " 'display '(space :align-to 5))
- "face: ")
- (insert (concat "`" (symbol-name face) "'"))
- (insert "\n"))))))
+ (let ((face (glyph-face (car (aref disp-vector i)))))
+ (when face
+ (insert (propertize " " 'display '(space :align-to 5))
+ "face: ")
+ (insert (concat "`" (symbol-name face) "'"))
+ (insert "\n")))))
(insert "these terminal codes:\n")
(dotimes (i (length disp-vector))
(insert (car (aref disp-vector i))
"the meaning of the rule.\n"))
(if text-props-desc (insert text-props-desc))
+ (setq help-xref-stack-item (list 'help-insert-string (buffer-string)))
(toggle-read-only 1)
- (print-help-return-message)))))))
+ (print-help-return-message)))))
(defalias 'describe-char-after 'describe-char)
(make-obsolete 'describe-char-after 'describe-char "22.1")