Mercurial > hg > xemacs-beta
view lisp/tl/char-table.el @ 98:0d2f883870bc r20-1b1
Import from CVS: tag r20-1b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:13:56 +0200 |
parents | 364816949b59 |
children | 85ec50267440 |
line wrap: on
line source
;;; char-table.el --- display table of charset ;; Copyright (C) 1996,1997 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Version: $Id: char-table.el,v 1.2 1997/02/15 22:21:24 steve Exp $ ;; Keywords: character, Emacs/mule ;; This file is not part of tl (Tiny Library). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 2, or (at ;; your option) any later version. ;; This program 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, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Code: (defun char-position-to-string (charset r l &optional plane) (char-to-string (if plane (make-char charset plane (+ (* r 16) l)) (make-char charset (+ (* r 16) l)) ))) (defun char-table-1 (charset r l plane) (let ((str (char-position-to-string charset r l plane))) (concat (let ((i 0) (len (- 3 (string-columns str))) (dest "")) (while (< i len) (setq dest (concat dest " ")) (setq i (1+ i)) ) dest) str))) (defun show-94-table (charset &optional plane ofs) (if (null ofs) (setq ofs 0) ) (princ "======================================================\n") (princ (format "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n" (or plane 0))) (princ "-----+------------------------------------------------\n") (let ((j 2)) (princ (format "%2x%x : " (or plane 0) (* (+ j ofs) 16))) (let ((k 1)) (while (< k 16) (princ (char-table-1 charset j k plane)) (setq k (+ k 1)) ) (princ "\n") ) (setq j 3) (while (< j 7) (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16))) (let ((k 0)) (while (< k 16) (princ (char-table-1 charset j k plane)) (setq k (+ k 1)) ) (princ "\n") ) (setq j (+ j 1)) ) (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16))) (let ((k 0)) (while (< k 15) (princ (char-table-1 charset j k plane)) (setq k (+ k 1)) ) (princ "\n") ) )) (defun show-96-table (charset &optional plane ofs) (if (null ofs) (setq ofs 0) ) (princ "======================================================\n") (princ (format "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n" (or plane 0))) (princ "-----+------------------------------------------------\n") (let ((j 2)) (while (< j 8) (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16))) (let ((k 0)) (while (< k 16) (princ (char-table-1 charset j k plane)) (setq k (+ k 1)) ) (princ "\n") ) (setq j (1+ j)) ))) (defun show-94x94-table (charset) (let ((i 33)) (while (< i 127) (show-94-table charset i) (setq i (1+ i)) ))) (defun show-96x96-table (charset) (let ((i 32)) (while (< i 128) (show-96-table charset i) (setq i (1+ i)) ))) (defun show-char-table (charset) (let ((cc (charset-chars charset)) (cd (charset-dimension charset)) ) (cond ((= cd 1) (cond ((= cc 94) (show-94-table charset) ) ((= cc 96) (show-96-table charset) )) ) ((= cd 2) (cond ((= cc 94) (show-94x94-table charset) ) ((= cc 96) (show-96x96-table charset) )) )))) ;;; @ end ;;; (provide 'char-table) ;;; char-table.el ends here