lisp/disp-table.el

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