Commit | Line | Data |
---|---|---|
e62e3e6b KH |
1 | ;;; ps-bdf.el --- BDF font file handler for ps-print. |
2 | ||
3 | ;; Copyright (C) 1998 Electrotechnical Laboratory, JAPAN. | |
4 | ;; Licensed to the Free Software Foundation. | |
5 | ||
6 | ;; Keywords: BDF, font, PostScript | |
7 | ;; Maintainer: Kenichi Handa <handa@etl.go.jp> | |
1b3172da | 8 | ;; Time-stamp: <99/02/27 11:14:07 kenichi> |
e62e3e6b KH |
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 | |
3e3cf0a7 EZ |
37 | (defvar bdf-directory-list |
38 | (if (eq system-type 'ms-dos) | |
0a51cf3d | 39 | (list (expand-file-name "fonts/bdf" installation-directory)) |
3e3cf0a7 | 40 | '("/usr/local/share/emacs/fonts/bdf")) |
1b3172da | 41 | "*List of directories to search for `BDF' font files. |
5062e90d | 42 | The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") |
e62e3e6b | 43 | |
0a51cf3d EZ |
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 | ||
e62e3e6b KH |
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 | ||
6c743efb | 100 | (defvar bdf-cache-file (convert-standard-filename "~/.bdfcache.el") |
e62e3e6b KH |
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 | ||
6c743efb EZ |
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 | ||
e62e3e6b KH |
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." | |
6c743efb | 397 | (let* ((font-info (bdf-find-font-info bdfname)) |
e62e3e6b KH |
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)) | |
6c743efb EZ |
421 | (font-info (bdf-find-font-info font-name)) |
422 | (font-name (if (consp font-name) (car font-name) font-name))) | |
e62e3e6b KH |
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) | |
6c743efb EZ |
435 | (apply 'ps-mule-generate-bitmap-glyph |
436 | (if (consp font-name) (car font-name) font-name) | |
437 | x)) | |
e62e3e6b KH |
438 | (bdf-get-bitmaps font-name code-list)))) |
439 | ||
440 | (provide 'ps-bdf) | |
441 | ||
442 | ;;; ps-bdf.el ends here |