Commit 449c27f0 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Handle the [back] button properly (bug#4979).

* descr-text.el (describe-text-properties): Add a `buffer' argument.
Use help-setup-xref, help-buffer, and with-help-window.
(describe-char): Add `buffer' argument.
Pass proper command to help-setup-xref.  Don't meddle with
help-xref-stack-item directly.
(describe-text-category): Use with-help-window and help-buffer.
parent 32fe5377
2009-11-24 Stefan Monnier <monnier@iro.umontreal.ca>
Handle the [back] button properly (bug#4979).
* descr-text.el (describe-text-properties): Add a `buffer' argument.
Use help-setup-xref, help-buffer, and with-help-window.
(describe-char): Add `buffer' argument.
Pass proper command to help-setup-xref. Don't meddle with
help-xref-stack-item directly.
(describe-text-category): Use with-help-window and help-buffer.
* emacs-lisp/shadow.el (list-load-path-shadows): Setup a major mode
for the displayed buffer (bug#4887).
......
......@@ -103,39 +103,41 @@ into help buttons that call `describe-text-category' or
(interactive "SCategory: ")
(help-setup-xref (list #'describe-text-category category)
(called-interactively-p 'interactive))
(save-excursion
(with-output-to-temp-buffer "*Help*"
(set-buffer standard-output)
(with-help-window (help-buffer)
(with-current-buffer standard-output
(insert "Category " (format "%S" category) ":\n\n")
(describe-property-list (symbol-plist category))
(goto-char (point-min)))))
;;;###autoload
(defun describe-text-properties (pos &optional output-buffer)
"Describe widgets, buttons, overlays and text properties at POS.
(defun describe-text-properties (pos &optional output-buffer buffer)
"Describe widgets, buttons, overlays, and text properties at POS.
POS is taken to be in BUFFER or in current buffer if nil.
Interactively, describe them for the character after point.
If optional second argument OUTPUT-BUFFER is non-nil,
insert the output into that buffer, and don't initialize or clear it
otherwise."
(interactive "d")
(let ((src-buf (current-buffer)))
(if buffer (set-buffer buffer) (setq buffer (current-buffer)))
(if (>= pos (point-max))
(error "No character follows specified position"))
(if output-buffer
(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))
(target-buffer "*Help*"))
(when (eq buffer (get-buffer target-buffer))
(setq target-buffer "*Help*<2>"))
(save-excursion
(with-output-to-temp-buffer target-buffer
(set-buffer standard-output)
(with-temp-buffer
(setq output-buffer (current-buffer))
(insert "Text content at position " (format "%d" pos) ":\n\n")
(with-current-buffer buffer
(describe-text-properties-1 pos output-buffer))
(goto-char (point-min))))))))
(set-buffer buffer)
(describe-text-properties-1 pos output-buffer)
(set-buffer src-buf)
(help-setup-xref (list 'describe-text-properties pos nil buffer)
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
(buffer-swap-text output-buffer)
(goto-char (point-min)))))))))
(defun describe-text-properties-1 (pos output-buffer)
(let* ((properties (text-properties-at pos))
......@@ -373,19 +375,24 @@ This function is semi-obsolete. Use `get-char-code-property'."
mnemonics ", ")))))
;;;###autoload
(defun describe-char (pos)
(defun describe-char (pos &optional buffer)
"Describe the character after POS (interactively, the character after point).
Is POS is taken to be in buffer BUFFER or current buffer if nil.
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")
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
(let ((src-buf (current-buffer)))
(set-buffer buffer)
(if (>= pos (point-max))
(error "No character follows specified position"))
(let* ((char (char-after pos))
(eight-bit-p (and (not enable-multibyte-characters) (>= char 128)))
(charset (if eight-bit-p 'eight-bit
(or (get-text-property pos 'charset) (char-charset char))))
(or (get-text-property pos 'charset)
(char-charset char))))
(composition (find-composition pos nil nil t))
(component-chars nil)
(display-table (or (window-display-table)
......@@ -424,7 +431,6 @@ as well as widgets, buttons, overlays, and text properties."
(or (catch 'tag
(let ((from (car composition))
(to (nth 1 composition))
(next (1+ pos))
(components (nth 2 composition))
ch)
(if (and (vectorp components) (vectorp (aref components 0)))
......@@ -503,7 +509,8 @@ as well as widgets, buttons, overlays, and text properties."
,(format "(%s)" (charset-description charset)))
("code point"
,(let ((str (if (integerp code)
(format (if (< code 256) "0x%02X" "0x%04X") code)
(format (if (< code 256) "0x%02X" "0x%04X")
code)
(format "0x%04X%04X" (car code) (cdr code)))))
(if (<= (charset-dimension charset) 2)
`(insert-text-button
......@@ -515,8 +522,8 @@ as well as widgets, buttons, overlays, and text properties."
(goto-char (point-min))
(forward-line 2) ;Skip the header.
(let ((case-fold-search nil))
(if (search-forward ,(char-to-string char)
nil t)
(if (search-forward
,(char-to-string char) nil t)
(goto-char (match-beginning 0))))))
'follow-link t
'help-echo
......@@ -540,8 +547,10 @@ as well as widgets, buttons, overlays, and text properties."
(quail-find-key char))))
(if (consp key-list)
(list "type"
(mapconcat #'(lambda (x) (concat "\"" x "\""))
key-list " or ")
(concat "\""
(mapconcat 'identity
key-list "\" or \"")
"\"")
"with"
`(insert-text-button
,current-input-method
......@@ -558,7 +567,8 @@ as well as widgets, buttons, overlays, and text properties."
(encoded (encode-coding-char char coding charset)))
(if encoded
(list (encoded-string-description encoded coding)
(format "(encoded by coding system %S)" coding))
(format "(encoded by coding system %S)"
coding))
(list "not encodable by coding system"
(symbol-name coding))))
(list (format "#x%02X" char))))
......@@ -603,15 +613,18 @@ as well as widgets, buttons, overlays, and text properties."
(if face (list (list "hardcoded face"
`(insert-text-button
,(symbol-name face)
'type 'help-face 'help-args '(,face))))))
'type 'help-face
'help-args '(,face))))))
,@(if (not eight-bit-p)
(let ((unicodedata (describe-char-unicode-data char)))
(if unicodedata
(cons (list "Unicode data" " ") unicodedata))))))
(setq max-width (apply #'max (mapcar #'(lambda (x)
(setq max-width (apply 'max (mapcar (lambda (x)
(if (cadr x) (length (car x)) 0))
item-list)))
(help-setup-xref nil (called-interactively-p 'interactive))
(set-buffer src-buf)
(help-setup-xref (list 'describe-char pos buffer)
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
(set-buffer-multibyte multibyte-p)
......@@ -715,7 +728,8 @@ as well as widgets, buttons, overlays, and text properties."
(insert "\n "
(describe-char-padded-string (car elt))
?:
(propertize " " 'display '(space :align-to 5))
(propertize " "
'display '(space :align-to 5))
(or (cdr elt) "-- no font --")))))
(insert "these terminal codes:")
(dolist (elt component-chars)
......@@ -748,8 +762,7 @@ as well as widgets, buttons, overlays, and text properties."
(format " %s: %s\n" elt val)))))))
(if text-props-desc (insert text-props-desc))
(setq help-xref-stack-item (list 'help-insert-string (buffer-string)))
(toggle-read-only 1)))))
(toggle-read-only 1))))))
(define-obsolete-function-alias 'describe-char-after 'describe-char "22.1")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment