/[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.42 by schwab, Sun Nov 20 15:25:35 2005 UTC revision 1.43 by handa, Thu Dec 8 01:38:50 2005 UTC
# Line 464  as well as widgets, buttons, overlays, a Line 464  as well as widgets, buttons, overlays, a
464                                   (single-key-description char)                                   (single-key-description char)
465                                 (string-to-multibyte                                 (string-to-multibyte
466                                  (char-to-string char)))))                                  (char-to-string char)))))
467             (orig-buf (current-buffer))
468             (help-buf (if (eq orig-buf (get-buffer "*Help*"))
469                           "*Help-2*" "*Help*"))
470           item-list max-width unicode)           item-list max-width unicode)
471    
472      (if (or (< char 256)      (if (or (< char 256)
# Line 616  as well as widgets, buttons, overlays, a Line 619  as well as widgets, buttons, overlays, a
619      (setq max-width (apply #'max (mapcar #'(lambda (x)      (setq max-width (apply #'max (mapcar #'(lambda (x)
620                                               (if (cadr x) (length (car x)) 0))                                               (if (cadr x) (length (car x)) 0))
621                                           item-list)))                                           item-list)))
622      (with-output-to-temp-buffer "*Help*"      (with-output-to-temp-buffer help-buf
623        (with-current-buffer standard-output        (with-current-buffer standard-output
624          (set-buffer-multibyte multibyte-p)          (set-buffer-multibyte multibyte-p)
625          (let ((formatter (format "%%%ds:" max-width)))          (let ((formatter (format "%%%ds:" max-width)))
# Line 636  as well as widgets, buttons, overlays, a Line 639  as well as widgets, buttons, overlays, a
639                    (insert " " clm)))                    (insert " " clm)))
640                (insert "\n"))))                (insert "\n"))))
641    
642          (save-excursion          (when overlays
643            (goto-char (point-min))            (save-excursion
644            (re-search-forward "character:[ \t\n]+")              (goto-char (point-min))
645            (setq pos (point)))              (re-search-forward "character:[ \t\n]+")
646          (let ((end (+ pos (length char-description))))              (let* ((end (+ (point) (length char-description))))
           (if overlays  
647                (mapc #'(lambda (props)                (mapc #'(lambda (props)
648                          (let ((o (make-overlay pos end)))                          (let ((o (make-overlay (point) end)))
649                            (while props                            (while props
650                              (overlay-put o (car props) (nth 1 props))                              (overlay-put o (car props) (nth 1 props))
651                              (setq props (cddr props)))))                              (setq props (cddr props)))))
652                      overlays)))                      overlays))))
653    
654          (when disp-vector          (when disp-vector
655            (insert            (insert
# Line 720  as well as widgets, buttons, overlays, a Line 722  as well as widgets, buttons, overlays, a
722            (insert "\nSee the variable `reference-point-alist' for "            (insert "\nSee the variable `reference-point-alist' for "
723                    "the meaning of the rule.\n"))                    "the meaning of the rule.\n"))
724    
725          (describe-text-properties pos (current-buffer))          (save-excursion
726              (set-buffer orig-buf)
727              (describe-text-properties pos help-buf))
728          (describe-text-mode)))))          (describe-text-mode)))))
729    
730  (defalias 'describe-char-after 'describe-char)  (defalias 'describe-char-after 'describe-char)

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.43

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