comparison lisp/descr-text.el @ 55305:b1c52f4076c4

(describe-char): Copy the character with text properties and overlays into the first line, and call describe-text-properties on it.

55304:a052e022db03

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))
	 (component-chars nil)
	 (display-table (or (window-display-table)
			    buffer-display-table
			    standard-display-table))
	 (disp-vector (and display-table (aref display-table char)))
	 (multibyte-p enable-multibyte-characters)
	 text-prop-description
	 item-list max-width unicode)
    (if (eq charset 'unknown)
	(setq item-list
	      `(("character"
		 ,(format "%s (0%o, %d, 0x%x) -- invalid character code"
			  (if (< char 256)
			      (single-key-description char)
			    (char-to-string char))
			  char char char))))

      (if (or (< char 256)
	      (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
	      (get-char-property pos 'untranslated-utf-8))
	  (setq unicode (or (get-char-property pos 'untranslated-utf-8)
			    (encode-char char 'ucs))))
      (setq item-list
	    `(("character"
	       ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256)
						 (single-key-description char)
					       (char-to-string char))
			char char char
			(if unicode
			    (format ", U+%04X" unicode)
			  "")))
	      ("charset"
	       ,(symbol-name charset)
	       ,(format "(%s)" (charset-description charset)))
	      ("code point"
	       ,(let ((split (split-char char)))

					(describe-char-unicode-data unicode))))
		  (if unicodedata
		      (cons (list "Unicode data" " ") unicodedata))))))
    (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
					 item-list)))
    (setq text-prop-description
	  (with-temp-buffer
	    (let ((buf (current-buffer)))
	      (save-excursion
		(set-buffer buffer)
		(describe-text-properties pos buf)))
	    (buffer-string)))

    (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)
	    (when (cadr elt)
	      (insert (format formatter (car elt)))
	      (dolist (clm (cdr elt))
		(when (>= (+ (current-column)

		      (propertize " " 'display '(space :align-to 5))
		      (or (cdr elt) "-- not encodable --"))))
	  (insert "\nSee the variable `reference-point-alist' for "
		  "the meaning of the rule.\n"))

	(insert text-prop-description)
	(describe-text-mode)))))

(defalias 'describe-char-after 'describe-char)
(make-obsolete 'describe-char-after 'describe-char "21.5")

55305:b1c52f4076c4

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))
	 (char-string (buffer-substring pos (1+ pos)))
	 (charset (char-charset char))
	 (buffer (current-buffer))
	 (composition (find-composition pos nil nil t))
	 (component-chars nil)
	 (display-table (or (window-display-table)
			    buffer-display-table
			    standard-display-table))
	 (disp-vector (and display-table (aref display-table char)))
	 (multibyte-p enable-multibyte-characters)
	 (overlays (mapcar #'(lambda (o) (overlay-properties o))
			   (overlays-at pos)))
	 item-list max-width unicode)
    (if (eq charset 'unknown)
	(setq item-list '("character"))

      (if (or (< char 256)
	      (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
	      (get-char-property pos 'untranslated-utf-8))
	  (setq unicode (or (get-char-property pos 'untranslated-utf-8)
			    (encode-char char 'ucs))))
      (setq item-list
	    `(("character")
	      ("charset"
	       ,(symbol-name charset)
	       ,(format "(%s)" (charset-description charset)))
	      ("code point"
	       ,(let ((split (split-char char)))

					(describe-char-unicode-data unicode))))
		  (if unicodedata
		      (cons (list "Unicode data" " ") unicodedata))))))
    (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
					 item-list)))
    (pop item-list)

    (with-output-to-temp-buffer "*Help*"
      (with-current-buffer standard-output
	(set-buffer-multibyte multibyte-p)
	(let ((formatter (format "%%%ds:" max-width)))
	  (insert (format formatter "character") " ")
	  (setq pos (point))
	  (insert char-string
		  (format " (`%s', 0%o, %d, 0x%x"
			  (if (< char 256)
			      (single-key-description char)
			    (char-to-string char))
			  char char char)
		  (if (eq charset 'unknown)
		      ") -- invalid character code\n"
		    (if unicode
			(format ", U+%04X)\n" unicode)
		      ")\n")))
	  (mapc #'(lambda (props)
		    (let ((o (make-overlay pos (1+ pos))))
		      (while props
			(overlay-put o (car props) (nth 1 props))
			(setq props (cddr props)))))
		overlays)
	  (dolist (elt item-list)
	    (when (cadr elt)
	      (insert (format formatter (car elt)))
	      (dolist (clm (cdr elt))
		(when (>= (+ (current-column)

		      (propertize " " 'display '(space :align-to 5))
		      (or (cdr elt) "-- not encodable --"))))
	  (insert "\nSee the variable `reference-point-alist' for "
		  "the meaning of the rule.\n"))

	(describe-text-properties pos (current-buffer))
	(describe-text-mode)))))

(defalias 'describe-char-after 'describe-char)
(make-obsolete 'describe-char-after 'describe-char "21.5")