[Emacs-diffs] Changes to emacs/lisp/descr-text.el

[Stefan Monnier]

Index: emacs/lisp/descr-text.el
diff -c emacs/lisp/descr-text.el:1.7 emacs/lisp/descr-text.el:1.8
*** emacs/lisp/descr-text.el:1.7        Tue Sep 10 12:45:42 2002
--- emacs/lisp/descr-text.el    Tue Sep 24 17:11:25 2002
***************
*** 136,146 ****
  (defun describe-text-category (category)
    "Describe a text property category."
    (interactive "S")
-   (when (get-buffer "*Text Category*")
-     (kill-buffer "*Text Category*"))
    (save-excursion
!     (with-output-to-temp-buffer "*Text Category*"
!       (set-buffer "*Text Category*")
        (widget-insert "Category " (format "%S" category) ":\n\n")
        (describe-property-list (symbol-plist category))
        (describe-text-mode)
--- 136,144 ----
  (defun describe-text-category (category)
    "Describe a text property category."
    (interactive "S")
    (save-excursion
!     (with-output-to-temp-buffer "*Help*"
!       (set-buffer standard-output)
        (widget-insert "Category " (format "%S" category) ":\n\n")
        (describe-property-list (symbol-plist category))
        (describe-text-mode)
***************
*** 154,161 ****
  insert the output into that buffer, and don't initialize or clear it
  otherwise."
    (interactive "d")
-   (when (eq (current-buffer) (get-buffer "*Text Description*"))
-     (error "Can't do self inspection"))
    (if (>= pos (point-max))
        (error "No character follows specified position"))
    (if output-buffer
--- 152,157 ----
***************
*** 163,171 ****
      (if (not (or (text-properties-at pos) (overlays-at pos)))
        (message "This is plain text.")
        (let ((buffer (current-buffer)))
        (save-excursion
!         (with-output-to-temp-buffer "*Text Description*"
!           (set-buffer "*Text Description*")
            (setq output-buffer (current-buffer))
            (widget-insert "Text content at position " (format "%d" pos) 
":\n\n")
            (with-current-buffer buffer
--- 159,169 ----
      (if (not (or (text-properties-at pos) (overlays-at pos)))
        (message "This is plain text.")
        (let ((buffer (current-buffer)))
+       (when (eq buffer (get-buffer "*Help*"))
+         (error "Can't do self inspection"))
        (save-excursion
!         (with-output-to-temp-buffer "*Help*"
!           (set-buffer standard-output)
            (setq output-buffer (current-buffer))
            (widget-insert "Text content at position " (format "%d" pos) 
":\n\n")
            (with-current-buffer buffer
***************
*** 226,239 ****
  character composition information (if relevant),
  as well as widgets, buttons, overlays, and text properties."
    (interactive "d")
-   (when (eq (current-buffer) (get-buffer "*Text Description*"))
-     (error "Can't do self inspection"))
    (if (>= pos (point-max))
        (error "No character follows specified position"))
    (let* ((char (char-after pos))
         (charset (char-charset char))
         (buffer (current-buffer))
!        (composition (find-composition (point) nil nil t))
         (composed (if composition (buffer-substring (car composition)
                                                     (nth 1 composition))))
         (multibyte-p enable-multibyte-characters)
--- 224,235 ----
  character composition information (if relevant),
  as well as widgets, buttons, overlays, and text properties."
    (interactive "d")
    (if (>= pos (point-max))
        (error "No character follows specified position"))
    (let* ((char (char-after pos))
         (charset (char-charset char))
         (buffer (current-buffer))
!        (composition (find-composition pos nil nil t))
         (composed (if composition (buffer-substring (car composition)
                                                     (nth 1 composition))))
         (multibyte-p enable-multibyte-characters)
***************
*** 261,271 ****
                      (format "%d" (nth 1 split))
                    (format "%d %d" (nth 1 split) (nth 2 split)))))
              ("syntax"
!              ,(let ((syntax (get-char-property (point) 'syntax-table)))
                  (with-temp-buffer
!                   (internal-describe-syntax-value
!                    (if (consp syntax) syntax
!                      (aref (or syntax (syntax-table)) char)))
                    (buffer-string))))
              ("category"
               ,@(let ((category-set (char-category-set char)))
--- 257,265 ----
                      (format "%d" (nth 1 split))
                    (format "%d %d" (nth 1 split) (nth 2 split)))))
              ("syntax"
!              ,(let ((syntax (syntax-after pos)))
                  (with-temp-buffer
!                   (internal-describe-syntax-value syntax)
                    (buffer-string))))
              ("category"
               ,@(let ((category-set (char-category-set char)))
***************
*** 293,308 ****
                     (list "not encodable by coding system"
                           (symbol-name coding)))))
              ,@(if (or (memq 'mule-utf-8
!                         (find-coding-systems-region (point) (1+ (point))))
!                       (get-char-property (point) 'untranslated-utf-8))
!                   (let ((uc (or (get-char-property (point)
!                                                    'untranslated-utf-8)
!                                 (encode-char (char-after) 'ucs))))
                      (if uc
                          (list (list "Unicode"
                                      (format "%04X" uc))))))
              ,(if (display-graphic-p (selected-frame))
!                  (list "font" (or (internal-char-font (point))
                                    "-- none --"))
                 (list "terminal code"
                       (let* ((coding (terminal-coding-system))
--- 287,301 ----
                     (list "not encodable by coding system"
                           (symbol-name coding)))))
              ,@(if (or (memq 'mule-utf-8
!                         (find-coding-systems-region pos (1+ pos)))
!                       (get-char-property pos 'untranslated-utf-8))
!                   (let ((uc (or (get-char-property pos 'untranslated-utf-8)
!                                 (encode-char char 'ucs))))
                      (if uc
                          (list (list "Unicode"
                                      (format "%04X" uc))))))
              ,(if (display-graphic-p (selected-frame))
!                  (list "font" (or (internal-char-font pos)
                                    "-- none --"))
                 (list "terminal code"
                       (let* ((coding (terminal-coding-system))
***************
*** 312,322 ****
                           "not encodable")))))))
      (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
                                         item-list)))
!     (when (get-buffer "*Help*")
!       (kill-buffer "*Help*"))
      (with-output-to-temp-buffer "*Help*"
!       (save-excursion
!       (set-buffer standard-output)
        (set-buffer-multibyte multibyte-p)
        (let ((formatter (format "%%%ds:" max-width)))
          (dolist (elt item-list)
--- 305,314 ----
                           "not encodable")))))))
      (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
                                         item-list)))
!     (when (eq (current-buffer) (get-buffer "*Help*"))
!       (error "Can't do self inspection"))
      (with-output-to-temp-buffer "*Help*"
!       (with-current-buffer standard-output
        (set-buffer-multibyte multibyte-p)
        (let ((formatter (format "%%%ds:" max-width)))
          (dolist (elt item-list)
***************
*** 331,341 ****
              (insert " " clm))
            (insert "\n")))
        (when composition
!         (insert "\nComposed with the following character(s) "
!                 (mapconcat (lambda (x) (format "`%c'" x))
!                            (substring composed 1)
!                            ", ")
!                 " to form `" composed "'")
          (if (nth 3 composition)
              (insert ".\n")
            (insert "\nby the rule ("
--- 323,342 ----
              (insert " " clm))
            (insert "\n")))
        (when composition
!         (insert "\nComposed with the "
!                 (cond
!                  ((eq pos (car composition)) "following ")
!                  ((eq (1+ pos) (cadr composition)) "preceding ")
!                  (t ""))
!                 "character(s) `"
!                 (cond
!                  ((eq pos (car composition)) (substring composed 1))
!                  ((eq (1+ pos) (cadr composition)) (substring composed 0 -1))
!                  (t (concat (substring composed 0 (- pos (car composition)))
!                             "' and `"
!                             (substring composed (- (1+ pos) (car 
composition))))))
!                   
!                 "' to form `" composed "'")
          (if (nth 3 composition)
              (insert ".\n")
            (insert "\nby the rule ("