フォントの設定: add-intlfonts.el

;;; add-intlfonts.el version 1.01
;;; Meadow-2.10 $B$G$N$_3NG':Q$_$G$9!#(B
;;; intlfonts $B%Q%C%1!<%8$r$"$i$+$8$a%$%s%9%H!<%k$7$F2<$5$$!#(B

;;; .emacs $B$K0J2<$N#29T$rDI2C$7$^$9!#(B
;;; "MS Gothic 16" $B$NItJ,$K$O!"(Bintlfonts $B$N(B BDF$B%U%)%s%H$r(B
;;; $BDI2C$7$?$$%U%)%s%HL>$r;XDj$7$^$9!#(B
;;; intlfonts $B$O!"<g$K(B($B9b$5(B)16$B%I%C%H$N%U%)%s%H$G9=@.$5$l$F$$$^$9!#(B
;;(load "add-intlfonts")
;;(add-intlfonts "MS Gothic 16")

(defun mw32-convert-fr-vec-to-spec (v)
  (let ((charset (char-charset (aref v 0)))
        (width (aref v 1))
        (height (aref v 2))
        (family (aref v 3))
        (weight (aref v 4))
        (slant (aref v 5))
        )
        (if (eq width 'normal) (setq width nil))
        ;(if (eq height 'any) (setq height nil))
        (if (string= family "\\*") (setq family nil))
        (if (eq weight 'normal) (setq weight nil))
        (if (eq slant 'normal) (setq slant nil))
        (delq nil 
              (list 
               :char-spec charset
               (if width :width) width
               (if height :height) height
               (if family :family) family
               (if weight :weight) weight
               (if slant :slant) slant
               )
              )
        )
  )

(defun mw32-convert-font-request-alist-back (alist)
  (setq alist (mw32-convert-font-legacy-strict-spec alist))
  (let* ((sslot (assq 'spec alist))
         (ss (cdr sslot))
         rs elem spec val)
    (while (setq elem (car ss))
      (setq spec (car elem)
            val (cdr elem))
      (if (not (vectorp spec))
          (error "Invalid Spec %S" spec))
      (setq rs (cons (cons
                      (mw32-convert-fr-vec-to-spec spec)
                      val)
                     rs))
      (setq ss (cdr ss)))
    (if rs (cons (cons 'spec (nreverse rs))
                 (delq sslot alist))
      alist)))

; bdf.el $B$N4X?t$rCV$-49$($k$N$G@h$KFI$_9~$s$G$*$/!#(B
(require 'bdf)

; fontset $B$K;XDj$5$l$?%U%)%s%HL>$N%U%)%s%H$KBP$7$F!"(B
; bdf-alist $B$KNs5s$5$l$?(B bdf $B%U%)%s%H$rDI2C$9$k!#(B
; override $B$,(B nil $B$G$J$$>l9g$O$9$G$K@_Dj$5$l$F$$$k%-%c%i%/%?%;%C%H$N(B
; $B%U%)%s%H$bCV$-49$($k!#(B
; override $B$,(B nil $B$+>JN,$5$l$?>l9g$K$O!"$9$G$K@_Dj$5$l$F$$$k(B
; $B%-%c%i%/%?%;%C%H$N%U%)%s%H$O$=$N$^$^0];}$9$k!#(B
(defun bdf-configure-fontset (fontset bdf-alist &optional override)
  "if not exist fontset, then make fontset, else return fontlist."
  (let ((exist (member fontset (w32-font-list)))
        fontlist charsets cs)
    (if exist (setq fontlist (w32-get-font-info fontset)))
    (setq fontlist (mw32-convert-font-request-alist-back fontlist))
    (setq fontlist (cdr (car fontlist)))
    (if override
        (setq fontlist 
              (delq nil 
                    (mapcar 
                     (lambda (x) 
                       (if (assoc (car (cdr (car x))) bdf-alist) nil x))
                     fontlist)))
      (dolist (x fontlist)
        (setq cs (car (cdr (car x))))
        (setq charsets (cons cs (delq cs charsets)))
        )
      )
    (dolist (x bdf-alist)
      (if (not (memq (car x) charsets))
          (setq fontlist (append fontlist (bdf-make-char-spec x))))
      )
    (setq fontlist (list (cons 'spec fontlist)))
    (if exist
        (w32-change-font fontset fontlist)
      (w32-add-font fontset fontlist))
    )
  )

; fn $B$K;XDj$5$l$?%U%)%s%HL>$N%U%)%s%H$K!"(Bintlfonts $B$N%U%)%s%H$rDI2C@_Dj$9$k!#(B
(defun add-intlfonts (fn)
  (if (not (boundp 'intlfonts-file-16dot-alist))
      (add-hook
       'after-init-hook 
       `(lambda ()
          (if (not (boundp 'intlfonts-file-16dot-alist)) nil
            (bdf-configure-fontset ,fn intlfonts-file-16dot-alist)
            (bdf-configure-fontset ,fn '((indian-1-column ("ind1c16-mule.bdf"))))
            )
          )
       )
      (bdf-configure-fontset fn intlfonts-file-16dot-alist)
      (bdf-configure-fontset fn '((indian-1-column ("ind1c16-mule.bdf"))))
      )
  )