cgit.sxemacs.org Git - packages/blob - mule-packages/mule-base/chartblxmas.el

   1 ;;; chartblxmas.el --- display table of charset by pop-up menu
   2
   3 ;; Copyright (C) 1997 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: chartblxmas.el,v 1.1.1.1 1998-01-14 06:35:19 steve Exp $
   7 ;; Keywords: character, XEmacs/mule
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; 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 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24 ;; 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (require 'alist)
  29 (require 'char-table)
  30
  31 (defun classify-charsets-by-dimension-and-chars (charset-list)
  32   (let (dest)
  33     (while charset-list
  34       (let* ((charset (car charset-list))
  35              (chars (charset-chars charset))
  36              (dim (charset-dimension charset))
  37              (dim-alist (cdr (assq dim dest)))
  38              )
  39         (setq dest
  40               (put-alist dim
  41                          (put-alist chars
  42                                     (cons charset
  43                                           (cdr (assq chars dim-alist)))
  44                                     dim-alist)
  45                          dest))
  46         )
  47       (setq charset-list (cdr charset-list))
  48       )
  49     dest))
  50
  51
  52 ;;;###autoload
  53 (defun view-charset-by-menu ()
  54   "Display character table of CHARSET by pop-up menu."
  55   (interactive)
  56   (popup-menu
  57    (cons
  58     "Character set:"
  59     (mapcar (function
  60              (lambda (cat)
  61                (cons (car cat)
  62                      (sort
  63                       (mapcar (function
  64                                (lambda (charset)
  65                                  (vector (charset-doc-string charset)
  66                                          `(view-charset ',charset)
  67                                          t)
  68                                  ))
  69                               (cdr cat))
  70                       (function
  71                        (lambda (a b)
  72                          (string< (aref a 0)(aref b 0))
  73                          ))))))
  74             (sort
  75              (let ((rest
  76                     (classify-charsets-by-dimension-and-chars (charset-list))
  77                     ))
  78                (while rest
  79                  (let* ((r (car rest))
  80                         (d (car r)))
  81                    (setq r (cdr r))
  82                    (while r
  83                      (let* ((p (car r))
  84                             (n (int-to-string (car p)))
  85                             (s n)
  86                             (i 1))
  87                        (while (< i d)
  88                          (setq s (concat s " x " n))
  89                          (setq i (1+ i)))
  90                        (set-alist 'dest (concat s " character set") (cdr p)))
  91                      (setq r (cdr r))
  92                      ))
  93                  (setq rest (cdr rest)))
  94                dest)
  95              (function (lambda (a b)
  96                          (string< (car a)(car b))
  97                          )))
  98             ))))
  99
 100 ;;; chartblxmas.el ends here