;;; descr-text.el --- describe text mode
;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
+;; Maintainer: FSF
;; Keywords: faces, i18n, Unicode, multilingual
;; This file is part of GNU Emacs.
;;; Code:
-(eval-when-compile (require 'button) (require 'quail))
-
-(defun describe-text-done ()
- "Delete the current window or bury the current buffer."
- (interactive)
- (if (> (count-windows) 1)
- (delete-window)
- (bury-buffer)))
-
-(defvar describe-text-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- map)
- "Keymap for `describe-text-mode'.")
-
-(defcustom describe-text-mode-hook nil
- "List of hook functions ran by `describe-text-mode'."
- :type 'hook
- :group 'facemenu)
-
-(defun describe-text-mode ()
- "Major mode for buffers created by `describe-char'.
-
-\\{describe-text-mode-map}
-Entry to this mode calls the value of `describe-text-mode-hook'
-if that value is non-nil."
- (kill-all-local-variables)
- (setq major-mode 'describe-text-mode
- mode-name "Describe-Text")
- (use-local-map describe-text-mode-map)
- (widget-setup)
- (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
- (run-mode-hooks 'describe-text-mode-hook))
+(eval-when-compile (require 'quail))
+(require 'help-fns)
;;; Describe-Text Utilities.
(defun describe-text-widget (widget)
"Insert text to describe WIDGET in the current buffer."
- (widget-create 'link
- :notify `(lambda (&rest ignore)
- (widget-browse ',widget))
- (format "%S" (if (symbolp widget)
- widget
- (car widget))))
- (widget-insert " ")
- (widget-create 'info-link :tag "widget" "(widget)Top"))
+ (insert-text-button
+ (symbol-name (if (symbolp widget) widget (car widget)))
+ 'action `(lambda (&rest ignore)
+ (widget-browse ',widget))
+ 'help-echo "mouse-2, RET: browse this widget")
+ (insert " ")
+ (insert-text-button
+ "(widget)Top" 'type 'help-info 'help-args '("(widget)Top")))
(defun describe-text-sexp (sexp)
"Insert a short description of SEXP in the current buffer."
((> (length pp) (- (window-width) (current-column)))
nil)
(t t))
- (widget-insert pp)
- (widget-create 'push-button
- :tag "show"
- :action (lambda (widget &optional event)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ (widget-get widget :value))))
- pp))))
+ (insert pp)
+ (insert-text-button
+ "[Show]" 'action `(lambda (&rest ignore)
+ (with-output-to-temp-buffer
+ "*Pp Eval Output*"
+ (princ ',pp)))
+ 'help-echo "mouse-2, RET: pretty print value in another buffer"))))
(defun describe-property-list (properties)
"Insert a description of PROPERTIES in the current buffer.
PROPERTIES should be a list of overlay or text properties.
The `category', `face' and `font-lock-face' properties are made
-into widget buttons that call `describe-text-category' or
+into help 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)
(prin1-to-string (nth 0 b) t)))))
(let ((key (nth 0 elt))
(value (nth 1 elt)))
- (widget-insert (propertize (format " %-20s " key)
- 'font-lock-face 'italic))
+ (insert (propertize (format " %-20s " key)
+ 'face 'help-argument-name))
(cond ((eq key 'category)
- (widget-create 'link
- :notify `(lambda (&rest ignore)
- (describe-text-category ',value))
- (format "%S" value)))
+ (insert-text-button
+ (symbol-name value)
+ 'action `(lambda (&rest ignore)
+ (describe-text-category ',value))
+ 'help-echo "mouse-2, RET: describe this category"))
((memq key '(face font-lock-face mouse-face))
- (widget-create 'link
- :notify `(lambda (&rest ignore)
- (describe-face ',value))
- (format "%S" value)))
+ (insert-text-button
+ (format "%S" value)
+ 'type 'help-face 'help-args (list value)))
((widgetp value)
(describe-text-widget value))
(t
(describe-text-sexp value))))
- (widget-insert "\n")))
+ (insert "\n")))
\f
;;; Describe-Text Commands.
(defun describe-text-category (category)
"Describe a text property category."
- (interactive "S")
+ (interactive "SCategory: ")
+ (help-setup-xref (list #'describe-text-category category) (interactive-p))
(save-excursion
(with-output-to-temp-buffer "*Help*"
(set-buffer standard-output)
- (widget-insert "Category " (format "%S" category) ":\n\n")
+ (insert "Category " (format "%S" category) ":\n\n")
(describe-property-list (symbol-plist category))
- (describe-text-mode)
(goto-char (point-min)))))
;;;###autoload
(let ((buffer (current-buffer))
(target-buffer "*Help*"))
(when (eq buffer (get-buffer target-buffer))
- (setq target-buffer "*Help-2*"))
+ (setq target-buffer "*Help*<2>"))
(save-excursion
(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")
+ (insert "Text content at position " (format "%d" pos) ":\n\n")
(with-current-buffer buffer
(describe-text-properties-1 pos output-buffer))
- (describe-text-mode)
(goto-char (point-min))))))))
(defun describe-text-properties-1 (pos output-buffer)
;; Widgets
(when (widgetp widget)
(newline)
- (widget-insert (cond (wid-field "This is an editable text area")
- (wid-button "This is an active area")
- (wid-doc "This is documentation text")))
- (widget-insert " of a ")
+ (insert (cond (wid-field "This is an editable text area")
+ (wid-button "This is an active area")
+ (wid-doc "This is documentation text")))
+ (insert " of a ")
(describe-text-widget widget)
- (widget-insert ".\n\n"))
+ (insert ".\n\n"))
;; Buttons
(when (and button (not (widgetp wid-button)))
(newline)
- (widget-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)
(if (eq (length overlays) 1)
- (widget-insert "There is an overlay here:\n")
- (widget-insert "There are " (format "%d" (length overlays))
+ (insert "There is an overlay here:\n")
+ (insert "There are " (format "%d" (length overlays))
" overlays here:\n"))
(dolist (overlay overlays)
- (widget-insert " From " (format "%d" (overlay-start overlay))
+ (insert " From " (format "%d" (overlay-start overlay))
" to " (format "%d" (overlay-end overlay)) "\n")
(describe-property-list (overlay-properties overlay)))
- (widget-insert "\n"))
+ (insert "\n"))
;; Text properties
(when properties
(newline)
- (widget-insert "There are text properties here:\n")
+ (insert "There are text properties here:\n")
(describe-property-list properties)))))
\f
(defcustom describe-char-unicodedata-file nil
multilingual development.
This is a fairly large file, not typically present on GNU systems. At
-the time of writing it is at
-<URL:http://www.unicode.org/Public/UNIDATA/UnicodeData.txt>."
+the time of writing it is at the URL
+`http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'."
:group 'mule
:version "22.1"
:type '(choice (const :tag "None" nil)
(multibyte-p enable-multibyte-characters)
(overlays (mapcar #'(lambda (o) (overlay-properties o))
(overlays-at pos)))
+ (char-description (if (not multibyte-p)
+ (single-key-description char)
+ (if (< char 128)
+ (single-key-description char)
+ (string-to-multibyte
+ (char-to-string char)))))
+ (text-props-desc
+ (let ((tmp-buf (generate-new-buffer " *text-props*")))
+ (unwind-protect
+ (progn
+ (describe-text-properties pos tmp-buf)
+ (with-current-buffer tmp-buf (buffer-string)))
+ (kill-buffer tmp-buf))))
item-list max-width unicode)
(if (or (< char 256)
(encode-char char 'ucs))))
(setq item-list
`(("character"
- ,(format "%s (0%o, %d, 0x%x%s)"
- (apply 'propertize (if (not multibyte-p)
- (single-key-description char)
- (if (< char 128)
- (single-key-description char)
- (string-to-multibyte
- (char-to-string char))))
- (text-properties-at pos))
- char char char
- (if unicode
- (format ", U+%04X" unicode)
- "")))
+ ,(format "%s (%d, #o%o, #x%x%s)"
+ (apply 'propertize char-description
+ (text-properties-at pos))
+ char char char
+ (if unicode
+ (format ", U+%04X" unicode)
+ "")))
("charset"
- ,`(widget-create 'link
- :notify (lambda (&rest ignore)
- (describe-character-set ',charset))
- ,(symbol-name charset))
+ ,`(insert-text-button
+ ,(symbol-name charset)
+ 'type 'help-character-set 'help-args '(,charset))
,(format "(%s)" (charset-description charset)))
("code point"
,(let ((split (split-char char)))
- `(widget-create
- 'link
- :notify (lambda (&rest ignore)
+ `(insert-text-button
+ ,(if (= (charset-dimension charset) 1)
+ (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)
(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))))))
+ (forward-line 2) ;Skip the header.
+ (let ((case-fold-search nil))
+ (search-forward ,(char-to-string char)
+ nil t))))
+ 'help-echo
+ "mouse-2, RET: show this character in its character set")))
("syntax"
,(let ((syntax (syntax-after pos)))
(with-temp-buffer
,@(let ((category-set (char-category-set char)))
(if (not category-set)
'("-- none --")
- (mapcar #'(lambda (x) (format "%c:%s "
+ (mapcar #'(lambda (x) (format "%c:%s"
x (category-docstring x)))
(category-set-mnemonics category-set)))))
,@(let ((props (aref char-code-property-table char))
(mapconcat #'(lambda (x) (concat "\"" x "\""))
key-list " or ")
"with"
- `(widget-create
- 'link
- :notify (lambda (&rest ignore)
- (describe-input-method
- ',current-input-method))
- ,(format "%s" current-input-method))))))
+ `(insert-text-button
+ ,current-input-method
+ 'type 'help-input-method
+ 'help-args '(,current-input-method))))))
("buffer code"
,(encoded-string-description
(string-as-unibyte (char-to-string char)) nil))
(if display
(concat
"by this font (glyph code)\n"
- (format " %s (0x%02X)"
+ (format " %s (#x%02X)"
(car display) (cdr display)))
"no font available")
(if display
((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))))))
+ `(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)))
- (with-output-to-temp-buffer "*Help*"
+ (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)))
(when (cadr elt)
(insert (format formatter (car elt)))
(dolist (clm (cdr elt))
- (if (eq (car-safe clm) 'widget-create)
+ (if (eq (car-safe clm) 'insert-text-button)
(progn (insert " ") (eval clm))
(when (>= (+ (current-column)
(or (string-match "\n" clm)
(insert " " clm)))
(insert "\n"))))
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "character:[ \t\n]+")
- (setq pos (point)))
- (if overlays
- (mapc #'(lambda (props)
- (let ((o (make-overlay pos (1+ pos))))
- (while props
- (overlay-put o (car props) (nth 1 props))
- (setq props (cddr props)))))
- overlays))
+ (when overlays
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "character:[ \t\n]+")
+ (let* ((end (+ (point) (length char-description))))
+ (mapc #'(lambda (props)
+ (let ((o (make-overlay (point) end)))
+ (while props
+ (overlay-put o (car props) (nth 1 props))
+ (setq props (cddr props)))))
+ overlays))))
(when disp-vector
(insert
(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))
+ (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))))))
+ (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 (concat "`" (symbol-name face) "'"))
(insert "\n"))))))
(insert "these terminal codes:\n")
(dotimes (i (length disp-vector))
(insert "\n " (car elt) ?:
(propertize " " 'display '(space :align-to 5))
(if (cdr elt)
- (format "%s (0x%02X)" (cadr elt) (cddr elt))
+ (format "%s (#x%02X)" (cadr elt) (cddr elt))
"-- no font --"))))
(insert "these terminal codes:")
(dolist (elt component-chars)
(insert "\nSee the variable `reference-point-alist' for "
"the meaning of the rule.\n"))
- (describe-text-properties pos (current-buffer))
- (describe-text-mode)))))
+ (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)))))
(defalias 'describe-char-after 'describe-char)
(make-obsolete 'describe-char-after 'describe-char "22.1")