Re: cannot understand Elisp manual node Glyphs

[storm@cua.dk (Kim F. Storm)]

David Kastrup <dak@gnu.org> writes:

> Well, picking from the doc string, make-glyph-code would seem a
> suitable choice, too.

Good idea.

Here is a complete patch:

*** display.texi	02 Feb 2007 11:06:10 +0100	1.247
--- display.texi	08 Feb 2007 11:32:56 +0100	
***************
*** 5272,5280 ****
  
    A glyph code can be @dfn{simple} or it can be defined by the
  @dfn{glyph table}.  A simple glyph code is just a way of specifying a
! character and a face to output it in.  When a glyph code is simple,
! the code, mod 524288, is the character to output, and the code divided
! by 524288 specifies the face number (@pxref{Face Functions}) to use
  while outputting it.  (524288 is
  @ifnottex
  2**19.)
--- 5272,5298 ----
  
    A glyph code can be @dfn{simple} or it can be defined by the
  @dfn{glyph table}.  A simple glyph code is just a way of specifying a
! character and a face to output it in.  @xref{Faces}.
! 
!   The following functions are used to manipulate simple glyph codes:
! 
! @defun make-glyph-code char &optional face
! This function returns a simple glyph code representing char @var{char}
! with face @var{face}.
! @end defun
! 
! @defun glyph-char glyph
! This function returns the character of simple glyph code @var{glyph}.
! @end defun
! 
! @defun glyph-face glyph
! This function returns face of simple glyph code @var{glyph}, or
! @code{nil} if @var{glyph} has the default face (face-id 0).
! @end defun
! 
!   Internally, a simple glyph code is an integer @var{gc}, where @var{gc}
! modulo 524288 is the character to output, and @var{gc} divided
! by 524288 specifies the face-id (@pxref{Face Functions}) to use
  while outputting it.  (524288 is
  @ifnottex
  2**19.)
***************
*** 5282,5288 ****
  @tex
  $2^{19}$.)
  @end tex
- @xref{Faces}.
  
    On character terminals, you can set up a @dfn{glyph table} to define
  the meaning of glyph codes.
--- 5300,5305 ----


