--- a/lisp/disp-table.el	Mon Dec 24 14:00:51 2007 +0100
+++ b/lisp/disp-table.el	Mon Dec 24 20:22:08 2007 +0100
@@ -1,6 +1,6 @@
 ;;; disp-table.el --- functions for dealing with char tables.
 
-;; Copyright (C) 1987, 1994, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1994, 1997, 2007 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Sun Microsystems.
 
 ;; Author: Howard Gayle
@@ -28,56 +28,82 @@
 
 ;;; Commentary:
 
-;; #### Need lots of work.  make-display-table depends on a value
-;; that is a define in the C code.  Maybe we should just move the
-;; function into C.
-
-;; #### display-tables-as-vectors is really evil and a big pain in
-;; the ass.
-
 ;; Rewritten for XEmacs July 1995, Ben Wing.
 
 
 ;;; Code:
 
+;;;###autoload
+(defun make-display-table ()
+  "Return a new, empty display table.
+
+This returns a generic character table; previously it returned a vector, but
+that was not helpful when dealing with internationalized characters above
+#xFF.  See `make-char-table' for details of character tables in general.  To
+write code that works with both vectors and character tables, add something
+like the following to the beginning of your file, and use
+`put-display-table' to set what a given character is displayed as, and
+`get-display-table' to examine what that character is currently displayed
+as:
+
+\(defun-when-void put-display-table (range value display-table)
+  \"Set the value for char RANGE to VALUE in DISPLAY-TABLE.  \"
+  (ecase (type-of display-table)
+    (vector
+     (aset display-table range value))
+    (char-table
+     (put-char-table range value display-table))))
+
+\(defun-when-void get-display-table (character display-table)
+  \"Find value for CHARACTER in DISPLAY-TABLE.  \"
+  (ecase (type-of display-table)
+    (vector
+     (aref display-table character))
+    (char-table
+     (get-char-table character display-table))))
+
+In this implementation, `put-display-table' and `get-display-table' are
+aliases of `put-char-table' and `get-char-table' respectively, and are
+always available.   "
+  (make-char-table 'generic))
+
+;;;###autoload
+(defalias 'put-display-table #'put-char-table)
+
+;;;###autoload
+(defalias 'get-display-table #'get-char-table)
+
 (defun describe-display-table (dt)
   "Describe the display table DT in a help buffer."
   (with-displaying-help-buffer
    (lambda ()
-     (princ "\nCharacter display glyph sequences:\n")
-     (save-excursion
-       (let ((vector (make-vector 256 nil))
-             (i 0))
-         (while (< i 256)
-           (aset vector i (aref dt i))
-           (incf i))
-	 ;; FSF calls `describe-vector' here, but it is so incredibly
-	 ;; lame a function for that name that I cannot bring myself
-	 ;; to porting it.  Here is what `describe-vector' does:
-	 (terpri)
-	 (let ((old (aref vector 0))
-	       (oldpos 0)
-	       (i 1)
-	       str)
-	   (while (<= i 256)
-	     (when (or (= i 256)
-		       (not (equal old (aref vector i))))
-	       (if (eq oldpos (1- i))
-		   (princ (format "%s\t\t%s\n"
-				  (single-key-description (int-char oldpos))
-				  old))
-		 (setq str (format "%s - %s"
-				   (single-key-description (int-char oldpos))
-				   (single-key-description (int-char (1- i)))))
-		 (princ str)
-		 (princ (make-string (max (- 2 (/ (length str)
-						  tab-width)) 1) ?\t))
-		 (princ old)
-		 (terpri))
-	       (or (= i 256)
-		   (setq old (aref vector i)
-			 oldpos i)))
-	     (incf i))))))))
+     (map-char-table
+      (lambda (range value)
+        (cond
+         ((eq range t)
+          (princ "\nAll characters: \n")
+          (princ (format "  %S" value)))
+         ((eq 'charset (and (symbolp range) (type-of (find-charset range))))
+          (princ (format "\n\nCharset %S: \n" (charset-name range)))
+          (princ (format "  %S" value)))
+         ((vectorp range)
+          (princ (format "\n\nCharset %S, row %d \n"
+                         (charset-name (aref value 0))
+                         (aref value 1)))
+          (princ (format "  %S\n\n" value)))
+         ((characterp range)
+          (princ (format "\nCharacter U+%04X, %S: "
+                         range (if (fboundp 'split-char)
+                                   (split-char range)
+                                 (list 'ascii (char-to-int range)))))
+          (princ (format "  %S" value))))
+        nil) dt)
+     (princ 
+      "\n\nFor some of the various other glyphs that GNU Emacs uses the display
+table for, see the XEmacs specifiers `truncation-glyph' ,
+`continuation-glyph', `control-arrow-glyph', `octal-escape-glyph' and the
+others described in the docstring of `make-glyph'. \n\n"))))
+
 
 ;;;###autoload
 (defun describe-current-display-table (&optional domain)
@@ -89,21 +115,17 @@
 	(describe-display-table disptab)
       (message "No display table"))))
 
-;;;###autoload
-(defun make-display-table ()
-  "Return a new, empty display table."
-  (make-vector 256 nil))
-
 ;; #### we need a generic frob-specifier function.
 ;; #### this also needs to be redone like frob-face-property.
 
 ;; Let me say one more time how much dynamic scoping sucks.
 
-(defun frob-display-table (fdt-function fdt-locale)
+;;;###autoload
+(defun frob-display-table (fdt-function fdt-locale &optional tag-set)
   (or fdt-locale (setq fdt-locale 'global))
-  (or (specifier-spec-list current-display-table fdt-locale)
+  (or (specifier-spec-list current-display-table fdt-locale tag-set)
       (add-spec-to-specifier current-display-table (make-display-table)
-			     fdt-locale))
+			     fdt-locale tag-set))
   (add-spec-list-to-specifier
    current-display-table
    (list (cons fdt-locale
@@ -112,29 +134,44 @@
                   (funcall fdt-function (cdr fdt-x))
                   fdt-x)
 		(cdar (specifier-spec-list current-display-table
-					   fdt-locale)))))))
+					   fdt-locale tag-set)))))))
 
 (defun standard-display-8bit-1 (dt l h)
   (while (<= l h)
-    (aset dt l (char-to-string l))
+    (remove-char-table (int-to-char l) dt)
     (setq l (1+ l))))
 
 ;;;###autoload
 (defun standard-display-8bit (l h &optional locale)
-  "Display characters in the range L to H literally."
+  "Display characters in the range L to H literally [sic].
+
+GNU Emacs includes this function.  There, `literally' has no good meaning.
+Under XEmacs, this function makes characters with numeric values in the
+range L to H display as themselves; that is, as ASCII, latin-iso8859-1,
+latin-iso8859-2 or whatever.  See `standard-display-default' for the inverse
+function.  "
   (frob-display-table
    (lambda (x)
      (standard-display-8bit-1 x l h))
    locale))
 
 (defun standard-display-default-1 (dt l h)
+  "Misnamed function under XEmacs. See `standard-display-default'."
   (while (<= l h)
-    (aset dt l nil)
+    (put-char-table (int-to-char l) (format "\\%o" l) dt)
     (setq l (1+ l))))
 
 ;;;###autoload
 (defun standard-display-default (l h &optional locale)
-  "Display characters in the range L to H using the default notation."
+  "Display characters in the range L to H using octal escape notation.
+
+In the XEmacs context this function is misnamed.  Under GNU Emacs,
+characters in the range #xA0 to #xFF display as octal escapes unless
+`standard-display-european' has been called; this function neutralizes the
+effects of `standard-display-european'.  Under XEmacs, those characters
+normally do not display as octal escapes (this ignores hackery like
+specifying the X11 font character set on non-Mule builds) and this function
+sets them to display as octal escapes.  "
   (frob-display-table
    (lambda (x)
      (standard-display-default-1 x l h))
@@ -145,12 +182,9 @@
   "Display character C using printable string S."
   (frob-display-table
    (lambda (x)
-     (aset x c s))
+     (put-char-table c s x))
    locale))
 
