1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
emacs/lisp/disp-table.el

142 lines
4.8 KiB
EmacsLisp
Raw Normal View History

1992-05-30 23:54:21 +00:00
;;; disp-table.el --- functions for dealing with char tables.
1992-07-22 04:22:30 +00:00
;; Copyright (C) 1987 Free Software Foundation, Inc.
1992-07-16 21:47:34 +00:00
;; Author: Howard Gayle
;; Maintainer: FSF
1993-05-24 07:55:58 +00:00
;; Keywords: i18n
1989-10-31 16:00:07 +00:00
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
1992-07-16 21:47:34 +00:00
;; the Free Software Foundation; either version 2, or (at your option)
1989-10-31 16:00:07 +00:00
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
1992-07-16 21:47:34 +00:00
;;; Code:
1989-10-31 16:00:07 +00:00
(defun describe-display-table (dt)
1992-03-16 20:39:07 +00:00
"Describe the display table DT in a help buffer."
1989-10-31 16:00:07 +00:00
(with-output-to-temp-buffer "*Help*"
1992-06-07 04:20:03 +00:00
(princ "\nTruncation glyph: ")
1989-10-31 16:00:07 +00:00
(prin1 (aref dt 256))
1992-06-07 04:20:03 +00:00
(princ "\nWrap glyph: ")
1989-10-31 16:00:07 +00:00
(prin1 (aref dt 257))
1992-06-07 04:20:03 +00:00
(princ "\nEscape glyph: ")
1989-10-31 16:00:07 +00:00
(prin1 (aref dt 258))
1992-06-07 04:20:03 +00:00
(princ "\nCtrl glyph: ")
1989-10-31 16:00:07 +00:00
(prin1 (aref dt 259))
(princ "\nSelective display glyph sequence: ")
(prin1 (aref dt 260))
(princ "\nCharacter display glyph sequences:\n")
1989-10-31 16:00:07 +00:00
(let ((vector (make-vector 256 nil))
(i 0))
(while (< i 256)
(aset vector i (aref dt i))
1989-10-31 16:00:07 +00:00
(setq i (1+ i)))
(describe-vector vector))
(print-help-return-message)))
;;;###autoload
1989-10-31 16:00:07 +00:00
(defun describe-current-display-table ()
1992-03-16 20:39:07 +00:00
"Describe the display table in use in the selected window and buffer."
1989-10-31 16:00:07 +00:00
(interactive)
(describe-display-table
(or (window-display-table (selected-window))
buffer-display-table
standard-display-table)))
;;;###autoload
1989-10-31 16:00:07 +00:00
(defun make-display-table ()
"Return a new, empty display table."
1989-10-31 16:00:07 +00:00
(make-vector 261 nil))
;;;###autoload
1989-10-31 16:00:07 +00:00
(defun standard-display-8bit (l h)
1992-03-16 20:39:07 +00:00
"Display characters in the range L to H literally."
1989-10-31 16:00:07 +00:00
(while (<= l h)
(if (and (>= l ?\ ) (< l 127))
(if standard-display-table (aset standard-display-table l nil))
(or standard-display-table
(setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table l (vector l)))
1989-10-31 16:00:07 +00:00
(setq l (1+ l))))
;;;###autoload
(defun standard-display-default (l h)
"Display characters in the range L to H using the default notation."
(while (<= l h)
(if (and (>= l ?\ ) (< l 127))
(if standard-display-table (aset standard-display-table l nil))
(or standard-display-table
(setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table l nil))
(setq l (1+ l))))
;;;###autoload
1989-10-31 16:00:07 +00:00
(defun standard-display-ascii (c s)
"Display character C using string S."
(or standard-display-table
(setq standard-display-table (make-vector 261 nil)))
1993-04-12 07:54:04 +00:00
(aset standard-display-table c (apply 'vector (append s nil))))
1989-10-31 16:00:07 +00:00
;;;###autoload
1989-10-31 16:00:07 +00:00
(defun standard-display-g1 (c sc)
"Display character C as character SC in the g1 character set."
(or standard-display-table
(setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table c
1993-04-12 07:54:04 +00:00
(vector (create-glyph (concat "\016" (char-to-string sc) "\017")))))
1989-10-31 16:00:07 +00:00
;;;###autoload
1989-10-31 16:00:07 +00:00
(defun standard-display-graphic (c gc)
"Display character C as character GC in graphics character set."
(or standard-display-table
(setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table c
1993-04-12 07:54:04 +00:00
(vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
1989-10-31 16:00:07 +00:00
;;;###autoload
1989-10-31 16:00:07 +00:00
(defun standard-display-underline (c uc)
"Display character C as character UC plus underlining."
(or standard-display-table
(setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table c
1993-04-12 07:54:04 +00:00
(vector (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))
1992-06-07 04:20:03 +00:00
;; Allocate a glyph code to display by sending STRING to the terminal.
;;;###autoload
1992-06-07 04:20:03 +00:00
(defun create-glyph (string)
(if (= (length glyph-table) 65536)
(error "No free glyph codes remain"))
(setq glyph-table (vconcat glyph-table (list string)))
(1- (length glyph-table)))
1989-10-31 16:00:07 +00:00
;;;###autoload
(defun standard-display-european (arg)
"Toggle display of European characters encoded with ISO 8859.
When enabled, characters in the range of 160 to 255 display not
as octal escapes, but as accented characters.
With prefix argument, enable European character display iff arg is positive."
(interactive "P")
(if (or (< (prefix-numeric-value arg) 0)
(and (null arg)
(vectorp standard-display-table)
(>= (length standard-display-table) 161)
(equal (aref standard-display-table 160) [160])))
(standard-display-default 160 255)
(standard-display-8bit 160 255)))
1989-10-31 16:00:07 +00:00
(provide 'disp-table)
1992-05-30 23:54:21 +00:00
;;; disp-table.el ends here