code.delx.au - gnu-emacs/blob - lisp/disp-table.el

   1 ;;; disp-table.el --- functions for dealing with char tables.
   2
   3 ;; Copyright (C) 1987, 1994 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 S is usually a terminal-dependent escape sequence.
  94 This function is meaningless for an X frame."
  95   (if window-system
  96       (error "Cannot use string glyphs in a windowing system"))
  97   (or standard-display-table
  98       (setq standard-display-table (make-vector 261 nil)))
  99   (aset standard-display-table c (apply 'vector (append s nil))))
 100
 101 ;;;###autoload
 102 (defun standard-display-g1 (c sc)
 103   "Display character C as character SC in the g1 character set.
 104 This function assumes that your terminal uses the SO/SI characters;
 105 it is meaningless for an X frame."
 106   (if window-system
 107       (error "Cannot use string glyphs in a windowing system"))
 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 "\016" (char-to-string sc) "\017")))))
 112
 113 ;;;###autoload
 114 (defun standard-display-graphic (c gc)
 115   "Display character C as character GC in graphics character set.
 116 This function assumes VT100-compatible escapes; it is meaningless for an
 117 X frame."
 118   (if window-system
 119       (error "Cannot use string glyphs in a windowing system"))
 120   (or standard-display-table
 121       (setq standard-display-table (make-vector 261 nil)))
 122   (aset standard-display-table c
 123         (vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
 124
 125 ;;;###autoload
 126 (defun standard-display-underline (c uc)
 127   "Display character C as character UC plus underlining."
 128   (if window-system (require 'faces))
 129   (or standard-display-table
 130       (setq standard-display-table (make-vector 261 nil)))
 131   (aset standard-display-table c
 132         (vector
 133          (if window-system
 134              (logior uc (lsh (face-id (internal-find-face 'underline)) 8))
 135            (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))))
 136
 137 ;; Allocate a glyph code to display by sending STRING to the terminal.
 138 ;;;###autoload
 139 (defun create-glyph (string)
 140   (if (= (length glyph-table) 65536)
 141       (error "No free glyph codes remain"))
 142   ;; Don't use slots that correspond to ASCII characters.
 143   (if (= (length glyph-table) 32)
 144       (setq glyph-table (vconcat glyph-table (make-vector 224 nil))))
 145   (setq glyph-table (vconcat glyph-table (list string)))
 146   (1- (length glyph-table)))
 147
 148 ;;;###autoload
 149 (defun standard-display-european (arg)
 150   "Toggle display of European characters encoded with ISO 8859.
 151 When enabled, characters in the range of 160 to 255 display not
 152 as octal escapes, but as accented characters.
 153 With prefix argument, enable European character display iff arg is positive."
 154   (interactive "P")
 155   (if (or (< (prefix-numeric-value arg) 0)
 156           (and (null arg)
 157                (vectorp standard-display-table)
 158                (>= (length standard-display-table) 161)
 159                (equal (aref standard-display-table 160) [160])))
 160       (standard-display-default 160 255)
 161     (standard-display-8bit 160 255)))
 162
 163 (provide 'disp-table)
 164
 165 ;;; disp-table.el ends here