-
-;;; #### should frob in a 'tty locale.
-
 ;;;###autoload
 (defun standard-display-g1 (c sc &optional locale)
   "Display character C as character SC in the g1 character set.
@@ -158,11 +192,8 @@
 it is meaningless for an X frame."
   (frob-display-table
    (lambda (x)
-     (aset x c (concat "\016" (char-to-string sc) "\017")))
-   locale))
-
-
-;;; #### should frob in a 'tty locale.
+     (put-char-table c (concat "\016" (char-to-string sc) "\017") x))
+   locale '(tty)))
 
 ;;;###autoload
 (defun standard-display-graphic (c gc &optional locale)
@@ -171,37 +202,41 @@
 X frame."
   (frob-display-table
    (lambda (x)
-     (aset x c (concat "\e(0" (char-to-string gc) "\e(B")))
-   locale))
-
-;;; #### should frob in a 'tty locale.
-;;; #### the FSF equivalent of this makes this character be displayed
-;;; in the 'underline face.  There's no current way to do this with
-;;; XEmacs display tables.
+     (put-char-table c (concat "\e(0" (char-to-string gc) "\e(B") x))
+   locale '(tty)))
 
 ;;;###autoload
 (defun standard-display-underline (c uc &optional locale)
   "Display character C as character UC plus underlining."
   (frob-display-table
    (lambda (x)
-     (aset x c (concat "\e[4m" (char-to-string uc) "\e[m")))
+     (let (glyph)
+       (setq glyph (make-glyph (vector 'string :data (char-to-string uc))))
+       (set-glyph-face glyph 'underline)
+       (put-char-table c glyph x)))
    locale))
 
 ;;;###autoload
 (defun standard-display-european (arg &optional locale)
-  "Toggle display of European characters encoded with ISO 8859.
-When enabled, characters in the range of 160 to 255 display not
-as octal escapes, but as accented characters.
-With prefix argument, enable European character display iff arg is positive."
+  "Toggle display of European characters encoded with ISO 8859-1.
+When enabled (the default), characters in the range of 160 to 255 display
+as accented characters. With negative prefix argument, display characters in
+that range as octal escapes.  
+
+If you want to work in a Western European language under XEmacs, it
+shouldn't be necessary to call this function--things should just work.  But
+it's in a sufficient number of init files that we're not in a hurry to
+remove it.  "
   (interactive "P")
-  (frob-display-table
-   (lambda (x)
-     (if (or (<= (prefix-numeric-value arg) 0)
-             (and (null arg)
-                  (equal (aref x 160) (char-to-string 160))))
-         (standard-display-default-1 x 160 255)
-       (standard-display-8bit-1 x 160 255)))
-   locale))
+  (if (<= (prefix-numeric-value arg) 0)
+      (frob-display-table
+       (lambda (x)
+         (standard-display-default-1 x 160 255))
+       locale)
+    (frob-display-table
+     (lambda (x)
+       (standard-display-8bit-1 x 160 255))
+       locale)))
 
 (provide 'disp-table)