cgit.sxemacs.org Git - sxemacs/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 SXEmacs.
   9 ;;
  10 ;; SXEmacs 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 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; SXEmacs 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 this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 ;;; Work around what is arguably a Sun CDE bug.
  28
  29 (defun x-use-halfwidth-roman-font (fullwidth-charset roman-registry)
  30   "Maybe set charset registry of the 'ascii charset to ROMAN-REGISTRY.
  31
  32 Do this only if:
  33  - the current display is an X device
  34  - the displayed width of FULLWIDTH-CHARSET is twice the displayed
  35    width of the 'ascii charset, but only when using ROMAN-REGISTRY.
  36
  37 Traditionally, Asian characters have been displayed so that they
  38 occupy exactly twice the screen space of ASCII (`halfwidth')
  39 characters.  On many systems, e.g. Sun CDE systems, this can only be
  40 achieved by using a national variant roman font to display ASCII."
  41   (let* ((charset-font-width
  42           (lambda (charset)
  43             (font-instance-width
  44              (face-font-instance 'default (selected-device) charset))))
  45
  46          (twice-as-wide
  47           (lambda (cs1 cs2)
  48             (let ((width1 (funcall charset-font-width cs1))
  49                   (width2 (funcall charset-font-width cs2)))
  50               (and width1 width2 (eq (+ width1 width1) width2))))))
  51
  52     (when (eq 'x (device-type))
  53       (condition-case nil
  54           (unless (funcall twice-as-wide 'ascii fullwidth-charset)
  55             (set-charset-registry 'ascii roman-registry)
  56             (unless (funcall twice-as-wide 'ascii fullwidth-charset)
  57               ;; Restore if roman-registry didn't help
  58               (set-charset-registry 'ascii "iso8859-1")))
  59         (error (set-charset-registry 'ascii "iso8859-1"))))))
  60
  61 ;;;;
  62
  63 (defvar mule-x-win-initted nil)
  64
  65 (defun init-mule-x-win ()
  66   "Initialize X Windows for MULE at startup.  Don't call this."
  67   (when (not mule-x-win-initted)
  68     (define-specifier-tag 'mule-fonts
  69       (lambda (device) (eq 'x (device-type device))))
  70
  71     (set-face-font
  72      'default
  73      '("-*-fixed-medium-r-*--16-*-iso8859-1"
  74        "-*-fixed-medium-r-*--*-iso8859-1"
  75        "-*-fixed-medium-r-*--*-iso8859-2"
  76        "-*-fixed-medium-r-*--*-iso8859-3"
  77        "-*-fixed-medium-r-*--*-iso8859-4"
  78        "-*-fixed-medium-r-*--*-iso8859-7"
  79        "-*-fixed-medium-r-*--*-iso8859-8"
  80        "-*-fixed-medium-r-*--*-iso8859-5"
  81        "-*-fixed-medium-r-*--*-iso8859-9"
  82
  83        ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun
  84        "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0"
  85        "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0"
  86        "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0"
  87        ;; Other Japanese fonts
  88        "-*-fixed-medium-r-*--*-jisx0201.1976-*"
  89        "-*-fixed-medium-r-*--*-jisx0208.1983-*"
  90        "-*-fixed-medium-r-*--*-jisx0212*-*"
  91
  92        ;; Chinese fonts
  93        "-*-*-medium-r-*--*-gb2312.1980-*"
  94
  95        ;; Use One font specification for CNS chinese
  96        ;; Too many variations in font naming
  97        "-*-fixed-medium-r-*--*-cns11643*-*"
  98        ;; "-*-fixed-medium-r-*--*-cns11643*2"
  99        ;; "-*-fixed-medium-r-*--*-cns11643*3"
 100        ;; "-*-fixed-medium-r-*--*-cns11643*4"
 101        ;; "-*-fixed-medium-r-*--*-cns11643.5-0"
 102        ;; "-*-fixed-medium-r-*--*-cns11643.6-0"
 103        ;; "-*-fixed-medium-r-*--*-cns11643.7-0"
 104
 105        "-*-fixed-medium-r-*--*-big5*-*"
 106        "-*-fixed-medium-r-*--*-sisheng_cwnn-0"
 107
 108        ;; Other fonts
 109
 110        ;; "-*-fixed-medium-r-*--*-viscii1.1-1"
 111
 112        ;; "-*-fixed-medium-r-*--*-mulearabic-0"
 113        ;; "-*-fixed-medium-r-*--*-mulearabic-1"
 114        ;; "-*-fixed-medium-r-*--*-mulearabic-2"
 115
 116        ;; "-*-fixed-medium-r-*--*-muleipa-1"
 117        ;; "-*-fixed-medium-r-*--*-ethio-*"
 118
 119        "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean
 120        "-*-fixed-medium-r-*--*-tis620.2529-1"   ; Thai
 121        )
 122      'global '(mule-fonts) 'append)
 123
 124     (setq mule-x-win-initted t)))