Problem with glyphs with face-id over 128 in unicode-2 emacs

[Eduardo Ochs]

Suppose that we have more than 128 faces defined, and that we want to
make, say, all "\^O"s be displayed as "*"s with the face
`face-with-id-138'; we would try to do this:

  (aset standard-display-table ?\^O
        (vector (make-glyph-code ?* 'face-with-id-138)))

where, of course, face-with-id-138 is a face for which:

  (face-id 'face-with-id-138)
     ==> 138.

Then we will notice that the "\^O"s get displayed using the face with
face-id=10 instead (by the way: here (face-id 'highlight) is 10)...

Here's what is happening: `make-glyph-code' has this definition (in
"disp-table.el" in emacs-unicode-2, i.e., in CVS Emacs after the merge
or the unicode-2 branch):

  (defun make-glyph-code (char &optional face)
    "Return a glyph code representing char CHAR with face FACE."
    ;; Due to limitations on Emacs integer values, faces with
    ;; face id greater that 512 are silently ignored.
    (if (and face (<= (face-id face) #x1ff))
        (logior char (lsh (face-id face) 22))
      char))

That magic number, 22, used to be 19 in pre-unicode-2 Emacs.

The problem is that (lsh 128 22) is 0, and so (lsh 138 22) drops the
bit corresponding to the 128 in the shift, and its result is the same
as of (lsh 10 22).

Any ideas of workarounds - besides defining the faces that will be
used for glyphs as early as possible?

  Cheers, thanks in advance,
    Eduardo Ochs
    http://angg.twu.net/
    eduardoochs@gmail.com





P.S.: (emacs-version)
    ==> "GNU Emacs 23.0.60.2 (i686-pc-linux-gnu, GTK+ Version 2.8.20)
        of 2008-02-22 on persephone"

P.P.S.: I just noticed that when the face-id of a glyph is between 64
and 127 the glyph appears in the default face... possibly some type
that should be unsigned is currently declared as signed, and face-ids
betwenn 64 and 127 become -64 to -1 on the C side...

P.P.P.S.: Here's the code that I used to understand this bug...

;; --snip--snip--

;; First create 49 faces, with names from `glyph-bug-face-00' to
;; `glyph-bug-face-48'; the first seven of them will have red
;; foreground, the next seven an orange foreground, and so on; and all
;; of them will have a "gray20" background.
;;
(setq glyph-bug-colors
      (split-string "red orange yellow green blue #7000C0 violet"))
(defun glyph-bug-ns () (number-sequence 0 48))
(defun glyph-bug-fg (n) (nth (floor n 7) glyph-bug-colors))
(defun glyph-bug-bg (n) "gray20")
(defun glyph-bug-face (n) (intern (format "glyph-bug-face-%02d" n)))
(defun glyph-bug-make-face (n)
  (let ((face (glyph-bug-face n)))
    (make-face face)
    (set-face-foreground face (glyph-bug-fg n))
    (set-face-background face (glyph-bug-bg n))))

;; Create the faces:
(setq standard-display-table
      (or standard-display-table
          (make-display-table)))
(mapc 'glyph-bug-make-face (glyph-bug-ns))

;; Now set the glyphs for the characters 160 to 160+48=208 (in the
;; positions 160 to 208 of the display table) to characters with the
;; faces that we just created.
;; For pos=160 we use char=48, face=glyph-bug-face-00;
;; for pos=161 we use char=49, face=glyph-bug-face-01;
;; and so on.
;;
(defun glyph-bug-char (n) (+ 48 n))
(defun glyph-bug-position (n) (+ 160 n))
(defun glyph-bug-set (n)
  (aset standard-display-table (glyph-bug-position n)
        (vector (make-glyph-code (glyph-bug-char n) (glyph-bug-face n)))))

;; Set the glyphs:
(mapc 'glyph-bug-set (glyph-bug-ns))

;; Some code to inspect all faces and the corresponding face-ids,
;; ordering them by face-id; (list-colors-display) sorts them
;; alphabetically.

;; Adapted from: (find-efile "disp-table.el" "defun glyph-face ")
;; A simple test: (face-with-id 2)
(defun face-with-id (face-id)
  (car (delq nil (mapcar (lambda (face)
                           (and (eq (get face 'face) face-id)
                                face))
                         (face-list)))))

(defun face-numbers () (number-sequence 0 (- (length (face-list)) 1)))
(defun insert-face-n-and-descr (n)
  (let* ((face (face-with-id n))
         (face-name (symbol-name face)))
    (insert (format "%3d: " n)
            (propertize face-name 'face face)
            "\n")))

(defun glyph-bug-glyphed-chars ()
      (apply 'string (mapcar 'glyph-bug-position (glyph-bug-ns))))

;; Now insert the characters for which we have set glyphs,
;; and the list of face-ids and face names.
(progn
  (insert (glyph-bug-glyphed-chars) "\n")
  (mapc 'insert-face-n-and-descr (face-numbers)))