23896
|
1 ;;; ps-bdf.el --- BDF font file handler for ps-print.
|
|
2
|
26116
|
3 ;; Copyright (C) 1998, 1999 Electrotechnical Laboratory, JAPAN.
|
23896
|
4 ;; Licensed to the Free Software Foundation.
|
|
5
|
26116
|
6 ;; Keywords: wp, BDF, font, PostScript
|
23896
|
7 ;; Maintainer: Kenichi Handa <handa@etl.go.jp>
|
24416
3d446442b6a0
(bdf-directory-list): Initialize it to '("/usr/local/share/emacs/fonts/bdf").
Kenichi Handa <handa@m17n.org>
diff
changeset
|
8 ;; Time-stamp: <99/02/27 11:14:07 kenichi>
|
23896
|
9
|
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
15 ;; any later version.
|
|
16
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
20 ;; GNU General Public License for more details.
|
|
21
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
26
|
|
27 ;;; Commentary:
|
|
28
|
|
29 ;; Functions for getting bitmap information from X's BDF font file are
|
|
30 ;; provided.
|
|
31
|
|
32 ;;; Code:
|
|
33
|
|
34 (eval-when-compile (require 'ps-mule))
|
|
35
|
|
36 ;;;###autoload
|
24449
|
37 (defvar bdf-directory-list
|
|
38 (if (eq system-type 'ms-dos)
|
24450
|
39 (list (expand-file-name "fonts/bdf" installation-directory))
|
24449
|
40 '("/usr/local/share/emacs/fonts/bdf"))
|
24416
3d446442b6a0
(bdf-directory-list): Initialize it to '("/usr/local/share/emacs/fonts/bdf").
Kenichi Handa <handa@m17n.org>
diff
changeset
|
41 "*List of directories to search for `BDF' font files.
|
24467
|
42 The default value is '(\"/usr/local/share/emacs/fonts/bdf\").")
|
23896
|
43
|
24450
|
44 ;; MS-DOS users like to move the binary around after it's built, but
|
|
45 ;; the value above is computed at loadup time.
|
|
46 (and (eq system-type 'ms-dos)
|
|
47 (setq bdf-directory-list
|
|
48 (list (expand-file-name "fonts/bdf" installation-directory))))
|
|
49
|
23896
|
50 (defun bdf-expand-file-name (bdfname)
|
|
51 "Return an abosolute path name of a `BDF' font file BDFNAME.
|
|
52 It searches directories listed in the variable `bdf-directory-list'
|
|
53 for BDFNAME."
|
|
54 (if (file-name-absolute-p bdfname)
|
|
55 (and (file-readable-p bdfname)
|
|
56 bdfname)
|
|
57 (let ((dir-list bdf-directory-list)
|
|
58 dir)
|
|
59 (while (and dir-list
|
|
60 (progn
|
|
61 (setq dir (expand-file-name bdfname (car dir-list)))
|
|
62 (not (file-readable-p dir))))
|
|
63 (setq dir nil
|
|
64 dir-list (cdr dir-list)))
|
|
65 dir)))
|
|
66
|
|
67 (defsubst bdf-file-mod-time (filename)
|
|
68 "Return modification time of FILENAME.
|
|
69 The value is a list of two integers, the first integer has high-order
|
|
70 16 bits, the second has low 16 bits."
|
|
71 (nth 5 (file-attributes filename)))
|
|
72
|
|
73 (defun bdf-file-newer-than-time (filename mod-time)
|
|
74 "Return non-nil if and only if FILENAME is newer than MOD-TIME.
|
|
75 MOD-TIME is a modification time as a list of two integers, the first
|
|
76 integer has high-order 16 bits, the second has low 16 bits."
|
|
77 (let ((file-name (bdf-expand-file-name filename)))
|
|
78 (and file-name
|
|
79 (let* ((new-mod-time (bdf-file-mod-time file-name))
|
|
80 (new-time (car new-mod-time))
|
|
81 (time (car mod-time)))
|
|
82 (or (> new-time time)
|
|
83 (and (= new-time time)
|
|
84 (> (nth 1 new-mod-time) (nth 1 mod-time))))))))
|
|
85
|
|
86 (defun bdf-find-file (bdfname)
|
|
87 "Return a buffer visiting a bdf file BDFNAME.
|
|
88 If BDFNAME is not an absolute path, directories listed in
|
|
89 `bdf-directory-list' is searched.
|
|
90 If BDFNAME doesn't exist, return nil."
|
|
91 (let ((file-name (bdf-expand-file-name bdfname)))
|
|
92 (and file-name
|
|
93 (let ((buf (generate-new-buffer " *bdf-work*"))
|
|
94 (coding-system-for-read 'no-conversion))
|
|
95 (save-excursion
|
|
96 (set-buffer buf)
|
|
97 (insert-file-contents file-name)
|
|
98 buf)))))
|
|
99
|
24087
|
100 (defvar bdf-cache-file (convert-standard-filename "~/.bdfcache.el")
|
23896
|
101 "Name of cache file which contains information of `BDF' font files.")
|
|
102
|
|
103 (defvar bdf-cache nil
|
|
104 "Cached information of `BDF' font files. It is a list of FONT-INFO.
|
|
105 FONT-INFO is a list of the following format:
|
|
106 (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
|
|
107 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
|
|
108 See the documentation of the function `bdf-read-font-info' for more detail.")
|
|
109
|
|
110 (defun bdf-read-cache ()
|
|
111 "Return a cached information about `BDF' font files from a cache file.
|
|
112 The variable `bdf-cache-file' holds the cache file name.
|
|
113 If the cache file is not readable, this return nil."
|
|
114 (setq bdf-cache nil)
|
|
115 (condition-case nil
|
|
116 (and (file-readable-p bdf-cache-file)
|
|
117 (progn
|
|
118 (load-file bdf-cache-file)
|
|
119 (if (listp bdf-cache)
|
|
120 bdf-cache
|
|
121 (setq bdf-cache nil))))
|
|
122 (error nil)))
|
|
123
|
|
124 (defun bdf-write-cache ()
|
|
125 "Write out cached information of `BDF' font file to a file.
|
|
126 The variable `bdf-cache-file' holds the cache file name.
|
|
127 The file is written if and only if the file alreay exists and writable."
|
|
128 (and bdf-cache
|
|
129 (file-exists-p bdf-cache-file)
|
|
130 (file-writable-p bdf-cache-file)
|
|
131 (write-region (format "(setq bdf-cache '%S)\n" bdf-cache)
|
|
132 nil bdf-cache-file)))
|
|
133
|
|
134 (defun bdf-set-cache (font-info)
|
|
135 "Cache FONT-INFO as information about one `BDF' font file.
|
|
136 FONT-INFO is a list of the following format:
|
|
137 (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
|
|
138 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
|
|
139 See the documentation of the function `bdf-read-font-info' for more detail."
|
|
140 (let ((slot (assoc (car font-info) bdf-cache)))
|
|
141 (if slot
|
|
142 (setcdr slot (cdr font-info))
|
|
143 (setq bdf-cache (cons font-info bdf-cache)))))
|
|
144
|
|
145 (defun bdf-initialize ()
|
|
146 "Initialize `bdf' library."
|
|
147 (and (bdf-read-cache)
|
|
148 (add-hook 'kill-emacs-hook 'bdf-write-cache)))
|
|
149
|
|
150 (defun bdf-compact-code (code code-range)
|
|
151 (if (or (< code (aref code-range 4))
|
|
152 (> code (aref code-range 5)))
|
|
153 (setq code (aref code-range 6)))
|
|
154 (+ (* (- (lsh code -8) (aref code-range 0))
|
|
155 (1+ (- (aref code-range 3) (aref code-range 2))))
|
|
156 (- (logand code 255) (aref code-range 2))))
|
|
157
|
|
158 (defun bdf-expand-code (code code-range)
|
|
159 (let ((code0-range (1+ (- (aref code-range 3) (aref code-range 2)))))
|
|
160 (+ (* (+ (/ code code0-range) (aref code-range 0)) 256)
|
|
161 (+ (% code code0-range) (aref code-range 2)))))
|
|
162
|
|
163 (defun bdf-search-and-read (match limit)
|
|
164 (goto-char (point-min))
|
|
165 (and (search-forward match limit t)
|
|
166 (progn
|
|
167 (goto-char (match-end 0))
|
|
168 (read (current-buffer)))))
|
|
169
|
|
170 (defun bdf-read-font-info (bdfname)
|
|
171 "Read `BDF' font file BDFNAME and return information (FONT-INFO) of the file.
|
|
172 FONT-INFO is a list of the following format:
|
|
173 (BDFFILE ABSOLUTE-PATH MOD-TIME FONT-BOUNDING-BOX
|
|
174 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
|
|
175
|
|
176 BDFFILE is a name of a font file (excluding directory part).
|
|
177
|
|
178 ABSOLUTE-PATH is an absolute path of the font file.
|
|
179
|
|
180 MOD-TIME is last modification time as a list of two integers, the
|
|
181 first integer has high-order 16 bits, the second has low 16 bits.
|
|
182
|
|
183 SIZE is a size of the font. This value is got from SIZE record of the
|
|
184 font.
|
|
185
|
|
186 FONT-BOUNDING-BOX is the font bounding box as a list of four integers,
|
|
187 BBX-WIDTH, BBX-HEIGHT, BBX-XOFF, and BBX-YOFF.
|
|
188
|
|
189 RELATIVE-COMPOSE is an integer value of the font's property
|
|
190 `_MULE_RELATIVE_COMPOSE'. If the font doesn't have this property, the
|
|
191 value is 0.
|
|
192
|
|
193 BASELINE-OFFSET is an integer value of the font's property
|
|
194 `_MULE_BASELINE_OFFSET'. If the font doesn't have this property, the
|
|
195 value is 0.
|
|
196
|
|
197 CODE-RANGE is a vector of minimum 1st byte, maximum 1st byte, minimum
|
|
198 2nd byte, maximum 2nd byte, minimum code, maximum code, and default
|
|
199 code. For 1-byte fonts, the first two elements are 0.
|
|
200
|
|
201 MAXLEN is a maximum bytes of one glyph informaion in the font file.
|
|
202
|
|
203 OFFSET-VECTOR is a vector of a file position which starts bitmap data
|
|
204 of the glyph in the font file.
|
|
205
|
|
206 Nth element of OFFSET-VECTOR is a file position for the glyph of code
|
|
207 CODE, where N and CODE are in the following relation:
|
|
208 (bdf-compact-code CODE) => N, (bdf-expand-code N) => CODE"
|
|
209 (let* ((absolute-path (bdf-expand-file-name bdfname))
|
|
210 (buf (and absolute-path (bdf-find-file absolute-path)))
|
|
211 (maxlen 0)
|
|
212 (relative-compose 'false)
|
|
213 (baseline-offset 0)
|
|
214 size
|
|
215 font-bounding-box
|
|
216 default-char
|
|
217 code-range
|
|
218 offset-vector)
|
|
219 (if buf
|
|
220 (message "Reading %s..." bdfname)
|
|
221 (error "BDF file %s doesn't exist" bdfname))
|
|
222 (unwind-protect
|
|
223 (save-excursion
|
|
224 (set-buffer buf)
|
|
225 (goto-char (point-min))
|
|
226 (search-forward "\nFONTBOUNDINGBOX")
|
|
227 (setq font-bounding-box
|
|
228 (vector (read (current-buffer)) (read (current-buffer))
|
|
229 (read (current-buffer)) (read (current-buffer))))
|
|
230 ;; The following kludgy code is to avoid bugs of fonts
|
|
231 ;; jiskan16.bdf and jiskan24.bdf distributed with X.
|
|
232 ;; They contain wrong FONTBOUNDINGBOX.
|
|
233 (and (> (aref font-bounding-box 3) 0)
|
|
234 (string-match "jiskan\\(16\\|24\\)" bdfname)
|
|
235 (aset font-bounding-box 3
|
|
236 (- (aref font-bounding-box 3))))
|
|
237
|
|
238 (goto-char (point-min))
|
|
239 (search-forward "\nSIZE ")
|
|
240 (setq size (read (current-buffer)))
|
|
241 ;; The following kludgy code is t avoid bugs of several
|
|
242 ;; fonts which have wrong SIZE record.
|
|
243 (and (<= size (/ (aref font-bounding-box 1) 2))
|
|
244 (setq size (aref font-bounding-box 1)))
|
|
245
|
|
246 (setq default-char (bdf-search-and-read "\nDEFAULT_CHAR" nil))
|
|
247
|
|
248 (search-forward "\nSTARTCHAR")
|
|
249 (forward-line -1)
|
|
250 (let ((limit (point)))
|
|
251 (setq relative-compose
|
|
252 (or (bdf-search-and-read "\n_MULE_RELATIVE_COMPOSE" limit)
|
|
253 'false)
|
|
254 baseline-offset
|
|
255 (or (bdf-search-and-read "\n_MULE_BASELINE_OFFSET" limit)
|
|
256 0)))
|
|
257
|
|
258 (let ((min-code0 256) (min-code1 256) (min-code 65536)
|
|
259 (max-code0 0) (max-code1 0) (max-code 0)
|
|
260 glyph glyph-list code0 code1 code bbx offset)
|
|
261
|
|
262 (while (search-forward "\nSTARTCHAR" nil t)
|
|
263 (setq offset (line-beginning-position))
|
|
264 (search-forward "\nENCODING")
|
|
265 (setq code (read (current-buffer))
|
|
266 code0 (lsh code -8)
|
|
267 code1 (logand code 255)
|
|
268 min-code (min min-code code)
|
|
269 max-code (max max-code code)
|
|
270 min-code0 (min min-code0 code0)
|
|
271 max-code0 (max max-code0 code0)
|
|
272 min-code1 (min min-code1 code1)
|
|
273 max-code1 (max max-code1 code1))
|
|
274 (search-forward "ENDCHAR")
|
|
275 (setq maxlen (max maxlen (- (point) offset))
|
|
276 glyph-list (cons (cons code offset) glyph-list)))
|
|
277
|
|
278 (setq code-range
|
|
279 (vector min-code0 max-code0 min-code1 max-code1
|
|
280 min-code max-code (or default-char min-code))
|
|
281 offset-vector
|
|
282 (make-vector (1+ (bdf-compact-code max-code code-range))
|
|
283 nil))
|
|
284
|
|
285 (while glyph-list
|
|
286 (setq glyph (car glyph-list)
|
|
287 glyph-list (cdr glyph-list))
|
|
288 (aset offset-vector
|
|
289 (bdf-compact-code (car glyph) code-range)
|
|
290 (cdr glyph)))))
|
|
291
|
|
292 (kill-buffer buf))
|
|
293 (message "Reading %s...done" bdfname)
|
|
294 (list bdfname absolute-path (bdf-file-mod-time absolute-path)
|
|
295 size font-bounding-box relative-compose baseline-offset
|
|
296 code-range maxlen offset-vector)))
|
|
297
|
|
298 (defsubst bdf-info-absolute-path (font-info) (nth 1 font-info))
|
|
299 (defsubst bdf-info-mod-time (font-info) (nth 2 font-info))
|
|
300 (defsubst bdf-info-size (font-info) (nth 3 font-info))
|
|
301 (defsubst bdf-info-font-bounding-box (font-info) (nth 4 font-info))
|
|
302 (defsubst bdf-info-relative-compose (font-info) (nth 5 font-info))
|
|
303 (defsubst bdf-info-baseline-offset (font-info) (nth 6 font-info))
|
|
304 (defsubst bdf-info-code-range (font-info) (nth 7 font-info))
|
|
305 (defsubst bdf-info-maxlen (font-info) (nth 8 font-info))
|
|
306 (defsubst bdf-info-offset-vector (font-info) (nth 9 font-info))
|
|
307
|
|
308 (defun bdf-get-font-info (bdfname)
|
|
309 "Return information about `BDF' font file BDFNAME.
|
|
310 The value FONT-INFO is a list of the following format:
|
|
311 (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
|
|
312 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
|
|
313 See the documentation of the function `bdf-read-font-info' for more detail."
|
|
314 (or bdf-cache
|
|
315 (bdf-read-cache))
|
|
316 (let ((font-info (assoc bdfname bdf-cache)))
|
|
317 (if (or (not font-info)
|
|
318 (not (file-readable-p (bdf-info-absolute-path font-info)))
|
|
319 (bdf-file-newer-than-time bdfname (bdf-info-mod-time font-info)))
|
|
320 (progn
|
|
321 (setq font-info (bdf-read-font-info bdfname))
|
|
322 (bdf-set-cache font-info)))
|
|
323 font-info))
|
|
324
|
24087
|
325 (defun bdf-find-font-info (bdfnames)
|
|
326 "Return information about `BDF' font file with alternative names BDFNAMES.
|
|
327
|
|
328 If BDFNAMES is a list of file names, this function finds the first file
|
|
329 in the list which exists and is readable, then calls `bdf-get-font-info'
|
|
330 on that file name."
|
|
331 (let ((fnlist bdfnames)
|
|
332 (fname bdfnames))
|
|
333 (if (consp fnlist)
|
|
334 (while (and fnlist
|
|
335 (progn
|
|
336 (setq fname (car fnlist))
|
|
337 (null (bdf-expand-file-name fname))))
|
|
338 (setq fname nil
|
|
339 fnlist (cdr fnlist))))
|
|
340 (bdf-get-font-info (or fname (car bdfnames)))))
|
|
341
|
23896
|
342 (defun bdf-read-bitmap (bdfname offset maxlen)
|
|
343 "Read `BDF' font file BDFNAME to get bitmap data at file poistion OFFSET.
|
|
344 BDFNAME is an abosolute path name of the font file.
|
|
345 MAXLEN specifies how many bytes we should read at least.
|
|
346 The value is a list of DWIDTH, BBX, and BITMAP-STRING.
|
|
347 DWIDTH is a pixel width of a glyph.
|
|
348 BBX is a bounding box of the glyph.
|
|
349 BITMAP-STRING is a string representing bits by hexadecimal digits."
|
|
350 (let ((coding-system-for-read 'no-conversion)
|
|
351 dwidth bbx height yoff bitmap-string)
|
|
352 (condition-case nil
|
|
353 (with-temp-buffer
|
|
354 (insert-file-contents bdfname nil offset (+ offset maxlen))
|
|
355 (goto-char (point-min))
|
|
356 (search-forward "\nDWIDTH")
|
|
357 (setq dwidth (read (current-buffer)))
|
|
358 (goto-char (point-min))
|
|
359 (search-forward "\nBBX")
|
|
360 (setq bbx (vector (read (current-buffer)) (read (current-buffer))
|
|
361 (read (current-buffer)) (read (current-buffer)))
|
|
362 height (aref bbx 1) yoff (aref bbx 3))
|
|
363 (search-forward "\nBITMAP")
|
|
364 (forward-line 1)
|
|
365 (delete-region (point-min) (point))
|
|
366 (and (looking-at "\\(0+\n\\)+")
|
|
367 (progn
|
|
368 (setq height (- height (count-lines (point) (match-end 0))))
|
|
369 (delete-region (point) (match-end 0))))
|
|
370 (or (looking-at "ENDCHAR")
|
|
371 (progn
|
|
372 (search-forward "ENDCHAR" nil 'move)
|
|
373 (forward-line -1)
|
|
374 (while (looking-at "0+$")
|
|
375 (setq yoff (1+ yoff)
|
|
376 height (1- height))
|
|
377 (forward-line -1))
|
|
378 (forward-line 1)))
|
|
379 (aset bbx 1 height)
|
|
380 (aset bbx 3 yoff)
|
|
381 (delete-region (point) (point-max))
|
|
382 (goto-char (point-min))
|
|
383 (while (not (eobp))
|
|
384 (end-of-line)
|
|
385 (delete-char 1))
|
|
386 (setq bitmap-string (buffer-string)))
|
|
387 (error nil))
|
|
388 (list dwidth bbx bitmap-string)))
|
|
389
|
|
390 (defun bdf-get-bitmaps (bdfname codes)
|
|
391 "Return bitmap information of glyphs of CODES in `BDF' font file BDFNAME.
|
|
392 CODES is a list of encoding number of glyphs in the file.
|
|
393 The value is a list of CODE, DWIDTH, BBX, and BITMAP-STRING.
|
|
394 DWIDTH is a pixel width of a glyph.
|
|
395 BBX is a bounding box of the glyph.
|
|
396 BITMAP-STRING is a string representing bits by hexadecimal digits."
|
24087
|
397 (let* ((font-info (bdf-find-font-info bdfname))
|
23896
|
398 (absolute-path (bdf-info-absolute-path font-info))
|
|
399 (font-bounding-box (bdf-info-font-bounding-box font-info))
|
|
400 (maxlen (bdf-info-maxlen font-info))
|
|
401 (code-range (bdf-info-code-range font-info))
|
|
402 (offset-vector (bdf-info-offset-vector font-info)))
|
|
403 (mapcar '(lambda (x)
|
|
404 (cons x (bdf-read-bitmap
|
|
405 absolute-path
|
|
406 (aref offset-vector (bdf-compact-code x code-range))
|
|
407 maxlen)))
|
|
408 codes)))
|
|
409
|
|
410 ;;; Interface to ps-print.el
|
|
411
|
|
412 ;; Called from ps-mule-init-external-library.
|
|
413 (defun bdf-generate-prologue ()
|
|
414 (or bdf-cache
|
|
415 (bdf-initialize))
|
|
416 (ps-mule-generate-bitmap-prologue))
|
|
417
|
|
418 ;; Called from ps-mule-generate-font.
|
|
419 (defun bdf-generate-font (charset font-spec)
|
|
420 (let* ((font-name (ps-mule-font-spec-name font-spec))
|
24087
|
421 (font-info (bdf-find-font-info font-name))
|
|
422 (font-name (if (consp font-name) (car font-name) font-name)))
|
23896
|
423 (ps-mule-generate-bitmap-font font-name
|
|
424 (ps-mule-font-spec-bytes font-spec)
|
|
425 (charset-width charset)
|
|
426 (bdf-info-size font-info)
|
|
427 (bdf-info-relative-compose font-info)
|
|
428 (bdf-info-baseline-offset font-info)
|
|
429 (bdf-info-font-bounding-box font-info))))
|
|
430
|
|
431 ;; Called from ps-mule-generate-glyphs.
|
|
432 (defun bdf-generate-glyphs (font-spec code-list bytes)
|
|
433 (let ((font-name (ps-mule-font-spec-name font-spec)))
|
|
434 (mapcar '(lambda (x)
|
24087
|
435 (apply 'ps-mule-generate-bitmap-glyph
|
|
436 (if (consp font-name) (car font-name) font-name)
|
|
437 x))
|
23896
|
438 (bdf-get-bitmaps font-name code-list))))
|
|
439
|
|
440 (provide 'ps-bdf)
|
|
441
|
|
442 ;;; ps-bdf.el ends here
|