[Message Prev][Message Next][Thread Prev][Thread Next][Message Index][Thread Index]
[MD:593] bdf font
- X-ml-count: 593
- Subject: [MD:593] bdf font
- From: YAMAMOTO Akishige <yamamoto@xxxxxxxxx>
- Date: 15 Mar 1998 05:44:13 +0900
- X-mailer: Semi-gnus 6.0.8 (based on Quassia Gnus v0.34)
Yoshiki Hayashi <penny@xxxxxxxxxxxxxxxx> writes:
> しかし、ここがxlfdで無いと、どうやって判定して良いのか分からないので、
> xlfdであると仮定して、やまもとさんのコードを参考にしながら、
> bdf-font-listを作成とupdateする関数を力ずくで書いてみました。
> 適当に自分の好みで変数名などを変更しています。とりあえずは動きます。
> でも、非常に遅いです。その上、elispを書く力がないので、とても汚いコー
> ドになっています。
ぐぇぇ、バッティングしてしまいました。私もゴリゴリ書いてました^^;;
私は、himi さんからも、w32-get-logfont-info をいじっても良いというお
許しが出たので(?)、そっちのアプローチで進めてしまいました。それと、
timestamp による最適化の話も出てたので、そちらも。
まずは、w32-get-logfont-info で registry, encoding, slant,
setwidth_name が得られるようにする、パッチを添付しておきます。
# lexical なルールが不明だったので、ちょっと怪しいところがあるかもしれ
# ません。この実装だと、単純にダブルクオート間を文字列としてます。まあ、
# そうで無い場合は、必ず空文字列を返すので、問題無いとは、思いますが。
次に、高速化についてですが、
o キャッシュファイルには、各フォントファイルにつき
(filename timestamp fontinfo)
を格納した、alist をもたせます。更新時は、timestamp を比較し、
w32-get-logfont-info を出来る限り行わないようにする。
o charset を求める作業もコストが高いので、fontinfo alist の中にキャッ
シュするようにする。
o charset 用の bdf を求める作業は、どうせすべての charset について発生
する為、更新時に charset の property list に格納するようにする。
o 後は姑息に macro。(高速化というより、可読性向上と云う意味の方が多
いですが)
こんな、感じです。それなりに、高速化したと思います。これ以上早くした
いとなると、検索結果自体のキャッシュですね。
ところで、w32-get-logfont-info に memory leak があるようです。(一回
の query で 4k 程度) しかし、コードを読んでも memory leak なコードは
発見出来ませんでした。何なんでしょう? gc がらみ? あっ、一応言ってお
きますが、下のパッチをあてる前の症状です。
;; やまもと
--- mw32bdf.h.orig Sat Mar 14 02:28:29 1998
+++ mw32bdf.h Sat Mar 14 02:51:31 1998
@@ -31,6 +31,15 @@
int relative_compose;
int default_ascent;
+ unsigned char *registry;
+ int nregistry;
+ unsigned char *encoding;
+ int nencoding;
+ unsigned char *slant;
+ int nslant;
+ unsigned char *width;
+ int nwidth;
+
}bdffont;
#define BDF_FILE_SIZE_MAX 256*1024*1024 /* 256Mb */
--- mw32bdf.c.orig Thu Mar 05 01:43:02 1998
+++ mw32bdf.c Sun Mar 15 03:23:20 1998
@@ -68,7 +68,32 @@
if (flag == -1) return 0;
return 1;
}
-
+
+void
+get_quoted_contents(char *start, char *end, char **val, int *nval)
+{
+ while (*start != '\"')
+ {
+ if (++start > end)
+ {
+ *val = 0;
+ *nval = 0;
+ return;
+ }
+ }
+ *val = ++start;
+ while (*start != '\"')
+ {
+ if (++start > end)
+ {
+ *val = 0;
+ *nval = 0;
+ return;
+ }
+ }
+ *nval = start - *val;
+}
+
static int
set_bdf_font_info(bdffont *fontp)
{
@@ -84,6 +109,15 @@
fontp->relative_compose = 0;
fontp->default_ascent = 0;
+ fontp->registry = 0;
+ fontp->nregistry = 0;
+ fontp->encoding = 0;
+ fontp->nencoding = 0;
+ fontp->slant = 0;
+ fontp->nslant = 0;
+ fontp->width = 0;
+ fontp->nwidth = 0;
+
flag = proceed_file_line("FONTBOUNDINGBOX", start, &len, &p, &q);
if (!flag) return 0;
bbw = strtol(p, &start, 10);
@@ -103,6 +137,7 @@
flag = proceed_file_line("STARTPROPERTIES", start, &len, &p, &q);
if (!flag) return 1;
+ flag = 0;
do {
start = q;
if (search_file_line("PIXEL_SIZE", start, len, &p, &q) == 1)
@@ -134,6 +169,22 @@
val1 = atoi(p);
fontp->default_ascent = val1;
}
+ else if (search_file_line("CHARSET_REGISTRY", start, len, &p, &q) == 1)
+ {
+ get_quoted_contents(p, q, &fontp->registry, &fontp->nregistry);
+ }
+ else if (search_file_line("CHARSET_ENCODING", start, len, &p, &q) == 1)
+ {
+ get_quoted_contents(p, q, &fontp->encoding, &fontp->nencoding);
+ }
+ else if (search_file_line("SLANT", start, len, &p, &q) == 1)
+ {
+ get_quoted_contents(p, q, &fontp->slant, &fontp->nslant);
+ }
+ else if (search_file_line("SETWIDTH_NAME", start, len, &p, &q) == 1)
+ {
+ get_quoted_contents(p, q, &fontp->width, &fontp->nwidth);
+ }
else
{
flag = search_file_line("ENDPROPERTIES", start, len, &p, &q);
@@ -241,6 +292,14 @@
make_number(bdffontp->relative_compose));
store_in_alist(&ret, intern("default-ascent"),
make_number(bdffontp->default_ascent));
+ store_in_alist(&ret, intern("charset-registry"),
+ make_string(bdffontp->registry, bdffontp->nregistry));
+ store_in_alist(&ret, intern("charset-encoding"),
+ make_string(bdffontp->encoding, bdffontp->nencoding));
+ store_in_alist(&ret, intern("slant"),
+ make_string(bdffontp->slant, bdffontp->nslant));
+ store_in_alist(&ret, intern("setwidth-name"),
+ make_string(bdffontp->width, bdffontp->nwidth));
mw32_free_bdf_font(bdffontp);
(defvar w32-bdf-font-directory "d:/fonts")
(defvar w32-bdf-database nil)
(defvar w32-bdf-database-filename "~/.bdfdb")
(defmacro time-newer-than-time-p (time1 time2)
`(or (> (car ,time1) (car ,time2))
(> (nth 1 ,time1) (nth 1 ,time2))))
(defmacro w32-clear-charset-bdf-list (charset)
`(put ,charset 'bdf-list nil))
(defmacro w32-add-charset-bdf-list (charset entry)
`(put ,charset 'bdf-list (cons ,entry (get ,charset 'bdf-list))))
(defmacro w32-get-charset-bdf-list (charset)
`(get ,charset 'bdf-list))
(defmacro w32-bdf-database-filename (entry)
`(car ,entry))
(defmacro w32-bdf-database-modified-time (entry)
`(nth 1 ,entry))
(defmacro w32-clear-charset-bdf-list-all ()
'(mapcar '(lambda (charset)
(w32-clear-charset-bdf-list charset))
(charset-list)))
(defmacro w32-bdf-database-font-info (entry)
`(nth 2 ,entry))
(defmacro w32-update-bdf-database-entry (filename)
`(let ((modified-time (nth 5 (file-attributes ,filename)))
(cached-entry (assoc ,filename w32-bdf-database)))
(list ,filename
modified-time
(if (and cached-entry
(time-newer-than-time-p
(w32-bdf-database-modified-time
cached-entry)
modified-time))
(w32-bdf-database-font-info cached-entry)
(if (assq 'charset cached-entry)
(w32-get-logfont-info
(list 'bdf-font ,filename))
(cons (cons 'charset
(w32-get-bdf-charset
(w32-bdf-database-filename cached-entry)))
(w32-get-logfont-info
(list 'bdf-font ,filename))))))))
(defmacro w32-bdf-charset-registry (filename)
`(cdr (assq 'charset-registry
(nth 2 (assoc ,filename w32-bdf-database)))))
(defmacro w32-bdf-charset-encoding (filename)
`(cdr (assq 'charset-encoding
(nth 2 (assoc ,filename w32-bdf-database)))))
(defmacro w32-bdf-italic-p (filename)
`(string-match
"^i$"
(cdr (assq 'slant
(nth 2 (assoc ,filename w32-bdf-database))))))
(defmacro w32-bdf-weight (filename)
`(let ((weight (cdr (assq 'setwidth-name
(nth 2 (assoc ,filename w32-bdf-database))))))
(cond ((string-match "^medium$" weight)
400)
((string-match "^bold$\\|^demibold$" weight)
700)
(t 400))))
(defmacro w32-bdf-charset (filename)
`(cdr (assq 'charset
(nth 2 (assoc ,filename w32-bdf-database)))))
(defun w32-get-bdf-database-internal (dir)
(let ((files nil)
(dirs (directory-files dir)))
(while dirs
(if (and (not (string= (car dirs) "."))
(not (string= (car dirs) "..")))
(let ((filename (expand-file-name (car dirs) dir)))
(if (file-directory-p filename)
(setq files (nconc (w32-get-bdf-database-internal filename)
files))
(if (string-match "^.*\\.bdf$" filename)
(let ((entry (w32-update-bdf-database-entry filename)))
(w32-add-charset-bdf-list
(cdr (assq 'charset (w32-bdf-database-font-info entry)))
entry)
(setq files (cons
entry
files)))))))
(setq dirs (cdr dirs)))
files))
(defun w32-load-bdf-database ()
(with-temp-buffer
(insert-file-contents w32-bdf-database-filename)
(setq w32-bdf-database (read (current-buffer)))))
(defun w32-save-bdf-database ()
(if w32-bdf-database
(with-temp-buffer
(insert ";; -*- emacs-lisp -*-\n")
(insert ";; Meadow bdf font list.\n")
(let ((print-quoted t)
(print-readably t))
(prin1 w32-bdf-database (current-buffer)))
(write-file w32-bdf-database-filename))))
(defun w32-update-bdf-database (&optional forcep)
(if (or forcep
(and (null w32-bdf-database)
(file-exists-p w32-bdf-database-filename)))
(w32-load-bdf-database))
(w32-clear-charset-bdf-list-all)
(setq w32-bdf-database (w32-get-bdf-database-internal
w32-bdf-font-directory))
(w32-save-bdf-database))
(defun w32-get-bdf-charset (filename)
(let ((registry (w32-bdf-charset-registry filename))
(encoding (w32-bdf-charset-encoding filename)))
(catch 'charset
(let ((regs x-charset-registries))
(while regs
(if (string-match (if (string-match "-" (cdr (car regs)))
(cdr (car regs))
(concat (cdr (car regs)) "[^-]*-" encoding))
(concat registry "-" encoding))
(throw 'charset (car (car regs))))
(setq regs (cdr regs)))))))
(defun w32-list-bdf (charset &optional filename-list)
(if filename-list
(let ((entries (w32-get-charset-bdf-list charset))
entry
matched)
(while filename-list
(if (setq entry (assoc (car filename-list) entries))
(setq matched (cons entry matched)))
(setq filename-list (cdr filename-list)))
matched)
(w32-get-charset-bdf-list charset)))
(defun w32-bdf-logfont-list-from-request (charset required recommended fontset)
(let (request cand1)
(setq cand1 (mapcar '(lambda (entry)
(list nil nil 'raster
(list 'bdf-font
(w32-bdf-database-filename entry))))
(w32-list-bdf
charset
(if (setq request (cdr (assq 'family required)))
request))))
(setq cand1 (w32-select-logfont-from-required cand1 required))
(nth 3 (w32-select-logfont-from-recommended cand1 recommended))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; patch for logfont property functions
(defun w32-logfont-italic-p (logfont)
"Return italic-p of logfont."
(w32-check-logfont logfont)
(if (eq (car logfont) 'bdf-font)
(w32-bdf-italic-p (nth 1 logfont))
(nth 6 logfont)))
(defun w32-logfont-weight (logfont)
"Return weight of logfont."
(w32-check-logfont logfont)
(if (eq (car logfont) 'bdf-font)
(w32-bdf-weight (nth 1 logfont))
(nth 4 logfont)))
(defun w32-logfont-fixed-p (logfont)
(or (eq (car logfont) 'bdf-font)
(/= (logand (nth 12 logfont) 1) 0)))
(defun w32-candidate-satisfy-request-p (cand request)
(let* ((item (car request))
(cont (cdr request))
(logfont (nth 3 cand))
(info (w32-get-logfont-info logfont)))
(cond ((eq item 'width) t)
;; width は無視している
;;((or (w32-candidate-scalable-p cand)
;; (= (cdr (assq 'width info)) cont)))
((eq item 'height)
(or (w32-candidate-scalable-p cand)
(= (cdr (assq 'height info)) cont)))
((eq item 'weight)
t)
; (or (w32-candidate-scalable-p cand)
; (= (cdr (assq 'weight info)) cont)))
((eq item 'italic)
(if cont
(w32-logfont-italic-p logfont)
(not (w32-logfont-italic-p logfont))))
((eq item 'fixed)
(if cont
(w32-logfont-fixed-p logfont)
(not (w32-logfont-fixed-p logfont))))
((eq item 'family)
(string= (car cand) cont))
(t
t))))
;;; patch for create-fontset-from-request
(defun create-fontset-from-request
(name required recommended)
"Create fontset from your request."
(let* ((logfont-list (logfont-list-from-request
required recommended))
(curll logfont-list)
curle
logfont fontname charset)
(while (setq curle (car curll))
(setq logfont (cdr curle)
charset (car curle)
fontname (concat name "-" (symbol-name charset)))
(set-font-from-logfont fontname logfont charset 0
(nth 2 (assq charset w32-charset-encoding-alist)))
(setcdr curle fontname)
(setq curll (cdr curll)))
(new-fontset name logfont-list)))
;;; patch for w32-charset-encoding-alist
(setq w32-charset-encoding-alist
'((ascii 0 0) ; ANSI_CHARSET
(latin-iso8859-1 0 1) ; ANSI_CHARSET
(ascii-right-to-left 0 0) ; ANSI_CHARSET
(latin-iso8859-2 238 1) ; EASTEUROPE_CHARSET
(latin-iso8859-3 1 1) ; DEFAULT_CHARSET
(latin-iso8859-4 1 1) ; DEFAULT_CHARSET
(cyrillic-iso8859-5 204 1) ; RUSSIAN_CHARSET(1251!=8859)
(arabic-iso8859-6 178 0) ; ARABIC_CHARSET
(greek-iso8859-7 161 1) ; GREEK_CHARSET
(hebrew-iso8859-8 177 1) ; HEBREW_CHARSET
(latin-iso8859-9 162 1) ; TURKISH_CHARSET
(latin-jisx0201 128 0) ; SHIFTJIS_CHARSET
(katakana-jisx0201 128 4) ; SHIFTJIS_CHARSET
(japanese-jisx0208 128 4) ; SHIFTJIS_CHARSET
(japanese-jisx0212 1 0) ; DEFAULT_CHARSET
(chinese-big5-1
136 encode-big5-font) ; CHINESEBIG5_CHARSET
(chinese-big5-2
136 encode-big5-font) ; CHINESEBIG5_CHARSET
(chinese-gb2312 134 0) ; GB2312_CHARSET
(korean-ksc5601 129 0) ; HANGEUL_CHARSET
(thai-tis620 222 1) ; THAI_CHARSET
(vietnamese-viscii-lower
163 encode-viscii-font) ; VIETNAMESE_CHARSET
(vietnamese-viscii-upper
163 encode-viscii-font) ; VIETNAMESE_CHARSET
(chinese-cns11643-1 1 0) ; DEFAULT_CHARSET
(chinese-cns11643-2 1 0) ; DEFAULT_CHARSET
; (chinese-cns11643-3 1 0) ; DEFAULT_CHARSET
; (chinese-cns11643-4 1 0) ; DEFAULT_CHARSET
; (chinese-cns11643-5 1 0) ; DEFAULT_CHARSET
; (chinese-cns11643-6 1 0) ; DEFAULT_CHARSET
; (chinese-cns11643-7 1 0) ; DEFAULT_CHARSET
(arabic-digit 1 0) ; DEFAULT_CHARSET
(arabic-1-column 1 0) ; DEFAULT_CHARSET
(arabic-2-column 1 0) ; DEFAULT_CHARSET
(lao 1 1) ; DEFAULT_CHARSET
(ipa 1 1) ; DEFAULT_CHARSET
(ethiopic 1 encode-ethio-font) ; DEFAULT_CHARSET
(indian-is13194 1 0) ; DEFAULT_CHARSET
(indian-2-column 1 0) ; DEFAULT_CHARSET
(indian-1-column 1 0) ; DEFAULT_CHARSET
))
;;; sample
(if nil
(progn
(add-hook 'logfont-from-request-functions
'w32-bdf-logfont-list-from-request
t)
(w32-update-bdf-database)
(setq w32-bdf-font-directory "d:/fonts")
(setq w32-bdf-font-table-filename "~/.bdfdb")
(let ((fontset-name "private-fontset33"))
(create-fontset-from-request
fontset-name
'((width . 8)
(height . 16)
(fixed . t)
(italic . nil))
'((family . "ＭＳ ゴシック")
(family . "Courier New")))
(set-default-font fontset-name)))
)