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