--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/prim/disp-table.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,178 @@
+;;; disp-table.el --- functions for dealing with char tables.
+
+;; Copyright (C) 1987, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Sun Microsystems.
+
+;; Author: Howard Gayle
+;; Maintainer: FSF
+;; Keywords: i18n
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Synched up with: Not synched with FSF.
+
+;;; #### 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:
+
+(defun describe-display-table (dt)
+  "Describe the display table DT in a help buffer."
+  (with-displaying-help-buffer
+   (princ "\nCharacter display glyph sequences:\n")
+    (save-excursion
+      (set-buffer standard-output)
+      (let ((vector (make-vector 256 nil))
+	    (i 0))
+	(while (< i 256)
+	  (aset vector i (aref dt i))
+	  (setq i (1+ i)))
+	(describe-vector vector)))))
+
+;;;###autoload
+(defun describe-current-display-table (&optional domain)
+  "Describe the display table in use in the selected window and buffer."
+  (interactive)
+  (or domain (setq domain (selected-window)))
+  (let ((disptab (specifier-instance current-display-table domain)))
+    (if disptab
+	(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)
+  (or fdt-locale (setq fdt-locale 'global))
+  (or (specifier-spec-list current-display-table fdt-locale)
+      (add-spec-to-specifier current-display-table (make-display-table)
+			     fdt-locale))
+  (add-spec-list-to-specifier
+   current-display-table
+   (list (cons fdt-locale
+	       (mapcar
+		#'(lambda (fdt-x)
+		    (funcall fdt-function (cdr fdt-x))
+		    fdt-x)
+		(cdar (specifier-spec-list current-display-table
+					   fdt-locale)))))))
+
+(defun standard-display-8bit-1 (dt l h)
+  (while (<= l h)
+    (aset dt l (char-to-string l))
+    (setq l (1+ l))))
+
+;;;###autoload
+(defun standard-display-8bit (l h &optional locale)
+  "Display characters in the range L to H literally."
+  (frob-display-table
+   #'(lambda (x)
+       (standard-display-8bit-1 x l h))
+   locale))
+
+(defun standard-display-default-1 (dt l h)
+  (while (<= l h)
+    (aset dt l nil)
+    (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."
+  (frob-display-table
+   #'(lambda (x)
+       (standard-display-default-1 x l h))
+   locale))
+
+;;;###autoload
+(defun standard-display-ascii (c s &optional locale)
+  "Display character C using printable string S."
+  (frob-display-table
+   #'(lambda (x)
+       (aset x c s))
+   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.
+This function assumes that your terminal uses the SO/SI characters;
+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.
+
+;;;###autoload
+(defun standard-display-graphic (c gc &optional locale)
+  "Display character C as character GC in graphics character set.
+This function assumes VT100-compatible escapes; it is meaningless for an
+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.
+
+;;;###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")))
+   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."
+  (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))
+
+(provide 'disp-table)
+
+;;; disp-table.el ends here