*** disp-table.el	21 Jan 2007 21:52:32 +0100	1.64
--- disp-table.el	08 Feb 2007 11:34:24 +0100	
***************
*** 172,178 ****
    (aset standard-display-table c
  	(vector
  	 (if window-system
! 	     (logior uc (lsh (face-id 'underline) 19))
  	   (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))))
  
  ;;;###autoload
--- 172,178 ----
    (aset standard-display-table c
  	(vector
  	 (if window-system
! 	     (make-glyph-code uc 'underline)
  	   (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))))
  
  ;;;###autoload
***************
*** 187,192 ****
--- 187,214 ----
    (1- (length glyph-table)))
  
  ;;;###autoload
+ (defun make-glyph-code (char &optional face)
+   "Return a glyph code representing char CHAR with face FACE."
+   (if face
+       (logior char (lsh (face-id face) 19))
+     char))
+ 
+ ;;;###autoload
+ (defun glyph-char (glyph)
+   "Return the character of glyph code GLYPH."
+   (logand glyph #x7ffff))
+ 
+ ;;;###autoload
+ (defun glyph-face (glyph)
+   "Return the face of glyph code GLYPH, or nil if glyph has default face."
+   (let ((face-id (lsh glyph -19)))
+     (and (> face-id 0)
+ 	 (car (delq nil (mapcar (lambda (face)
+ 				  (and (eq (get face 'face) face-id)
+ 				       face))
+ 				(face-list)))))))
+ 
+ ;;;###autoload
  (defun standard-display-european (arg)
    "Semi-obsolete way to toggle display of ISO 8859 European characters.
  
*** descr-text.el	21 Jan 2007 21:52:32 +0100	1.54
--- descr-text.el	08 Feb 2007 10:54:37 +0100	
***************
*** 528,538 ****
  		  (setq char (aref disp-vector i))
  		  (aset disp-vector i
  			(cons char (describe-char-display
! 				    pos (logand char #x7ffff)))))
  		(format "by display table entry [%s] (see below)"
  			(mapconcat
  			 #'(lambda (x)
! 			     (format "?%c" (logand (car x) #x7ffff)))
  			 disp-vector " ")))
  	       (composition
  		(let ((from (car composition))
--- 528,538 ----
  		  (setq char (aref disp-vector i))
  		  (aset disp-vector i
  			(cons char (describe-char-display
! 				    pos (glyph-char char)))))
  		(format "by display table entry [%s] (see below)"
  			(mapconcat
  			 #'(lambda (x)
! 			     (format "?%c" (glyph-char (car x))))
  			 disp-vector " ")))
  	       (composition
  		(let ((from (car composition))
***************
*** 627,651 ****
  	      (progn
  		(insert "these fonts (glyph codes):\n")
  		(dotimes (i (length disp-vector))
! 		  (insert (logand (car (aref disp-vector i)) #x7ffff) ?:
  			  (propertize " " 'display '(space :align-to 5))
  			  (if (cdr (aref disp-vector i))
  			      (format "%s (#x%02X)" (cadr (aref disp-vector i))
  				      (cddr (aref disp-vector i)))
  			    "-- no font --")
  			  "\n")
! 		  (when (> (car (aref disp-vector i)) #x7ffff)
! 		    (let* ((face-id (lsh (car (aref disp-vector i)) -19))
! 			   (face (car (delq nil (mapcar
! 						 (lambda (face)
! 						   (and (eq (face-id face)
! 							    face-id) face))
! 						 (face-list))))))
! 		      (when face
! 			(insert (propertize " " 'display '(space :align-to 5))
! 				"face: ")
! 			(insert (concat "`" (symbol-name face) "'"))
! 			(insert "\n"))))))
  	    (insert "these terminal codes:\n")
  	    (dotimes (i (length disp-vector))
  	      (insert (car (aref disp-vector i))
--- 627,645 ----
  	      (progn
  		(insert "these fonts (glyph codes):\n")
  		(dotimes (i (length disp-vector))
! 		  (insert (glyph-char (car (aref disp-vector i))) ?:
  			  (propertize " " 'display '(space :align-to 5))
  			  (if (cdr (aref disp-vector i))
  			      (format "%s (#x%02X)" (cadr (aref disp-vector i))
  				      (cddr (aref disp-vector i)))
  			    "-- no font --")
  			  "\n")
! 		  (let ((face (glyph-face (car (aref disp-vector i)))))
! 		    (when face
! 		      (insert (propertize " " 'display '(space :align-to 5))
! 			      "face: ")
! 		      (insert (concat "`" (symbol-name face) "'"))
! 		      (insert "\n")))))
  	    (insert "these terminal codes:\n")
  	    (dotimes (i (length disp-vector))
  	      (insert (car (aref disp-vector i))


*** latin1-disp.el	21 Jan 2007 21:53:10 +0100	1.23
--- latin1-disp.el	08 Feb 2007 10:44:28 +0100	
***************
*** 177,190 ****
        (if (eq 'default latin1-display-face)
  	  (standard-display-ascii char (format latin1-display-format display))
  	(aset standard-display-table char
! 	      (vconcat (mapcar (lambda (c)
! 				 (logior c (lsh (face-id latin1-display-face)
! 						19)))
  			       display))))
      (aset standard-display-table char
! 	  (if (eq 'default latin1-display-face)
! 	      display
! 	    (logior display (lsh (face-id latin1-display-face) 19))))))
  
  (defun latin1-display-identities (charset)
    "Display each character in CHARSET as the corresponding Latin-1 character.
--- 177,186 ----
        (if (eq 'default latin1-display-face)
  	  (standard-display-ascii char (format latin1-display-format display))
  	(aset standard-display-table char
! 	      (vconcat (mapcar (lambda (c) (make-glyph-code c latin1-display-face))
  			       display))))
      (aset standard-display-table char
! 	  (make-glyph-code display latin1-display-face))))
  
  (defun latin1-display-identities (charset)
    "Display each character in CHARSET as the corresponding Latin-1 character.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk