| 1 |
;;; add-intlfonts.el version 1.01 |
|---|
| 2 |
;;; Meadow-2.10 $B$G$N$_3NG':Q$_$G$9!#(B |
|---|
| 3 |
;;; intlfonts $B%Q%C%1!<%8$r$"$i$+$8$a%$%s%9%H!<%k$7$F2<$5$$!#(B |
|---|
| 4 |
|
|---|
| 5 |
;;; .emacs $B$K0J2<$N#29T$rDI2C$7$^$9!#(B |
|---|
| 6 |
;;; "MS Gothic 16" $B$NItJ,$K$O!"(Bintlfonts $B$N(B BDF$B%U%)%s%H$r(B |
|---|
| 7 |
;;; $BDI2C$7$?$$%U%)%s%HL>$r;XDj$7$^$9!#(B |
|---|
| 8 |
;;; intlfonts $B$O!"<g$K(B($B9b$5(B)16$B%I%C%H$N%U%)%s%H$G9=@.$5$l$F$$$^$9!#(B |
|---|
| 9 |
;;(load "add-intlfonts") |
|---|
| 10 |
;;(add-intlfonts "MS Gothic 16") |
|---|
| 11 |
|
|---|
| 12 |
(defun mw32-convert-fr-vec-to-spec (v) |
|---|
| 13 |
(let ((charset (char-charset (aref v 0))) |
|---|
| 14 |
(width (aref v 1)) |
|---|
| 15 |
(height (aref v 2)) |
|---|
| 16 |
(family (aref v 3)) |
|---|
| 17 |
(weight (aref v 4)) |
|---|
| 18 |
(slant (aref v 5)) |
|---|
| 19 |
) |
|---|
| 20 |
(if (eq width 'normal) (setq width nil)) |
|---|
| 21 |
;(if (eq height 'any) (setq height nil)) |
|---|
| 22 |
(if (string= family "\\*") (setq family nil)) |
|---|
| 23 |
(if (eq weight 'normal) (setq weight nil)) |
|---|
| 24 |
(if (eq slant 'normal) (setq slant nil)) |
|---|
| 25 |
(delq nil |
|---|
| 26 |
(list |
|---|
| 27 |
:char-spec charset |
|---|
| 28 |
(if width :width) width |
|---|
| 29 |
(if height :height) height |
|---|
| 30 |
(if family :family) family |
|---|
| 31 |
(if weight :weight) weight |
|---|
| 32 |
(if slant :slant) slant |
|---|
| 33 |
) |
|---|
| 34 |
) |
|---|
| 35 |
) |
|---|
| 36 |
) |
|---|
| 37 |
|
|---|
| 38 |
(defun mw32-convert-font-request-alist-back (alist) |
|---|
| 39 |
(setq alist (mw32-convert-font-legacy-strict-spec alist)) |
|---|
| 40 |
(let* ((sslot (assq 'spec alist)) |
|---|
| 41 |
(ss (cdr sslot)) |
|---|
| 42 |
rs elem spec val) |
|---|
| 43 |
(while (setq elem (car ss)) |
|---|
| 44 |
(setq spec (car elem) |
|---|
| 45 |
val (cdr elem)) |
|---|
| 46 |
(if (not (vectorp spec)) |
|---|
| 47 |
(error "Invalid Spec %S" spec)) |
|---|
| 48 |
(setq rs (cons (cons |
|---|
| 49 |
(mw32-convert-fr-vec-to-spec spec) |
|---|
| 50 |
val) |
|---|
| 51 |
rs)) |
|---|
| 52 |
(setq ss (cdr ss))) |
|---|
| 53 |
(if rs (cons (cons 'spec (nreverse rs)) |
|---|
| 54 |
(delq sslot alist)) |
|---|
| 55 |
alist))) |
|---|
| 56 |
|
|---|
| 57 |
; bdf.el $B$N4X?t$rCV$-49$($k$N$G@h$KFI$_9~$s$G$*$/!#(B |
|---|
| 58 |
(require 'bdf) |
|---|
| 59 |
|
|---|
| 60 |
; fontset $B$K;XDj$5$l$?%U%)%s%HL>$N%U%)%s%H$KBP$7$F!"(B |
|---|
| 61 |
; bdf-alist $B$KNs5s$5$l$?(B bdf $B%U%)%s%H$rDI2C$9$k!#(B |
|---|
| 62 |
; override $B$,(B nil $B$G$J$$>l9g$O$9$G$K@_Dj$5$l$F$$$k%-%c%i%/%?%;%C%H$N(B |
|---|
| 63 |
; $B%U%)%s%H$bCV$-49$($k!#(B |
|---|
| 64 |
; override $B$,(B nil $B$+>JN,$5$l$?>l9g$K$O!"$9$G$K@_Dj$5$l$F$$$k(B |
|---|
| 65 |
; $B%-%c%i%/%?%;%C%H$N%U%)%s%H$O$=$N$^$^0];}$9$k!#(B |
|---|
| 66 |
(defun bdf-configure-fontset (fontset bdf-alist &optional override) |
|---|
| 67 |
"if not exist fontset, then make fontset, else return fontlist." |
|---|
| 68 |
(let ((exist (member fontset (w32-font-list))) |
|---|
| 69 |
fontlist charsets cs) |
|---|
| 70 |
(if exist (setq fontlist (w32-get-font-info fontset))) |
|---|
| 71 |
(setq fontlist (mw32-convert-font-request-alist-back fontlist)) |
|---|
| 72 |
(setq fontlist (cdr (car fontlist))) |
|---|
| 73 |
(if override |
|---|
| 74 |
(setq fontlist |
|---|
| 75 |
(delq nil |
|---|
| 76 |
(mapcar |
|---|
| 77 |
(lambda (x) |
|---|
| 78 |
(if (assoc (car (cdr (car x))) bdf-alist) nil x)) |
|---|
| 79 |
fontlist))) |
|---|
| 80 |
(dolist (x fontlist) |
|---|
| 81 |
(setq cs (car (cdr (car x)))) |
|---|
| 82 |
(setq charsets (cons cs (delq cs charsets))) |
|---|
| 83 |
) |
|---|
| 84 |
) |
|---|
| 85 |
(dolist (x bdf-alist) |
|---|
| 86 |
(if (not (memq (car x) charsets)) |
|---|
| 87 |
(setq fontlist (append fontlist (bdf-make-char-spec x)))) |
|---|
| 88 |
) |
|---|
| 89 |
(setq fontlist (list (cons 'spec fontlist))) |
|---|
| 90 |
(if exist |
|---|
| 91 |
(w32-change-font fontset fontlist) |
|---|
| 92 |
(w32-add-font fontset fontlist)) |
|---|
| 93 |
) |
|---|
| 94 |
) |
|---|
| 95 |
|
|---|
| 96 |
; 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 |
|---|
| 97 |
(defun add-intlfonts (fn) |
|---|
| 98 |
(if (not (boundp 'intlfonts-file-16dot-alist)) |
|---|
| 99 |
(add-hook |
|---|
| 100 |
'after-init-hook |
|---|
| 101 |
`(lambda () |
|---|
| 102 |
(if (not (boundp 'intlfonts-file-16dot-alist)) nil |
|---|
| 103 |
(bdf-configure-fontset ,fn intlfonts-file-16dot-alist) |
|---|
| 104 |
(bdf-configure-fontset ,fn '((indian-1-column ("ind1c16-mule.bdf")))) |
|---|
| 105 |
) |
|---|
| 106 |
) |
|---|
| 107 |
) |
|---|
| 108 |
(bdf-configure-fontset fn intlfonts-file-16dot-alist) |
|---|
| 109 |
(bdf-configure-fontset fn '((indian-1-column ("ind1c16-mule.bdf")))) |
|---|
| 110 |
) |
|---|
| 111 |
) |
|---|