;;; descr-text.el --- describe text mode
-;; Copyright (c) 1994, 95, 96, 2001, 02, 03, 04 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
-;; Keywords: faces
+;; Keywords: faces, i18n, Unicode, multilingual
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(use-local-map describe-text-mode-map)
(widget-setup)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
- (run-hooks 'describe-text-mode-hook))
+ (run-mode-hooks 'describe-text-mode-hook))
;;; Describe-Text Utilities.
into widget buttons that call `describe-text-category' or
`describe-face' when pushed."
;; Sort the properties by the size of their value.
- (dolist (elt (sort (let ((ret nil)
- (key nil)
- (val nil)
- (len nil))
+ (dolist (elt (sort (let (ret)
(while properties
- (setq key (pop properties)
- val (pop properties)
- len 0)
- (unless (or (memq key '(category face font-lock-face
- syntax-table))
- (widgetp val))
- (setq val (pp-to-string val)
- len (length val)))
- (push (list key val len) ret))
+ (push (list (pop properties) (pop properties)) ret))
ret)
- (lambda (a b)
- (< (nth 2 a)
- (nth 2 b)))))
+ (lambda (a b) (string< (nth 0 a) (nth 0 b)))))
(let ((key (nth 0 elt))
(value (nth 1 elt)))
(widget-insert (propertize (format " %-20s " key)
:notify `(lambda (&rest ignore)
(describe-text-category ',value))
(format "%S" value)))
- ((memq key '(face font-lock-face))
+ ((memq key '(face font-lock-face mouse-face))
(widget-create 'link
:notify `(lambda (&rest ignore)
(describe-face ',value))
(format "%S" value)))
- ((eq key 'syntax-table)
- (widget-create 'push-button
- :tag "show"
- :action (lambda (widget &optional event)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (pp (widget-get widget :value))))
- value))
((widgetp value)
(describe-text-widget value))
(t
- (widget-insert value))))
+ (describe-text-sexp value))))
(widget-insert "\n")))
\f
;;; Describe-Text Commands.
(describe-text-properties-1 pos output-buffer)
(if (not (or (text-properties-at pos) (overlays-at pos)))
(message "This is plain text.")
- (let ((buffer (current-buffer)))
- (when (eq buffer (get-buffer "*Help*"))
- (error "Can't do self inspection"))
+ (let ((buffer (current-buffer))
+ (target-buffer "*Help*"))
+ (when (eq buffer (get-buffer target-buffer))
+ (setq target-buffer "*Help-2*"))
(save-excursion
- (with-output-to-temp-buffer "*Help*"
+ (with-output-to-temp-buffer target-buffer
(set-buffer standard-output)
(setq output-buffer (current-buffer))
(widget-insert "Text content at position " (format "%d" pos) ":\n\n")
(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
+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.
the time of writing it is at
<URL:http://www.unicode.org/Public/UNIDATA/UnicodeData.txt>."
:group 'mule
- :version "21.4"
+ :version "22.1"
:type '(choice (const :tag "None" nil)
file))
(format ", U+%04X" unicode)
"")))
("charset"
- ,(symbol-name charset)
+ ,`(widget-create 'link
+ :notify (lambda (&rest ignore)
+ (describe-character-set ',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)))))
+ `(widget-create
+ 'link
+ :notify (lambda (&rest ignore)
+ (list-charset-chars ',charset)
+ (with-selected-window
+ (get-buffer-window "*Character List*" 0)
+ (goto-char (point-min))
+ (forward-line 2) ;Skip the header.
+ (let ((case-fold-search nil))
+ (search-forward ,(char-to-string char)
+ nil t))))
+ ,(if (= (charset-dimension charset) 1)
+ (format "%d" (nth 1 split))
+ (format "%d %d" (nth 1 split) (nth 2 split))))))
("syntax"
,(let ((syntax (syntax-after pos)))
(with-temp-buffer
(push (format "%s;" (pop props)) ps))
(list (cons "Properties" (nreverse ps)))))
("to input"
- ,@(let ((key-list (and current-input-method
+ ,@(let ((key-list (and (eq input-method-function
+ 'quail-input-method)
(quail-find-key char))))
(if (consp key-list)
(list "type"
(mapconcat #'(lambda (x) (concat "\"" x "\""))
- key-list " or ")))))
+ key-list " or ")
+ "with"
+ `(widget-create
+ 'link
+ :notify (lambda (&rest ignore)
+ (describe-input-method
+ ',current-input-method))
+ ,(format "%s" current-input-method))))))
("buffer code"
,(encoded-string-description
(string-as-unibyte (char-to-string char)) nil))
(dotimes (i (length disp-vector))
(setq char (aref disp-vector i))
(aset disp-vector i
- (cons char (describe-char-display pos char))))
+ (cons char (describe-char-display
+ pos (logand char #x7ffff)))))
(format "by display table entry [%s] (see below)"
- (mapconcat #'(lambda (x) (format "?%c" (car x)))
- disp-vector " ")))
+ (mapconcat
+ #'(lambda (x)
+ (format "?%c" (logand (car x) #x7ffff)))
+ disp-vector " ")))
(composition
(let ((from (car composition))
(to (nth 1 composition))
(if display
(format "terminal code %s" display)
"not encodable for terminal"))))))
+ ,@(let ((face
+ (if (not (or disp-vector composition))
+ (cond
+ ((and show-trailing-whitespace
+ (save-excursion (goto-char pos)
+ (looking-at "[ \t]+$")))
+ 'trailing-whitespace)
+ ((and nobreak-char-display unicode (eq unicode '#xa0))
+ 'nobreak-space)
+ ((and nobreak-char-display unicode (eq unicode '#xad))
+ 'escape-glyph)
+ ((and (< char 32) (not (memq char '(9 10))))
+ 'escape-glyph)))))
+ (if face (list (list "hardcoded face"
+ `(widget-create
+ 'link
+ :notify (lambda (&rest ignore)
+ (describe-face ',face))
+ ,(format "%s" face))))))
,@(let ((unicodedata (and unicode
(describe-char-unicode-data unicode))))
(if unicodedata
(cons (list "Unicode data" " ") unicodedata)))))
- (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
+ (setq max-width (apply #'max (mapcar #'(lambda (x)
+ (if (cadr x) (length (car x)) 0))
item-list)))
(with-output-to-temp-buffer "*Help*"
(with-current-buffer standard-output
(when (cadr elt)
(insert (format formatter (car elt)))
(dolist (clm (cdr elt))
- (when (>= (+ (current-column)
- (or (string-match "\n" clm)
- (string-width clm)) 1)
- (window-width))
- (insert "\n")
- (indent-to (1+ max-width)))
- (insert " " clm))
+ (if (eq (car-safe clm) 'widget-create)
+ (progn (insert " ") (eval clm))
+ (when (>= (+ (current-column)
+ (or (string-match "\n" clm)
+ (string-width clm))
+ 1)
+ (window-width))
+ (insert "\n")
+ (indent-to (1+ max-width)))
+ (insert " " clm)))
(insert "\n"))))
(save-excursion
(progn
(insert "these fonts (glyph codes):\n")
(dotimes (i (length disp-vector))
- (insert (car (aref disp-vector i)) ?:
+ (insert (logand (car (aref disp-vector i)) #x7ffff) ?:
(propertize " " 'display '(space :align-to 5))
(if (cdr (aref disp-vector i))
(format "%s (0x%02X)" (cadr (aref disp-vector i))
(cddr (aref disp-vector i)))
"-- no font --")
- "\n ")))
+ "\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: ")
+ (widget-create 'link
+ :notify `(lambda (&rest ignore)
+ (describe-face ',face))
+ (format "%S" face))
+ (insert "\n"))))))
(insert "these terminal codes:\n")
(dotimes (i (length disp-vector))
(insert (car (aref disp-vector i))
(describe-text-mode)))))
(defalias 'describe-char-after 'describe-char)
-(make-obsolete 'describe-char-after 'describe-char "21.5")
+(make-obsolete 'describe-char-after 'describe-char "22.1")
(provide 'descr-text)
-;;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1
+;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1
;;; descr-text.el ends here