git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/mule/mule-x-init.el

   1 ;;; mule-x-init.el --- initialization code for X Windows under MULE
   2 ;; Copyright (C) 1994 Free Software Foundation, Inc.
   3 ;; Copyright (C) 1996 Ben Wing <ben@xemacs.org>
   4
   5 ;; Author: various
   6 ;; Keywords: mule X11
   7
   8 ;; This file is part of XEmacs.
   9 ;;
  10 ;; XEmacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; XEmacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with XEmacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 ;;; Work around what is arguably a Sun CDE bug.
  30
  31 (defun x-use-halfwidth-roman-font (fullwidth-charset roman-registry)
  32   "Maybe set charset registry of the 'ascii charset to ROMAN-REGISTRY.
  33
  34 Do this only if:
  35  - the current display is an X device
  36  - the displayed width of FULLWIDTH-CHARSET is twice the displayed
  37    width of the 'ascii charset, but only when using ROMAN-REGISTRY.
  38
  39 Traditionally, Asian characters have been displayed so that they
  40 occupy exactly twice the screen space of ASCII (`halfwidth')
  41 characters.  On many systems, e.g. Sun CDE systems, this can only be
  42 achieved by using a national variant roman font to display ASCII."
  43   (let* ((charset-font-width
  44           (lambda (charset)
  45             (font-instance-width
  46              (face-font-instance 'default (selected-device) charset))))
  47
  48          (twice-as-wide
  49           (lambda (cs1 cs2)
  50             (let ((width1 (funcall charset-font-width cs1))
  51                   (width2 (funcall charset-font-width cs2)))
  52               (and width1 width2 (eq (+ width1 width1) width2))))))
  53
  54     (when (eq 'x (device-type))
  55       (condition-case nil
  56           (unless (funcall twice-as-wide 'ascii fullwidth-charset)
  57             (set-charset-registry 'ascii roman-registry)
  58             (unless (funcall twice-as-wide 'ascii fullwidth-charset)
  59               ;; Restore if roman-registry didn't help
  60               (set-charset-registry 'ascii "iso8859-1")))
  61         (error (set-charset-registry 'ascii "iso8859-1"))))))
  62
  63 ;;;;
  64
  65 (defvar mule-x-win-initted nil)
  66
  67 (defun init-mule-x-win ()
  68   "Initialize X Windows for MULE at startup.  Don't call this."
  69   (when (not mule-x-win-initted)
  70     (define-specifier-tag 'mule-fonts
  71       (lambda (device) (eq 'x (device-type device))))
  72
  73     (set-face-font
  74      'default
  75      '("-*-fixed-medium-r-*--16-*-iso8859-1"
  76        "-*-fixed-medium-r-*--*-iso8859-1"
  77        "-*-fixed-medium-r-*--*-iso8859-2"
  78        "-*-fixed-medium-r-*--*-iso8859-3"
  79        "-*-fixed-medium-r-*--*-iso8859-4"
  80        "-*-fixed-medium-r-*--*-iso8859-7"
  81        "-*-fixed-medium-r-*--*-iso8859-8"
  82        "-*-fixed-medium-r-*--*-iso8859-5"
  83        "-*-fixed-medium-r-*--*-iso8859-9"
  84
  85        ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun
  86        "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0"
  87        "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0"
  88        "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0"
  89        ;; Other Japanese fonts
  90        "-*-fixed-medium-r-*--*-jisx0201.1976-*"
  91        "-*-fixed-medium-r-*--*-jisx0208.1983-*"
  92        "-*-fixed-medium-r-*--*-jisx0212*-*"
  93
  94        ;; Chinese fonts
  95        "-*-*-medium-r-*--*-gb2312.1980-*"
  96
  97        ;; Use One font specification for CNS chinese
  98        ;; Too many variations in font naming
  99        "-*-fixed-medium-r-*--*-cns11643*-*"
 100        ;; "-*-fixed-medium-r-*--*-cns11643*2"
 101        ;; "-*-fixed-medium-r-*--*-cns11643*3"
 102        ;; "-*-fixed-medium-r-*--*-cns11643*4"
 103        ;; "-*-fixed-medium-r-*--*-cns11643.5-0"
 104        ;; "-*-fixed-medium-r-*--*-cns11643.6-0"
 105        ;; "-*-fixed-medium-r-*--*-cns11643.7-0"
 106
 107        "-*-fixed-medium-r-*--*-big5*-*"
 108        "-*-fixed-medium-r-*--*-sisheng_cwnn-0"
 109
 110        ;; Other fonts
 111
 112        ;; "-*-fixed-medium-r-*--*-viscii1.1-1"
 113
 114        ;; "-*-fixed-medium-r-*--*-mulearabic-0"
 115        ;; "-*-fixed-medium-r-*--*-mulearabic-1"
 116        ;; "-*-fixed-medium-r-*--*-mulearabic-2"
 117
 118        ;; "-*-fixed-medium-r-*--*-muleipa-1"
 119        ;; "-*-fixed-medium-r-*--*-ethio-*"
 120
 121        "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean
 122        "-*-fixed-medium-r-*--*-tis620.2529-1"   ; Thai
 123        )
 124      'global '(mule-fonts) 'append)
 125
 126     (setq mule-x-win-initted t)))