From: Kim F. Storm <storm@cua.dk>
Date: Wed, 14 Feb 2007 11:28:40 +0000 (+0000)
Subject: (make-glyph-code, glyph-char, glyph-face): New defuns.
X-Git-Tag: emacs-pretest-22.0.94~202
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7dbfbd9191092032c2878b6d0eac28773e2982e5;p=emacs.git

(make-glyph-code, glyph-char, glyph-face): New defuns.
(standard-display-underline): Use make-glyph-code.
---

diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index fa98086b0bc..2a4dd01897d 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -172,7 +172,7 @@ X frame."
   (aset standard-display-table c
 	(vector
 	 (if window-system
-	     (logior uc (lsh (face-id 'underline) 19))
+	     (make-glyph-code uc 'underline)
 	   (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))))
 
 ;;;###autoload
@@ -186,6 +186,30 @@ X frame."
   (setq glyph-table (vconcat glyph-table (list string)))
   (1- (length glyph-table)))
 
+;;;###autoload
+(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 4091 are silently ignored.
+  (if (and face (<= (face-id face) #xfff))
+      (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.