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 describe-display-table (dt)
  28   "Describe the display table DT in a help buffer."
  29   (with-output-to-temp-buffer "*Help*"
  30     (princ "\nTruncation glyph: ")
  31     (prin1 (aref dt 256))
  32     (princ "\nWrap glyph: ")
  33     (prin1 (aref dt 257))
  34     (princ "\nEscape glyph: ")
  35     (prin1 (aref dt 258))
  36     (princ "\nCtrl glyph: ")
  37     (prin1 (aref dt 259))
  38     (princ "\nSelective display rope: ")
  39     (prin1 (aref dt 260))
  40     (princ "\nCharacter display ropes:\n")
  41     (let ((vector (make-vector 256 nil))
  42           (i 0))
  43       (while (< i 256)
  44         (aset vector i (aref dt i))
  45         (setq i (1+ i)))
  46       (describe-vector vector))
  47     (print-help-return-message)))
  48
  49 ;;;###autoload
  50 (defun describe-current-display-table ()
  51    "Describe the display table in use in the selected window and buffer."
  52    (interactive)
  53    (describe-display-table
  54     (or (window-display-table (selected-window))
  55         buffer-display-table
  56         standard-display-table)))
  57
  58 ;;;###autoload
  59 (defun make-display-table ()
  60   "Return a new, empty display table."
  61   (make-vector 261 nil))
  62
  63 ;;;###autoload
  64 (defun standard-display-8bit (l h)
  65   "Display characters in the range L to H literally."
  66   (while (<= l h)
  67     (if (and (>= l ?\ ) (< l 127))
  68         (if standard-display-table (aset standard-display-table l nil))
  69       (or standard-display-table
  70           (setq standard-display-table (make-vector 261 nil)))
  71       (aset standard-display-table l l))
  72     (setq l (1+ l))))
  73
  74 ;;;###autoload
  75 (defun standard-display-ascii (c s)
  76   "Display character C using string S."
  77   (or standard-display-table
  78       (setq standard-display-table (make-vector 261 nil)))
  79   (aset standard-display-table c (apply 'make-rope (append s nil))))
  80
  81 ;;;###autoload
  82 (defun standard-display-g1 (c sc)
  83   "Display character C as character SC in the g1 character set."
  84   (or standard-display-table
  85       (setq standard-display-table (make-vector 261 nil)))
  86   (aset standard-display-table c
  87         (make-rope (create-glyph (concat "\016" (char-to-string sc) "\017")))))
  88
  89 ;;;###autoload
  90 (defun standard-display-graphic (c gc)
  91   "Display character C as character GC in graphics character set."
  92   (or standard-display-table
  93       (setq standard-display-table (make-vector 261 nil)))
  94   (aset standard-display-table c
  95         (make-rope (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
  96
  97 ;;;###autoload
  98 (defun standard-display-underline (c uc)
  99   "Display character C as character UC plus underlining."
 100   (or standard-display-table
 101       (setq standard-display-table (make-vector 261 nil)))
 102   (aset standard-display-table c
 103         (make-rope (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))
 104
 105 ;; Allocate a glyph code to display by sending STRING to the terminal.
 106 ;;;###autoload
 107 (defun create-glyph (string)
 108   (if (= (length glyph-table) 65536)
 109       (error "No free glyph codes remain"))
 110   (setq glyph-table (vconcat glyph-table (list string)))
 111   (1- (length glyph-table)))
 112
 113 (provide 'disp-table)
 114
 115 ;;; disp-table.el ends here