comparison lisp/descr-text.el @ 47601:7d00d911e8b9

(describe-text-category): Use *Help*. Don't kill-buffer. (describe-text-properties, describe-char): Delay self-inspection test. Use *Help*. Use syntax-after. Use `pos' rather than (point). Distinguish the before/after part of a composition.

47600:6ff56be7780a

;;; Describe-Text Commands.

(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)
      (goto-char (point-min)))))

Interactively, describe them for the character after point.
If optional second argument OUTPUT-BUFFER is non-nil,
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
      (describe-text-properties-1 pos output-buffer)
    (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
	      (describe-text-properties-1 pos output-buffer))
	    (describe-text-mode)

The information includes character code, charset and code points in it,
syntax, category, how the character is encoded in a file,
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)
	 item-list max-width)
    (if (eq charset 'unknown)

	       ,(let ((split (split-char char)))
		  (if (= (charset-dimension charset) 1)
		      (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)))
		   (if (not category-set)
		       '("-- none --")

		       (list (encoded-string-description encoded coding)
			     (format "(encoded by coding system %S)" coding))
		     (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))
			      (encoded (encode-coding-char char coding)))
			 (if encoded
			     (encoded-string-description encoded coding)
			   "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)
	    (insert (format formatter (car elt)))
	    (dolist (clm (cdr elt))

		(insert "\n")
		(indent-to (1+ max-width)))
	      (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 ("
		    (mapconcat (lambda (x)
				 (format (if (consp x) "%S" "?%c") x))

47601:7d00d911e8b9

;;; Describe-Text Commands.

(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)
      (goto-char (point-min)))))

Interactively, describe them for the character after point.
If optional second argument OUTPUT-BUFFER is non-nil,
insert the output into that buffer, and don't initialize or clear it
otherwise."
  (interactive "d")
  (if (>= pos (point-max))
      (error "No character follows specified position"))
  (if output-buffer
      (describe-text-properties-1 pos output-buffer)
    (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
	      (describe-text-properties-1 pos output-buffer))
	    (describe-text-mode)

The information includes character code, charset and code points in it,
syntax, category, how the character is encoded in a file,
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)
	 item-list max-width)
    (if (eq charset 'unknown)

	       ,(let ((split (split-char char)))
		  (if (= (charset-dimension charset) 1)
		      (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)))
		   (if (not category-set)
		       '("-- none --")

		       (list (encoded-string-description encoded coding)
			     (format "(encoded by coding system %S)" coding))
		     (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))
			      (encoded (encode-coding-char char coding)))
			 (if encoded
			     (encoded-string-description encoded coding)
			   "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)
	    (insert (format formatter (car elt)))
	    (dolist (clm (cdr elt))

		(insert "\n")
		(indent-to (1+ max-width)))
	      (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 ("
		    (mapconcat (lambda (x)
				 (format (if (consp x) "%S" "?%c") x))