Mercurial > hg > xemacs-beta

comparison lisp/descr-text.el @ 4480:74caf140505b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Wrap field descriptions, descr-text.el; name created buffer more uniquely. 2008-07-19 Aidan Kehoe <kehoea@parhasard.net> * descr-text.el (describe-property-list): Move the (require 'hyper-apropos) call to top level, this isn't the only function that uses the relevant face. (describe-char): Wrap the Unihan field descriptions if they are longer than the windows width minus 50. Rename the created buffer to reflect the character's position as well as its value.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 19 Jul 2008 15:19:59 +0200
parents 78738a40e31e
children f9c70d94f427
comparison
equal deleted inserted replaced
4479:4cb7c59b5201 4480:74caf140505b
29 ;;; Describe-Text Mode. 29 ;;; Describe-Text Mode.
30 30
31 ;;; Code: 31 ;;; Code:
32 32
33 (eval-when-compile (require 'wid-edit)) 33 (eval-when-compile (require 'wid-edit))
34
35 (require 'hyper-apropos)
34 36
35 ;;; Describe-Text Utilities. 37 ;;; Describe-Text Utilities.
36 38
37 (defun describe-text-widget (widget) 39 (defun describe-text-widget (widget)
38 "Insert text to describe WIDGET in the current buffer." 40 "Insert text to describe WIDGET in the current buffer."
80 PROPERTIES should be a list of overlay or text properties. 82 PROPERTIES should be a list of overlay or text properties.
81 The `category', `face' and `font-lock-face' properties are made 83 The `category', `face' and `font-lock-face' properties are made
82 into help buttons that call `describe-text-category' or 84 into help buttons that call `describe-text-category' or
83 `describe-face' when pushed." 85 `describe-face' when pushed."
84 ;; Sort the properties by the size of their value. 86 ;; Sort the properties by the size of their value.
85 (require 'hyper-apropos)
86 (dolist (elt (sort (let (ret) 87 (dolist (elt (sort (let (ret)
87 (while properties 88 (while properties
88 (push (list (pop properties) (pop properties)) ret)) 89 (push (list (pop properties) (pop properties)) ret))
89 ret) 90 ret)
90 (lambda (a b) (string< (prin1-to-string (nth 0 a) t) 91 (lambda (a b) (string< (prin1-to-string (nth 0 a) t)
1027 (unwind-protect 1028 (unwind-protect
1028 (progn 1029 (progn
1029 (describe-text-properties pos tmp-buf) 1030 (describe-text-properties pos tmp-buf)
1030 (with-current-buffer tmp-buf (buffer-string))) 1031 (with-current-buffer tmp-buf (buffer-string)))
1031 (kill-buffer tmp-buf)))) 1032 (kill-buffer tmp-buf))))
1032 item-list max-width unicode unicode-formatted unicode-error) 1033 item-list max-width unicode unicode-formatted unicode-error
1034 unicodedata (max-unicode-description-width (- (window-width) 50)))
1033 1035
1034 1036
1035 (setq unicode-error 1037 (setq unicode-error
1036 ;; XEmacs change, check does the character represent a Unicode 1038 ;; XEmacs change, check does the character represent a Unicode
1037 ;; error sequence. 1039 ;; error sequence.
1183 'escape-glyph))))) 1185 'escape-glyph)))))
1184 (if face (list (list "hardcoded face" 1186 (if face (list (list "hardcoded face"
1185 `(insert-gui-button 1187 `(insert-gui-button
1186 (make-gui-button 1188 (make-gui-button
1187 ,(symbol-name face))))))) 1189 ,(symbol-name face)))))))
1188 ,@(let ((unicodedata (and unicode 1190 ,@(progn
1189 (describe-char-unicode-data unicode)))) 1191 (setq unicodedata (and unicode
1192 (describe-char-unicode-data unicode)))
1190 (if unicodedata 1193 (if unicodedata
1191 (cons (list "Unicode data" " ") unicodedata))))) 1194 (cons (list "Unicode data" " ") unicodedata)))))
1192 (setq max-width (apply #'max (mapcar #'(lambda (x) 1195 (setq max-width (apply #'max (mapcar #'(lambda (x)
1193 (if (cadr x) (length (car x)) 0)) 1196 (if (cadr x) (length (car x)) 0))
1194 item-list))) 1197 item-list)))
1198 (when (and unicodedata (> max-width max-unicode-description-width))
1199 (setq max-width max-unicode-description-width)
1200 (with-temp-buffer
1201 (let ((fill-column max-unicode-description-width)
1202 (indent-tabs-mode nil))
1203 (dolist (unidata-line unicodedata)
1204 (when (cadr unidata-line)
1205 (setf (car unidata-line)
1206 (progn (insert (car unidata-line))
1207 (goto-char (point-min))
1208 (fill-paragraph 'right)
1209 (delete-region (1- (point-max))
1210 (point-max))
1211 (buffer-string)))
1212 (delete-region (point-min) (point-max)))))))
1195 ; (help-setup-xref nil (interactive-p)) 1213 ; (help-setup-xref nil (interactive-p))
1196 (with-displaying-help-buffer 1214 (with-displaying-help-buffer
1197 (lambda () 1215 (lambda ()
1198 (with-current-buffer standard-output 1216 (with-current-buffer standard-output
1199 ; (set-buffer-multibyte multibyte-p) 1217 ; (set-buffer-multibyte multibyte-p)
1272 1290
1273 (if text-props-desc (insert text-props-desc)) 1291 (if text-props-desc (insert text-props-desc))
1274 ; (setq help-xref-stack-item (list 'help-insert-string (buffer-string))) 1292 ; (setq help-xref-stack-item (list 'help-insert-string (buffer-string)))
1275 (toggle-read-only 1) 1293 (toggle-read-only 1)
1276 (print-help-return-message))) 1294 (print-help-return-message)))
1277 (format "Describe %c" (char-after pos))))) 1295 (format "Describe %c <%d>" (char-after pos) pos))))
1278 1296
1279 (defalias 'describe-char-after 'describe-char) 1297 (defalias 'describe-char-after 'describe-char)
1280 (make-obsolete 'describe-char-after 'describe-char "22.1") 1298 (make-obsolete 'describe-char-after 'describe-char "22.1")
1281 1299
1282 (provide 'descr-text) 1300 (provide 'descr-text)