Re: cannot understand Elisp manual node Glyphs

[Kim F. Storm]

David Kastrup <address@hidden> 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 <address@hidden> http://www.cua.dk