;;; add-intlfonts.el version 1.01
;;; Meadow-2.10 でのみ確認済みです。
;;; intlfonts パッケージをあらかじめインストールして下さい。

;;; .emacs に以下の２行を追加します。
;;; "MS Gothic 16" の部分には、intlfonts の BDFフォントを
;;; 追加したいフォント名を指定します。
;;; intlfonts は、主に(高さ)16ドットのフォントで構成されています。
;;(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 の関数を置き換えるので先に読み込んでおく。
(require 'bdf)

; fontset に指定されたフォント名のフォントに対して、
; bdf-alist に列挙された bdf フォントを追加する。
; override が nil でない場合はすでに設定されているキャラクタセットの
; フォントも置き換える。
; override が nil か省略された場合には、すでに設定されている
; キャラクタセットのフォントはそのまま維持する。
(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 に指定されたフォント名のフォントに、intlfonts のフォントを追加設定する。
(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"))))
      )
  )