/[emacs]/emacs/lisp/descr-text.el
ViewVC logotype

Diff of /emacs/lisp/descr-text.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.36 by lute, Mon Jul 4 23:08:52 2005 UTC revision 1.37 by jurta, Tue Jul 19 11:23:14 2005 UTC
# Line 479  as well as widgets, buttons, overlays, a Line 479  as well as widgets, buttons, overlays, a
479                           (format ", U+%04X" unicode)                           (format ", U+%04X" unicode)
480                         "")))                         "")))
481              ("charset"              ("charset"
482               ,(symbol-name charset)               ,`(widget-create 'link
483                                  :notify (lambda (&rest ignore)
484                                            (describe-character-set ',charset))
485                                  ,(symbol-name charset))
486               ,(format "(%s)" (charset-description charset)))               ,(format "(%s)" (charset-description charset)))
487              ("code point"              ("code point"
488               ,(let ((split (split-char char)))               ,(let ((split (split-char char)))
489                  (if (= (charset-dimension charset) 1)                  `(widget-create
490                      (format "%d" (nth 1 split))                    'link
491                    (format "%d %d" (nth 1 split) (nth 2 split)))))                    :notify (lambda (&rest ignore)
492                                (list-charset-chars ',charset)
493                                (with-selected-window
494                                    (get-buffer-window "*Character List*")
495                                  (goto-char (point-min))
496                                  (search-forward ,(char-to-string char)
497                                                  nil t)))
498                      ,(if (= (charset-dimension charset) 1)
499                           (format "%d" (nth 1 split))
500                         (format "%d %d" (nth 1 split) (nth 2 split))))))
501              ("syntax"              ("syntax"
502               ,(let ((syntax (syntax-after pos)))               ,(let ((syntax (syntax-after pos)))
503                  (with-temp-buffer                  (with-temp-buffer
# Line 512  as well as widgets, buttons, overlays, a Line 524  as well as widgets, buttons, overlays, a
524                   (if (consp key-list)                   (if (consp key-list)
525                       (list "type"                       (list "type"
526                             (mapconcat #'(lambda (x) (concat "\"" x "\""))                             (mapconcat #'(lambda (x) (concat "\"" x "\""))
527                                        key-list " or ")))))                                        key-list " or ")
528                               "with"
529                               `(widget-create
530                                 'link
531                                 :notify (lambda (&rest ignore)
532                                           (describe-input-method
533                                            ',current-input-method))
534                                 ,(format "%s" current-input-method))))))
535              ("buffer code"              ("buffer code"
536               ,(encoded-string-description               ,(encoded-string-description
537                 (string-as-unibyte (char-to-string char)) nil))                 (string-as-unibyte (char-to-string char)) nil))
# Line 536  as well as widgets, buttons, overlays, a Line 555  as well as widgets, buttons, overlays, a
555                  (format "by display table entry [%s] (see below)"                  (format "by display table entry [%s] (see below)"
556                          (mapconcat                          (mapconcat
557                           #'(lambda (x)                           #'(lambda (x)
558                               (if (> (car x) #x7ffff)                               (format "?%c" (logand (car x) #x7ffff)))
                                  (format "?%c<face-id=%s>"  
                                          (logand (car x) #x7ffff)  
                                          (lsh (car x) -19))  
                                (format "?%c" (car x))))  
559                           disp-vector " ")))                           disp-vector " ")))
560                 (composition                 (composition
561                  (let ((from (car composition))                  (let ((from (car composition))
# Line 571  as well as widgets, buttons, overlays, a Line 586  as well as widgets, buttons, overlays, a
586                      (if display                      (if display
587                          (format "terminal code %s" display)                          (format "terminal code %s" display)
588                        "not encodable for terminal"))))))                        "not encodable for terminal"))))))
589                ,@(let ((face
590                         (if (not (or disp-vector composition))
591                             (cond
592                              ((and show-trailing-whitespace
593                                    (save-excursion (goto-char pos)
594                                                    (looking-at "[ \t]+$")))
595                               'trailing-whitespace)
596                              ((and nobreak-char-display unicode (eq unicode '#xa0))
597                               'nobreak-space)
598                              ((and nobreak-char-display unicode (eq unicode '#xad))
599                               'escape-glyph)
600                              ((and (< char 32) (not (memq char '(9 10))))
601                               'escape-glyph)))))
602                    (if face (list (list "hardcoded face"
603                                         `(widget-create
604                                           'link
605                                           :notify (lambda (&rest ignore)
606                                                     (describe-face ',face))
607                                           ,(format "%s" face))))))
608              ,@(let ((unicodedata (and unicode              ,@(let ((unicodedata (and unicode
609                                        (describe-char-unicode-data unicode))))                                        (describe-char-unicode-data unicode))))
610                  (if unicodedata                  (if unicodedata
611                      (cons (list "Unicode data" " ") unicodedata)))))                      (cons (list "Unicode data" " ") unicodedata)))))
612      (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))      (setq max-width (apply #'max (mapcar #'(lambda (x)
613                                                 (if (cadr x) (length (car x)) 0))
614                                           item-list)))                                           item-list)))
615      (with-output-to-temp-buffer "*Help*"      (with-output-to-temp-buffer "*Help*"
616        (with-current-buffer standard-output        (with-current-buffer standard-output
# Line 585  as well as widgets, buttons, overlays, a Line 620  as well as widgets, buttons, overlays, a
620              (when (cadr elt)              (when (cadr elt)
621                (insert (format formatter (car elt)))                (insert (format formatter (car elt)))
622                (dolist (clm (cdr elt))                (dolist (clm (cdr elt))
623                  (when (>= (+ (current-column)                  (if (eq (car-safe clm) 'widget-create)
624                               (or (string-match "\n" clm)                      (progn (insert " ") (eval clm))
625                                   (string-width clm)) 1)                    (when (>= (+ (current-column)
626                            (window-width))                                 (or (string-match "\n" clm)
627                    (insert "\n")                                     (string-width clm))
628                    (indent-to (1+ max-width)))                                 1)
629                  (insert " " clm))                              (window-width))
630                        (insert "\n")
631                        (indent-to (1+ max-width)))
632                      (insert " " clm)))
633                (insert "\n"))))                (insert "\n"))))
634    
635          (save-excursion          (save-excursion
# Line 619  as well as widgets, buttons, overlays, a Line 657  as well as widgets, buttons, overlays, a
657                                (format "%s (0x%02X)" (cadr (aref disp-vector i))                                (format "%s (0x%02X)" (cadr (aref disp-vector i))
658                                        (cddr (aref disp-vector i)))                                        (cddr (aref disp-vector i)))
659                              "-- no font --")                              "-- no font --")
660                            "\n ")))                            "\n")
661                      (when (> (car (aref disp-vector i)) #x7ffff)
662                        (let* ((face-id (lsh (car (aref disp-vector i)) -19))
663                               (face (car (delq nil (mapcar (lambda (face)
664                                                              (and (eq (face-id face)
665                                                                       face-id) face))
666                                                            (face-list))))))
667                          (when face
668                            (insert (propertize " " 'display '(space :align-to 5))
669                                    "face: ")
670                            (widget-create 'link
671                                           :notify `(lambda (&rest ignore)
672                                                      (describe-face ',face))
673                                           (format "%S" face))
674                            (insert "\n"))))))
675              (insert "these terminal codes:\n")              (insert "these terminal codes:\n")
676              (dotimes (i (length disp-vector))              (dotimes (i (length disp-vector))
677                (insert (car (aref disp-vector i))                (insert (car (aref disp-vector i))
# Line 667  as well as widgets, buttons, overlays, a Line 719  as well as widgets, buttons, overlays, a
719          (describe-text-mode)))))          (describe-text-mode)))))
720    
721  (defalias 'describe-char-after 'describe-char)  (defalias 'describe-char-after 'describe-char)
722  (make-obsolete 'describe-char-after 'describe-char "21.5")  (make-obsolete 'describe-char-after 'describe-char "22.1")
723    
724  (provide 'descr-text)  (provide 'descr-text)
725    

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26