--- a/lisp/disp-table.el	Sat Dec 26 00:20:27 2009 -0600
+++ b/lisp/disp-table.el	Sat Dec 26 21:18:49 2009 -0600
@@ -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.
 ;; Copyright (C) 2005 Ben Wing.
 
@@ -28,69 +28,81 @@
 
 ;;; Commentary:
 
-;; #### Needs work.
-
 ;; Rewritten for XEmacs July 1995, Ben Wing.
 ;; November 1998?, display tables generalized to char/range tables, Hrvoje
 ;; Niksic.
-;; February 2005, rewrite this file to handle generalized display tables,
-;; Ben Wing.
+;; July 2007, rewrite this file to handle generalized display tables,
+;; Aidan Kehoe.
 
 ;;; 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.  \"
+  (if (sequencep display-table)
+      (aset display-table range value)
+    (put-char-table range value display-table)))
+
+\(defun-when-void get-display-table (character display-table)
+  \"Find value for CHARACTER in DISPLAY-TABLE.  \"
+  (if (sequencep display-table)
+      (aref display-table character)
+    (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")
-     (flet ((describe-display-table-entry
-	      (entry stream)
-	      ;; #### Write better version
-	      (princ entry stream))
-	    (describe-display-table-range
-	      (first last entry)
-	      (if (eq first last)
-		  (princ (format "%s\t\t"
-				 (single-key-description (int-char first))))
-		(let ((str (format "%s - %s"
-				   (single-key-description (int-char first))
-				   (single-key-description (int-char last)))))
-		  (princ str)
-		  (princ (make-string (max (- 2 (/ (length str)
-						   tab-width)) 1) ?\t))))
-	      (describe-display-table-entry entry standard-output)
-	      (terpri)))
-       (cond ((vectorp dt)
-	      (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 port it.  Here is what `describe-vector' does:
-		 (terpri)
-		 (let ((old (aref vector 0))
-		       (oldpos 0)
-		       (i 1))
-		   (while (<= i 256)
-		     (when (or (= i 256)
-			       (not (equal old (aref vector i))))
-		       (describe-display-table-range oldpos (1- i) old)
-		       (or (= i 256)
-			   (setq old (aref vector i)
-				 oldpos i)))
-		     (incf i))))))
-	     ((char-table-p dt)
-	      (describe-char-table dt 'map-char-table
-	       'describe-display-table-entry
-	       standard-output))
-	     ((range-table-p dt)
-	      (map-range-table
-	       #'(lambda (beg end value)
-		   (describe-display-table-range beg end value))
-	       dt)))))))
+     (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)
@@ -102,28 +114,6 @@
 	(describe-display-table disptab)
       (message "No display table"))))
 
-;;;###autoload
-(defun make-display-table ()
-  "Return a new, empty display table.
-Modify a display table using `put-display-table'.  Look up in display tables
-using `get-display-table'.  The exact format of display tables and their
-specs is described in `current-display-table'."
-  ;; #### This should do something smarter.
-  ;; #### Should use range table but there are bugs in range table and
-  ;; perhaps in callers not expecting this.
-  ;(make-range-table 'start-closed-end-closed)
-  ;(make-vector 256 nil)
-  ;; #### Should be type `display-table'
-  (make-char-table 'generic))
-
-(defun display-table-p (object)
-  "Return t if OBJECT is a display table.
-See `make-display-table'."
-  (or (and (vectorp object) (= (length object) 256))
-      (and (char-table-p object) (memq (char-table-type object)
-				       '(char generic display)))
-      (range-table-p object)))
-
 ;; #### we need a generic frob-specifier function.
 ;; #### this also needs to be redone like frob-face-property.
 
@@ -132,6 +122,7 @@
 ;; #### Need more thinking about basic primitives for modifying a specifier.
 ;; cf `modify-specifier-instances'.
 
+;;;###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 tag-set)
@@ -147,78 +138,42 @@
 		(cdar (specifier-spec-list current-display-table
 					   fdt-locale tag-set)))))))
 
-(defun put-display-table-range (l h spec display-table)
-  "Display characters in range L .. H, inclusive, in DISPLAY-TABLE using SPEC.
-Display tables are described in `current-display-table'."
-  (check-argument-type 'display-table-p display-table)
-  (cond ((vectorp display-table)
-	 (while (<= l h)
-	   (aset display-table l spec)
-	   (setq l (1+ l))))
-	((char-table-p display-table)
-	 (while (<= l h)
-	   (put-char-table l spec display-table)
-	   (setq l (1+ l))))
-	((range-table-p display-table)
-	 (put-range-table l h spec display-table))))
-
-(defun put-display-table (ch spec display-table)
-  "Display character spec CH in DISPLAY-TABLE using SPEC.
-CH can be a character, a charset, or t for all characters.
-Display tables are described in `current-display-table'."
-  (cond ((eq ch t)
-	 (cond ((vectorp display-table)
-		(put-display-table-range 0 (1- (length display-table)) spec
-					 display-table))
-	       ((range-table-p display-table)
-		; major hack
-		(put-display-table-range 0 (string-to-int "3FFFFFFF" 16)
-					 spec display-table))
-	       ((char-table-p display-table)
-		(put-char-table t spec display-table))))
-	((charsetp ch)
-	 (cond ((vectorp display-table)
-		;; #### fix
-		nil)
-	       ((range-table-p display-table)
-		;; #### fix
-		nil)
-	       ((char-table-p display-table)
-		(put-char-table ch spec display-table))))
-	(t (put-display-table-range ch ch spec display-table))))
-
-(defun get-display-table (char display-table)
-  "Return SPEC of CHAR in DISPLAY-TABLE.
-See `current-display-table'."
-  (check-argument-type 'display-table-p display-table)
-  (cond ((vectorp display-table)
-	 (aref display-table char))
-	((char-table-p display-table)
-	 (get-char-table char display-table))
-	((range-table-p display-table)
-	 (get-range-table char display-table))))
-
 (defun standard-display-8bit-1 (dt l h)
   (while (<= l h)
-    (put-display-table l (char-to-string l) dt)
+    (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)
-    (put-display-table l nil dt)
+    (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))
@@ -229,7 +184,7 @@
   "Display character C using printable string S."
   (frob-display-table
    (lambda (x)
-     (put-display-table c s x))
+     (put-char-table c s x))
    locale))
 
 ;;;###autoload
@@ -239,9 +194,8 @@
 the SO/SI characters."
   (frob-display-table
    (lambda (x)
-     (put-display-table c (concat "\016" (char-to-string sc) "\017") x))
-   locale
-   'tty))
+     (put-char-table c (concat "\016" (char-to-string sc) "\017") x))
+   locale '(tty)))
 
 ;;;###autoload
 (defun standard-display-graphic (c gc &optional locale)
@@ -249,38 +203,41 @@
 This only has an effect on TTY devices and assumes VT100-compatible escapes."
   (frob-display-table
    (lambda (x)
-     (put-display-table c (concat "\e(0" (char-to-string gc) "\e(B") x))
-   locale
-   'tty))
-
-;;; #### 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)
-     (put-display-table c (concat "\e[4m" (char-to-string uc) "\e[m") x))
-   locale
-   'tty))
+     (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 (get-display-table 160 x) (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)