changeset 75873:da8eab108281

(make-glyph-code, glyph-char, glyph-face): New defuns. (standard-display-underline): Use make-glyph-code.
author Kim F. Storm <storm@cua.dk>
date Wed, 14 Feb 2007 11:28:40 +0000
parents a527b46e9ab2
children b9243e7cca8d
files lisp/disp-table.el
diffstat 1 files changed, 25 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/disp-table.el	Wed Feb 14 11:28:31 2007 +0000
+++ b/lisp/disp-table.el	Wed Feb 14 11:28:40 2007 +0000
@@ -172,7 +172,7 @@
   (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
@@ -187,6 +187,30 @@
   (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.