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: i18n
   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 glyph sequence: ")
  39     (prin1 (aref dt 260))
  40     (princ "\nCharacter display glyph sequences:\n")
  41     (save-excursion
  42       (set-buffer standard-output)
  43       (let ((vector (make-vector 256 nil))
  44             (i 0))
  45         (while (< i 256)
  46           (aset vector i (aref dt i))
  47           (setq i (1+ i)))
  48         (describe-vector vector)))
  49     (print-help-return-message)))
  50
  51 ;;;###autoload
  52 (defun describe-current-display-table ()
  53   "Describe the display table in use in the selected window and buffer."
  54   (interactive)
  55   (let ((disptab
  56          (or (window-display-table (selected-window))
  57              buffer-display-table
  58              standard-display-table)))
  59     (if disptab
  60         (describe-display-table disptab)
  61       (message "No display table"))))
  62
  63 ;;;###autoload
  64 (defun make-display-table ()
  65   "Return a new, empty display table."
  66   (make-vector 261 nil))
  67
  68 ;;;###autoload
  69 (defun standard-display-8bit (l h)
  70   "Display characters in the range L to 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 (vector l)))
  77     (setq l (1+ l))))
  78
  79 ;;;###autoload
  80 (defun standard-display-default (l h)
  81   "Display characters in the range L to H using the default notation."
  82   (while (<= l h)
  83     (if (and (>= l ?\ ) (< l 127))
  84         (if standard-display-table (aset standard-display-table l nil))
  85       (or standard-display-table
  86           (setq standard-display-table (make-vector 261 nil)))
  87       (aset standard-display-table l nil))
  88     (setq l (1+ l))))
  89
  90 ;;;###autoload
  91 (defun standard-display-ascii (c s)
  92   "Display character C using string S."
  93   (or standard-display-table
  94       (setq standard-display-table (make-vector 261 nil)))
  95   (aset standard-display-table c (apply 'vector (append s nil))))
  96
  97 ;;;###autoload
  98 (defun standard-display-g1 (c sc)
  99   "Display character C as character SC in the g1 character set."
 100   (or standard-display-table
 101       (setq standard-display-table (make-vector 261 nil)))
 102   (aset standard-display-table c
 103         (vector (create-glyph (concat "\016" (char-to-string sc) "\017")))))
 104
 105 ;;;###autoload
 106 (defun standard-display-graphic (c gc)
 107   "Display character C as character GC in graphics character set."
 108   (or standard-display-table
 109       (setq standard-display-table (make-vector 261 nil)))
 110   (aset standard-display-table c
 111         (vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
 112
 113 ;;;###autoload
 114 (defun standard-display-underline (c uc)
 115   "Display character C as character UC plus underlining."
 116   (or standard-display-table
 117       (setq standard-display-table (make-vector 261 nil)))
 118   (aset standard-display-table c
 119         (vector (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))
 120
 121 ;; Allocate a glyph code to display by sending STRING to the terminal.
 122 ;;;###autoload
 123 (defun create-glyph (string)
 124   (if (= (length glyph-table) 65536)
 125       (error "No free glyph codes remain"))
 126   (setq glyph-table (vconcat glyph-table (list string)))
 127   (1- (length glyph-table)))
 128
 129 ;;;###autoload
 130 (defun standard-display-european (arg)
 131   "Toggle display of European characters encoded with ISO 8859.
 132 When enabled, characters in the range of 160 to 255 display not
 133 as octal escapes, but as accented characters.
 134 With prefix argument, enable European character display iff arg is positive."
 135   (interactive "P")
 136   (if (or (< (prefix-numeric-value arg) 0)
 137           (and (null arg)
 138                (vectorp standard-display-table)
 139                (>= (length standard-display-table) 161)
 140                (equal (aref standard-display-table 160) [160])))
 141       (standard-display-default 160 255)
 142     (standard-display-8bit 160 255)))
 143
 144 (provide 'disp-table)
 145
 146 ;;; disp-table.el ends here