Show
Ignore:
Timestamp:
01/28/06 09:46:44 (3 years ago)
Author:
miyoshi
Message:

Update.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • vendor/emacs-CVS_HEAD/lisp/descr-text.el

    r3988 r4018  
    55 
    66;; Author: Boris Goldowsky <boris@gnu.org> 
     7;; Maintainer: FSF 
    78;; Keywords: faces, i18n, Unicode, multilingual 
    89 
    …… 
    3031;;; Code: 
    3132 
    32 (eval-when-compile (require 'button) (require 'quail)) 
    33  
    34 (defun describe-text-done () 
    35   "Delete the current window or bury the current buffer." 
    36   (interactive) 
    37   (if (> (count-windows) 1) 
    38       (delete-window) 
    39     (bury-buffer))) 
    40  
    41 (defvar describe-text-mode-map 
    42   (let ((map (make-sparse-keymap))) 
    43     (set-keymap-parent map widget-keymap) 
    44     map) 
    45   "Keymap for `describe-text-mode'.") 
    46  
    47 (defcustom describe-text-mode-hook nil 
    48   "List of hook functions ran by `describe-text-mode'." 
    49   :type 'hook 
    50   :group 'facemenu) 
    51  
    52 (defun describe-text-mode () 
    53   "Major mode for buffers created by `describe-char'. 
    54  
    55 \\{describe-text-mode-map} 
    56 Entry to this mode calls the value of `describe-text-mode-hook' 
    57 if that value is non-nil." 
    58   (kill-all-local-variables) 
    59   (setq major-mode 'describe-text-mode 
    60         mode-name "Describe-Text") 
    61   (use-local-map describe-text-mode-map) 
    62   (widget-setup) 
    63   (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) 
    64   (run-mode-hooks 'describe-text-mode-hook)) 
     33(eval-when-compile (require 'quail)) 
     34(require 'help-fns) 
    6535 
    6636;;; Describe-Text Utilities. 
    …… 
    6838(defun describe-text-widget (widget) 
    6939  "Insert text to describe WIDGET in the current buffer." 
    70   (widget-create 'link 
    71                 :notify `(lambda (&rest ignore) 
    72                            (widget-browse ',widget)) 
    73                 (format "%S" (if (symbolp widget) 
    74                                   widget 
    75                                (car widget)))) 
    76   (widget-insert " ") 
    77   (widget-create 'info-link :tag "widget" "(widget)Top")) 
     40  (insert-text-button 
     41   (symbol-name (if (symbolp widget) widget (car widget))) 
     42   'action `(lambda (&rest ignore) 
     43              (widget-browse ',widget)) 
     44   'help-echo "mouse-2, RET: browse this widget") 
     45  (insert " ") 
     46  (insert-text-button 
     47  "(widget)Top" 'type 'help-info 'help-args '("(widget)Top"))) 
    7848 
    7949(defun describe-text-sexp (sexp) 
    …… 
    8959               nil) 
    9060              (t t)) 
    91         (widget-insert pp) 
    92       (widget-create 'push-button 
    93                      :tag "show" 
    94                      :action (lambda (widget &optional event) 
    95                                (with-output-to-temp-buffer 
    96                                    "*Pp Eval Output*" 
    97                                  (princ (widget-get widget :value)))) 
    98                      pp)))) 
     61        (insert pp) 
     62      (insert-text-button 
     63       "[Show]" 'action `(lambda (&rest ignore) 
     64                        (with-output-to-temp-buffer 
     65                            "*Pp Eval Output*" 
     66                          (princ ',pp))) 
     67       'help-echo "mouse-2, RET: pretty print value in another buffer")))) 
    9968 
    10069(defun describe-property-list (properties) 
    …… 
    10271PROPERTIES should be a list of overlay or text properties. 
    10372The `category', `face' and `font-lock-face' properties are made 
    104 into widget buttons that call `describe-text-category' or 
     73into help buttons that call `describe-text-category' or 
    10574`describe-face' when pushed." 
    10675  ;; Sort the properties by the size of their value. 
    …… 
    11382    (let ((key (nth 0 elt)) 
    11483          (value (nth 1 elt))) 
    115       (widget-insert (propertize (format "  %-20s " key) 
    116                                 'font-lock-face 'italic)) 
     84      (insert (propertize (format "  %-20s " key) 
     85                          'face 'help-argument-name)) 
    11786      (cond ((eq key 'category) 
    118              (widget-create 'link 
    119                             :notify `(lambda (&rest ignore) 
    120                                        (describe-text-category ',value)) 
    121                             (format "%S" value))) 
     87             (insert-text-button 
     88              (symbol-name value) 
     89              'action `(lambda (&rest ignore) 
     90                         (describe-text-category ',value)) 
     91              'help-echo "mouse-2, RET: describe this category")) 
    12292            ((memq key '(face font-lock-face mouse-face)) 
    123              (widget-create 'link 
    124                             :notify `(lambda (&rest ignore) 
    125                                        (describe-face ',value)) 
    126                             (format "%S" value))) 
     93             (insert-text-button 
     94              (format "%S" value) 
     95              'type 'help-face 'help-args (list value))) 
    12796            ((widgetp value) 
    12897             (describe-text-widget value)) 
    12998            (t 
    13099             (describe-text-sexp value)))) 
    131     (widget-insert "\n"))) 
     100    (insert "\n"))) 
    132101  
    133102;;; Describe-Text Commands. 
    …… 
    135104(defun describe-text-category (category) 
    136105  "Describe a text property category." 
    137   (interactive "S") 
     106  (interactive "SCategory: ") 
     107  (help-setup-xref (list #'describe-text-category category) (interactive-p)) 
    138108  (save-excursion 
    139109    (with-output-to-temp-buffer "*Help*" 
    140110      (set-buffer standard-output) 
    141       (widget-insert "Category " (format "%S" category) ":\n\n") 
     111      (insert "Category " (format "%S" category) ":\n\n") 
    142112      (describe-property-list (symbol-plist category)) 
    143       (describe-text-mode) 
    144113      (goto-char (point-min))))) 
    145114 
    …… 
    161130            (target-buffer "*Help*")) 
    162131        (when (eq buffer (get-buffer target-buffer)) 
    163           (setq target-buffer "*Help-2*")) 
     132          (setq target-buffer "*Help*<2>")) 
    164133        (save-excursion 
    165134          (with-output-to-temp-buffer target-buffer 
    166135            (set-buffer standard-output) 
    167136            (setq output-buffer (current-buffer)) 
    168             (widget-insert "Text content at position " (format "%d" pos) ":\n\n") 
     137            (insert "Text content at position " (format "%d" pos) ":\n\n") 
    169138            (with-current-buffer buffer 
    170139              (describe-text-properties-1 pos output-buffer)) 
    171             (describe-text-mode) 
    172140            (goto-char (point-min)))))))) 
    173141 
    …… 
    187155      (when (widgetp widget) 
    188156        (newline) 
    189         (widget-insert (cond (wid-field "This is an editable text area") 
    190                             (wid-button "This is an active area") 
    191                             (wid-doc "This is documentation text"))) 
    192         (widget-insert " of a ") 
     157        (insert (cond (wid-field "This is an editable text area") 
     158                     (wid-button "This is an active area") 
     159                     (wid-doc "This is documentation text"))) 
     160        (insert " of a ") 
    193161        (describe-text-widget widget) 
    194         (widget-insert ".\n\n")) 
     162        (insert ".\n\n")) 
    195163      ;; Buttons 
    196164      (when (and button (not (widgetp wid-button))) 
    197165        (newline) 
    198         (widget-insert "Here is a " (format "%S" button-type) 
    199                        " button labeled `" button-label "'.\n\n")) 
     166        (insert "Here is a `" (format "%S" button-type) 
     167                "' button labeled `" button-label "'.\n\n")) 
    200168      ;; Overlays 
    201169      (when overlays 
    202170        (newline) 
    203171        (if (eq (length overlays) 1) 
    204             (widget-insert "There is an overlay here:\n") 
    205           (widget-insert "There are " (format "%d" (length overlays)) 
     172            (insert "There is an overlay here:\n") 
     173          (insert "There are " (format "%d" (length overlays)) 
    206174                         " overlays here:\n")) 
    207175        (dolist (overlay overlays) 
    208           (widget-insert " From " (format "%d" (overlay-start overlay)) 
     176          (insert " From " (format "%d" (overlay-start overlay)) 
    209177                         " to " (format "%d" (overlay-end overlay)) "\n") 
    210178          (describe-property-list (overlay-properties overlay))) 
    211         (widget-insert "\n")) 
     179        (insert "\n")) 
    212180      ;; Text properties 
    213181      (when properties 
    214182        (newline) 
    215         (widget-insert "There are text properties here:\n") 
     183        (insert "There are text properties here:\n") 
    216184        (describe-property-list properties))))) 
    217185  
    …… 
    224192 
    225193This is a fairly large file, not typically present on GNU systems.  At 
    226 the time of writing it is at 
    227 <URL:http://www.unicode.org/Public/UNIDATA/UnicodeData.txt>." 
     194the time of writing it is at the URL 
     195`http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'." 
    228196  :group 'mule 
    229197  :version "22.1" 
    …… 
    465433                               (string-to-multibyte 
    466434                                (char-to-string char))))) 
     435         (text-props-desc 
     436          (let ((tmp-buf (generate-new-buffer " *text-props*"))) 
     437            (unwind-protect 
     438                (progn 
     439                  (describe-text-properties pos tmp-buf) 
     440                  (with-current-buffer tmp-buf (buffer-string))) 
     441              (kill-buffer tmp-buf)))) 
    467442         item-list max-width unicode) 
    468443 
    …… 
    474449    (setq item-list 
    475450          `(("character" 
    476             ,(format "%s (%d, #o%o, #x%x%s)" 
    477                      (apply 'propertize char-description 
    478                             (text-properties-at pos)) 
    479                      char char char 
    480                      (if unicode 
    481                          (format ", U+%04X" unicode) 
    482                        ""))) 
     451            ,(format "%s (%d, #o%o, #x%x%s)" 
     452                      (apply 'propertize char-description 
     453                            (text-properties-at pos)) 
     454                      char char char 
     455                      (if unicode 
     456                          (format ", U+%04X" unicode) 
     457                       ""))) 
    483458            ("charset" 
    484              ,`(widget-create 'link 
    485                               :notify (lambda (&rest ignore) 
    486                                         (describe-character-set ',charset)) 
    487                               ,(symbol-name charset)) 
     459             ,`(insert-text-button 
     460                ,(symbol-name charset) 
     461                'type 'help-character-set 'help-args '(,charset)) 
    488462             ,(format "(%s)" (charset-description charset))) 
    489463            ("code point" 
    490464             ,(let ((split (split-char char))) 
    491                 `(widget-create 
    492                   'link 
    493                   :notify (lambda (&rest ignore) 
     465                `(insert-text-button 
     466                  ,(if (= (charset-dimension charset) 1) 
     467                       (format "#x%02X" (nth 1 split)) 
     468                     (format "#x%02X #x%02X" (nth 1 split) 
     469                             (nth 2 split))) 
     470                  'action (lambda (&rest ignore) 
    494471                            (list-charset-chars ',charset) 
    495472                            (with-selected-window 
    496473                                (get-buffer-window "*Character List*" 0) 
    497474                              (goto-char (point-min)) 
    498                               (forward-line 2) ;Skip the header. 
    499                               (let ((case-fold-search nil)) 
    500                                 (search-forward ,(char-to-string char) 
    501                                                 nil t)))) 
    502                   ,(if (= (charset-dimension charset) 1) 
    503                        (format "%d" (nth 1 split)) 
    504                      (format "%d %d" (nth 1 split) (nth 2 split)))))) 
     475                              (forward-line 2) ;Skip the header. 
     476                              (let ((case-fold-search nil)) 
     477                                (search-forward ,(char-to-string char) 
     478                                                nil t)))) 
     479                  'help-echo 
     480                  "mouse-2, RET: show this character in its character set"))) 
    505481            ("syntax" 
    506482             ,(let ((syntax (syntax-after pos))) 
    …… 
    531507                                      key-list " or ") 
    532508                           "with" 
    533                            `(widget-create 
    534                              'link 
    535                              :notify (lambda (&rest ignore) 
    536                                        (describe-input-method 
    537                                         ',current-input-method)) 
    538                              ,(format "%s" current-input-method)))))) 
     509                           `(insert-text-button 
     510                             ,current-input-method 
     511                             'type 'help-input-method 
     512                             'help-args '(,current-input-method)))))) 
    539513            ("buffer code" 
    540514             ,(encoded-string-description 
    …… 
    605579                           'escape-glyph))))) 
    606580                (if face (list (list "hardcoded face" 
    607                                      `(widget-create 
    608                                        'link 
    609                                        :notify (lambda (&rest ignore) 
    610                                                  (describe-face ',face)) 
    611                                        ,(format "%s" face)))))) 
     581                                     `(insert-text-button 
     582                                       ,(symbol-name face) 
     583                                       'type 'help-face 'help-args '(,face)))))) 
    612584            ,@(let ((unicodedata (and unicode 
    613585                                      (describe-char-unicode-data unicode)))) 
    …… 
    617589                                             (if (cadr x) (length (car x)) 0)) 
    618590                                         item-list))) 
    619     (with-output-to-temp-buffer "*Help*" 
     591    (help-setup-xref nil (interactive-p)) 
     592    (with-output-to-temp-buffer (help-buffer) 
    620593      (with-current-buffer standard-output 
    621594        (set-buffer-multibyte multibyte-p) 
    …… 
    625598              (insert (format formatter (car elt))) 
    626599              (dolist (clm (cdr elt)) 
    627                 (if (eq (car-safe clm) 'widget-create) 
     600                (if (eq (car-safe clm) 'insert-text-button) 
    628601                    (progn (insert " ") (eval clm)) 
    629602                  (when (>= (+ (current-column) 
    …… 
    637610              (insert "\n")))) 
    638611 
    639         (save-excursion 
    640           (goto-char (point-min)) 
    641           (re-search-forward "character:[ \t\n]+") 
    642           (setq pos (point))) 
    643         (let ((end (+ pos (length char-description)))) 
    644           (if overlays 
     612        (when overlays 
     613          (save-excursion 
     614            (goto-char (point-min)) 
     615            (re-search-forward "character:[ \t\n]+") 
     616            (let* ((end (+ (point) (length char-description)))) 
    645617              (mapc #'(lambda (props) 
    646                         (let ((o (make-overlay pos end))) 
     618                        (let ((o (make-overlay (point) end))) 
    647619                          (while props 
    648620                            (overlay-put o (car props) (nth 1 props)) 
    649621                            (setq props (cddr props))))) 
    650                     overlays))) 
     622                    overlays)))) 
    651623 
    652624        (when disp-vector 
    …… 
    666638                  (when (> (car (aref disp-vector i)) #x7ffff) 
    667639                    (let* ((face-id (lsh (car (aref disp-vector i)) -19)) 
    668                            (face (car (delq nil (mapcar (lambda (face) 
    669                                                           (and (eq (face-id face) 
    670                                                                    face-id) face)) 
    671                                                         (face-list)))))) 
     640                           (face (car (delq nil (mapcar 
     641                                                 (lambda (face) 
     642                                                   (and (eq (face-id face) 
     643                                                            face-id) face)) 
     644                                                 (face-list)))))) 
    672645                      (when face 
    673646                        (insert (propertize " " 'display '(space :align-to 5)) 
    674647                                "face: ") 
    675                         (widget-create 'link 
    676                                        :notify `(lambda (&rest ignore) 
    677                                                   (describe-face ',face)) 
    678                                        (format "%S" face)) 
     648                        (insert (concat "`" (symbol-name face) "'")) 
    679649                        (insert "\n")))))) 
    680650            (insert "these terminal codes:\n") 
    …… 
    721691                  "the meaning of the rule.\n")) 
    722692 
    723         (describe-text-properties pos (current-buffer)) 
    724         (describe-text-mode))))) 
     693        (if text-props-desc (insert text-props-desc)) 
     694        (setq help-xref-stack-item (list 'help-insert-string (buffer-string))) 
     695        (toggle-read-only 1) 
     696        (print-help-return-message))))) 
    725697 
    726698(defalias 'describe-char-after 'describe-char)