lisp/disp-table.el

   1 ;; Functions for dealing with char tables.
   2 ;; Copyright (C) 1987 Free Software Foundation, Inc.
   3
   4 ;; This file is part of GNU Emacs.
   5
   6 ;; GNU Emacs is free software; you can redistribute it and/or modify
   7 ;; it under the terms of the GNU General Public License as published by
   8 ;; the Free Software Foundation; either version 1, or (at your option)
   9 ;; any later version.
  10
  11 ;; GNU Emacs is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;; GNU General Public License for more details.
  15
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20
  21 ;; Written by Howard Gayle.  See case-table.el for details.
  22
  23 (require 'case-table)
  24
  25 (defun rope-to-vector (rope)
  26   (let* ((len (/ (length rope) 2))
  27          (vector (make-vector len nil))
  28          (i 0))
  29     (while (< i len)
  30       (aset vector i (rope-elt rope i))
  31       (setq i (1+ i)))))
  32
  33 (defun describe-display-table (DT)
  34   "Describe the display-table DT in a help buffer."
  35   (with-output-to-temp-buffer "*Help*"
  36     (princ "\nTruncation glyf: ")
  37     (prin1 (aref dt 256))
  38     (princ "\nWrap glyf: ")
  39     (prin1 (aref dt 257))
  40     (princ "\nEscape glyf: ")
  41     (prin1 (aref dt 258))
  42     (princ "\nCtrl glyf: ")
  43     (prin1 (aref dt 259))
  44     (princ "\nSelective display rope: ")
  45     (prin1 (rope-to-vector (aref dt 260)))
  46     (princ "\nCharacter display ropes:\n")
  47     (let ((vector (make-vector 256 nil))
  48           (i 0))
  49       (while (< i 256)
  50         (aset vector i
  51               (if (stringp (aref dt i))
  52                   (rope-to-vector (aref dt i))
  53                 (aref dt i)))
  54         (setq i (1+ i)))
  55       (describe-vector vector))
  56     (print-help-return-message)))
  57
  58 (defun describe-current-display-table ()
  59    "Describe the display-table in use in the selected window and buffer."
  60    (interactive)
  61    (describe-display-table
  62     (or (window-display-table (selected-window))
  63         buffer-display-table
  64         standard-display-table)))
  65
  66 (defun make-display-table ()
  67   (make-vector 261 nil))
  68
  69 (defun standard-display-8bit (l h)
  70   "Display characters in the range [L, H] literally."
  71   (while (<= l h)
  72     (if (and (>= l ?\ ) (< l 127))
  73         (if standard-display-table (aset standard-display-table l nil))
  74       (or standard-display-table
  75           (setq standard-display-table (make-vector 261 nil)))
  76       (aset standard-display-table l l))
  77     (setq l (1+ l))))
  78
  79 (defun standard-display-ascii (c s)
  80   "Display character C using string S."
  81   (or standard-display-table
  82       (setq standard-display-table (make-vector 261 nil)))
  83   (aset standard-display-table c (apply 'make-rope (append s nil))))
  84
  85 (defun standard-display-g1 (c sc)
  86   "Display character C as character SC in the g1 character set."
  87   (or standard-display-table
  88       (setq standard-display-table (make-vector 261 nil)))
  89   (aset standard-display-table c
  90         (make-rope (create-glyf (concat "\016" (char-to-string sc) "\017")))))
  91
  92 (defun standard-display-graphic (c gc)
  93   "Display character C as character GC in graphics character set."
  94   (or standard-display-table
  95       (setq standard-display-table (make-vector 261 nil)))
  96   (aset standard-display-table c
  97         (make-rope (create-glyf (concat "\e(0" (char-to-string gc) "\e(B")))))
  98
  99 (defun standard-display-underline (c uc)
 100   "Display character C as character UC plus underlining."
 101   (or standard-display-table
 102       (setq standard-display-table (make-vector 261 nil)))
 103   (aset standard-display-table c
 104         (make-rope (create-glyf (concat "\e[4m" (char-to-string uc) "\e[m")))))
 105
 106 (defun create-glyf (string)
 107   (let ((i 256))
 108     (while (and (< i 65536) (aref glyf-table i)
 109                 (not (string= (aref glyf-table i) string)))
 110       (setq i (1+ i)))
 111     (if (= i 65536)
 112         (error "No free glyf codes remain"))
 113     (aset glyf-table i string)))
 114
 115 (provide 'disp-table)