merge trunk
[emacs.git] / lisp / ps-bdf.el
bloba82e03ceda7a8bed178055b7aec4dad0275db25f
1 ;;; ps-bdf.el --- BDF font file handler for ps-print
3 ;; Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
4 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
5 ;; 2008, 2009, 2010, 2011
6 ;; National Institute of Advanced Industrial Science and Technology (AIST)
7 ;; Registration Number H14PRO021
8 ;; Copyright (C) 2003
9 ;; National Institute of Advanced Industrial Science and Technology (AIST)
10 ;; Registration Number H13PRO009
12 ;; Author: Kenichi Handa <handa@m17n.org>
13 ;; (according to ack.texi)
14 ;; Keywords: wp, BDF, font, PostScript
15 ;; Package: ps-print
17 ;; This file is part of GNU Emacs.
19 ;; GNU Emacs is free software: you can redistribute it and/or modify
20 ;; it under the terms of the GNU General Public License as published by
21 ;; the Free Software Foundation, either version 3 of the License, or
22 ;; (at your option) any later version.
24 ;; GNU Emacs is distributed in the hope that it will be useful,
25 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
26 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27 ;; GNU General Public License for more details.
29 ;; You should have received a copy of the GNU General Public License
30 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
32 ;;; Commentary:
34 ;; Functions for getting bitmap information from X's BDF font file are
35 ;; provided.
37 ;;; Code:
39 (require 'ps-mule)
41 ;;;###autoload
42 (defcustom bdf-directory-list
43 (if (memq system-type '(ms-dos windows-nt))
44 (list (expand-file-name "fonts/bdf" installation-directory))
45 '("/usr/local/share/emacs/fonts/bdf"))
46 "List of directories to search for `BDF' font files.
47 The default value is '(\"/usr/local/share/emacs/fonts/bdf\")."
48 :type '(repeat :tag "BDF font directory list"
49 (directory :tag "BDF font directory"))
50 :group 'ps-print-miscellany)
52 ;; MS-DOS and MS-Windows users like to move the binary around after
53 ;; it's built, but the value above is computed at load-up time.
54 (and (memq system-type '(ms-dos windows-nt))
55 (setq bdf-directory-list
56 (list (expand-file-name "fonts/bdf" installation-directory))))
58 (defun bdf-expand-file-name (bdfname)
59 "Return an absolute path name of a `BDF' font file BDFNAME.
60 It searches directories listed in the variable `bdf-directory-list'
61 for BDFNAME."
62 (if (file-name-absolute-p bdfname)
63 (and (file-readable-p bdfname)
64 bdfname)
65 (catch 'tag
66 (dolist (dir bdf-directory-list)
67 (let ((absolute-path (expand-file-name bdfname dir)))
68 (if (file-readable-p absolute-path)
69 (throw 'tag absolute-path)))))))
71 (defsubst bdf-file-mod-time (filename)
72 "Return modification time of FILENAME.
73 The value is a list of two integers, the first integer has high-order
74 16 bits, the second has low 16 bits."
75 (nth 5 (file-attributes filename)))
77 (defun bdf-file-newer-than-time (filename mod-time)
78 "Return non-nil if and only if FILENAME is newer than MOD-TIME.
79 MOD-TIME is a modification time as a list of two integers, the first
80 integer has high-order 16 bits, the second has low 16 bits."
81 (let* ((new-mod-time (bdf-file-mod-time filename))
82 (new-time (car new-mod-time))
83 (time (car mod-time)))
84 (or (> new-time time)
85 (and (= new-time time)
86 (> (nth 1 new-mod-time) (nth 1 mod-time))))))
88 (defun bdf-find-file (bdfname)
89 "Return a buffer visiting a bdf file BDFNAME.
90 BDFNAME must be an absolute file name.
91 If BDFNAME doesn't exist, return nil."
92 (and (file-readable-p bdfname)
93 (let ((buf (generate-new-buffer " *bdf-work*"))
94 (coding-system-for-read 'no-conversion))
95 (with-current-buffer buf
96 (insert-file-contents bdfname)
97 buf))))
99 (defvar bdf-cache-file (if (eq system-type 'ms-dos)
100 ;; convert-standard-filename doesn't
101 ;; guarantee that the .el extension will be
102 ;; preserved.
103 "~/_bdfcache.el"
104 (convert-standard-filename "~/.bdfcache.el"))
105 "Name of cache file which contains information of `BDF' font files.")
107 (defvar bdf-cache nil
108 "Cached information of `BDF' font files. It is a list of FONT-INFO.
109 FONT-INFO is a list of the following format:
110 (ABSOLUTE-FILE-NAME MOD-TIME SIZE FONT-BOUNDING-BOX
111 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
112 See the documentation of the function `bdf-read-font-info' for more detail.")
114 (defun bdf-read-cache ()
115 "Return a cached information about `BDF' font files from a cache file.
116 The variable `bdf-cache-file' holds the cache file name.
117 If the cache file is not readable, this return nil."
118 (setq bdf-cache nil)
119 (condition-case nil
120 (and (file-readable-p bdf-cache-file)
121 (progn
122 (load-file bdf-cache-file)
123 (if (listp bdf-cache)
124 bdf-cache
125 (setq bdf-cache nil))))
126 (error nil)))
128 (defun bdf-write-cache ()
129 "Write out cached information of `BDF' font file to a file.
130 The variable `bdf-cache-file' holds the cache file name.
131 The file is written if and only if the file already exists and writable."
132 (and bdf-cache
133 (file-exists-p bdf-cache-file)
134 (file-writable-p bdf-cache-file)
135 (write-region (format "(setq bdf-cache '%S)\n" bdf-cache)
136 nil bdf-cache-file)))
138 (defun bdf-set-cache (font-info)
139 "Cache FONT-INFO as information about one `BDF' font file.
140 FONT-INFO is a list of the following format:
141 (ABSOLUTE-FILE-NAME MOD-TIME SIZE FONT-BOUNDING-BOX
142 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
143 See the documentation of the function `bdf-read-font-info' for more detail."
144 (let ((slot (assoc (car font-info) bdf-cache)))
145 (if slot
146 (setcdr slot (cdr font-info))
147 (setq bdf-cache (cons font-info bdf-cache)))))
149 (defun bdf-initialize ()
150 "Initialize `bdf' library."
151 (and (bdf-read-cache)
152 (add-hook 'kill-emacs-hook 'bdf-write-cache)))
154 (defun bdf-compact-code (code code-range)
155 (if (or (< code (aref code-range 4))
156 (> code (aref code-range 5)))
157 (setq code (aref code-range 6)))
158 (+ (* (- (lsh code -8) (aref code-range 0))
159 (1+ (- (aref code-range 3) (aref code-range 2))))
160 (- (logand code 255) (aref code-range 2))))
162 (defun bdf-expand-code (code code-range)
163 (let ((code0-range (1+ (- (aref code-range 3) (aref code-range 2)))))
164 (+ (* (+ (/ code code0-range) (aref code-range 0)) 256)
165 (+ (% code code0-range) (aref code-range 2)))))
167 (defun bdf-search-and-read (match limit)
168 (goto-char (point-min))
169 (and (search-forward match limit t)
170 (progn
171 (goto-char (match-end 0))
172 (read (current-buffer)))))
174 (defun bdf-read-font-info (bdfname)
175 "Read `BDF' font file BDFNAME and return information (FONT-INFO) of the file.
176 BDFNAME must be an absolute file name.
177 FONT-INFO is a list of the following format:
178 (BDFFILE MOD-TIME FONT-BOUNDING-BOX
179 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
181 MOD-TIME is last modification time as a list of two integers, the
182 first integer has high-order 16 bits, the second has low 16 bits.
184 SIZE is a size of the font on 72 dpi device. This value is got
185 from SIZE record of the font.
187 FONT-BOUNDING-BOX is the font bounding box as a list of four integers,
188 BBX-WIDTH, BBX-HEIGHT, BBX-XOFF, and BBX-YOFF.
190 RELATIVE-COMPOSE is an integer value of the font's property
191 `_MULE_RELATIVE_COMPOSE'. If the font doesn't have this property, the
192 value is 0.
194 BASELINE-OFFSET is an integer value of the font's property
195 `_MULE_BASELINE_OFFSET'. If the font doesn't have this property, the
196 value is 0.
198 CODE-RANGE is a vector of minimum 1st byte, maximum 1st byte, minimum
199 2nd byte, maximum 2nd byte, minimum code, maximum code, and default
200 code. For 1-byte fonts, the first two elements are 0.
202 MAXLEN is a maximum bytes of one glyph information in the font file.
204 OFFSET-VECTOR is a vector of a file position which starts bitmap data
205 of the glyph in the font file.
207 Nth element of OFFSET-VECTOR is a file position for the glyph of code
208 CODE, where N and CODE are in the following relation:
209 (bdf-compact-code CODE) => N, (bdf-expand-code N) => CODE"
210 (let* ((buf (bdf-find-file bdfname))
211 (maxlen 0)
212 (relative-compose 'false)
213 (baseline-offset 0)
214 size
216 font-bounding-box
217 default-char
218 code-range
219 offset-vector)
220 (if buf
221 (message "Reading %s..." bdfname)
222 (error "BDF file %s doesn't exist" bdfname))
223 (unwind-protect
224 (with-current-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))))
238 (goto-char (point-min))
239 (search-forward "\nFONT ")
240 (if (looking-at "-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-\\([0-9]+\\)")
241 (setq size (string-to-number (match-string 1)))
242 (search-forward "\nSIZE ")
243 (setq size (read (current-buffer)))
244 ;; The following kludgy code is to avoid bugs of several
245 ;; fonts which have wrong SIZE record.
246 (and (string-match "jiskan" bdfname)
247 (<= size (/ (aref font-bounding-box 1) 3))
248 (setq size (aref font-bounding-box 1)))
249 (setq dpi (read (current-buffer)))
250 (if (and (> dpi 0) (/= dpi 72))
251 (setq size (/ (* size dpi) 72))))
253 (setq default-char (bdf-search-and-read "\nDEFAULT_CHAR" nil))
255 (search-forward "\nSTARTCHAR")
256 (forward-line -1)
257 (let ((limit (point)))
258 (setq relative-compose
259 (or (bdf-search-and-read "\n_MULE_RELATIVE_COMPOSE" limit)
260 'false)
261 baseline-offset
262 (or (bdf-search-and-read "\n_MULE_BASELINE_OFFSET" limit)
263 0)))
265 (let ((min-code0 256) (min-code1 256) (min-code 65536)
266 (max-code0 0) (max-code1 0) (max-code 0)
267 glyph glyph-list code0 code1 code offset)
269 (while (search-forward "\nSTARTCHAR" nil t)
270 (setq offset (line-beginning-position))
271 (search-forward "\nENCODING")
272 (setq code (read (current-buffer)))
273 (if (< code 0)
274 (search-forward "ENDCHAR")
275 (setq code0 (lsh code -8)
276 code1 (logand code 255)
277 min-code (min min-code code)
278 max-code (max max-code code)
279 min-code0 (min min-code0 code0)
280 max-code0 (max max-code0 code0)
281 min-code1 (min min-code1 code1)
282 max-code1 (max max-code1 code1))
283 (search-forward "ENDCHAR")
284 (setq maxlen (max maxlen (- (point) offset))
285 glyph-list (cons (cons code offset) glyph-list))))
287 (setq code-range
288 (vector min-code0 max-code0 min-code1 max-code1
289 min-code max-code (or default-char min-code))
290 offset-vector
291 (make-vector (1+ (bdf-compact-code max-code code-range))
292 nil))
294 (while glyph-list
295 (setq glyph (car glyph-list)
296 glyph-list (cdr glyph-list))
297 (aset offset-vector
298 (bdf-compact-code (car glyph) code-range)
299 (cdr glyph)))))
301 (kill-buffer buf))
302 (message "Reading %s...done" bdfname)
303 (list bdfname (bdf-file-mod-time bdfname)
304 size font-bounding-box relative-compose baseline-offset
305 code-range maxlen offset-vector)))
307 (defsubst bdf-info-absolute-path (font-info) (nth 0 font-info))
308 (defsubst bdf-info-mod-time (font-info) (nth 1 font-info))
309 (defsubst bdf-info-size (font-info) (nth 2 font-info))
310 (defsubst bdf-info-font-bounding-box (font-info) (nth 3 font-info))
311 (defsubst bdf-info-relative-compose (font-info) (nth 4 font-info))
312 (defsubst bdf-info-baseline-offset (font-info) (nth 5 font-info))
313 (defsubst bdf-info-code-range (font-info) (nth 6 font-info))
314 (defsubst bdf-info-maxlen (font-info) (nth 7 font-info))
315 (defsubst bdf-info-offset-vector (font-info) (nth 8 font-info))
317 (defun bdf-get-font-info (bdfname)
318 "Return information about `BDF' font file BDFNAME.
319 BDFNAME must be an absolute file name.
320 The value FONT-INFO is a list of the following format:
321 (BDFNAME MOD-TIME SIZE FONT-BOUNDING-BOX
322 RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
323 See the documentation of the function `bdf-read-font-info' for more detail."
324 (or bdf-cache
325 (bdf-read-cache))
326 (let ((font-info (assoc bdfname bdf-cache)))
327 (if (or (not font-info)
328 (not (file-readable-p bdfname))
329 (bdf-file-newer-than-time bdfname (bdf-info-mod-time font-info)))
330 (progn
331 (setq font-info (bdf-read-font-info bdfname))
332 (bdf-set-cache font-info)))
333 font-info))
335 (defun bdf-read-bitmap (bdfname offset maxlen relative-compose)
336 "Read `BDF' font file BDFNAME to get bitmap data at file position OFFSET.
337 BDFNAME is an absolute path name of the font file.
338 MAXLEN specifies how many bytes we should read at least.
339 The value is a list of DWIDTH, BBX, and BITMAP-STRING.
340 DWIDTH is a pixel width of a glyph.
341 BBX is a bounding box of the glyph.
342 BITMAP-STRING is a string representing bits by hexadecimal digits."
343 (let* ((coding-system-for-read 'no-conversion)
344 (bbx (bdf-info-font-bounding-box (bdf-get-font-info bdfname)))
345 (dwidth (elt bbx 0))
346 (bitmap-string "")
347 height yoff)
348 (condition-case nil
349 (with-temp-buffer
350 (insert-file-contents bdfname nil offset (+ offset maxlen))
351 (goto-char (point-min))
352 (search-forward "\nDWIDTH")
353 (setq dwidth (read (current-buffer)))
354 (if (= dwidth 0)
355 (setq dwidth 0.1))
356 (goto-char (point-min))
357 (search-forward "\nBBX")
358 (setq bbx (vector (read (current-buffer)) (read (current-buffer))
359 (read (current-buffer)) (read (current-buffer)))
360 height (aref bbx 1)
361 yoff (aref bbx 3))
362 (search-forward "\nBITMAP")
363 (forward-line 1)
364 (delete-region (point-min) (point))
365 (and (looking-at "\\(0+\n\\)+")
366 (progn
367 (setq height (- height (count-lines (point) (match-end 0))))
368 (delete-region (point) (match-end 0))))
369 (or (looking-at "ENDCHAR")
370 (progn
371 (search-forward "ENDCHAR" nil 'move)
372 (forward-line -1)
373 (while (looking-at "0+$")
374 (setq yoff (1+ yoff)
375 height (1- height))
376 (forward-line -1))
377 (forward-line 1)))
378 (aset bbx 1 height)
379 (aset bbx 3 yoff)
380 (delete-region (point) (point-max))
381 (goto-char (point-min))
382 (while (not (eobp))
383 (end-of-line)
384 (delete-char 1))
385 (setq bitmap-string (buffer-string)))
386 (error nil))
387 (vector dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3)
388 (concat "<" bitmap-string ">")
389 (or relative-compose 'false))))
391 (defun bdf-get-bitmap (bdfname code)
392 "Return bitmap information of glyph of CODE in `BDF' font file BDFNAME.
393 CODE is an encoding number of glyph in the file.
394 The value is a list (DWIDTH BBX BITMAP-STRING).
395 DWIDTH is a pixel width of a glyph.
396 BBX is a bounding box of the glyph.
397 BITMAP-STRING is a string representing bits by hexadecimal digits."
398 (let* ((info (bdf-get-font-info bdfname))
399 (maxlen (bdf-info-maxlen info))
400 (code-range (bdf-info-code-range info))
401 (offset-vector (bdf-info-offset-vector info)))
402 (bdf-read-bitmap bdfname
403 (aref offset-vector (bdf-compact-code code code-range))
404 maxlen (bdf-info-relative-compose info))))
406 ;;; Interface to ps-mule.el
408 ;; Called from ps-mule-init-external-library.
409 (defun bdf-generate-prologue ()
410 (or bdf-cache
411 (bdf-initialize))
412 (ps-mule-generate-bitmap-prologue))
414 ;; Called from ps-mule-check-font.
415 (defun bdf-check-font (font-spec)
416 (let ((font-name-list (ps-mule-font-spec-name font-spec)))
417 (ps-mule-font-spec-set-name
418 font-spec
419 (if (stringp font-name-list)
420 (bdf-expand-file-name font-name-list)
421 (catch 'tag
422 (dolist (font-name font-name-list)
423 (setq font-name (bdf-expand-file-name font-name))
424 (if font-name
425 (throw 'tag font-name))))))))
427 ;; Called from ps-mule-generate-font.
428 (defun bdf-generate-font (font-spec)
429 (let ((info (bdf-get-font-info (ps-mule-font-spec-name font-spec))))
430 (ps-mule-font-spec-set-extra
431 font-spec (bdf-info-absolute-path info))
432 (ps-mule-generate-bitmap-font font-spec
433 (bdf-info-size info)
434 (bdf-info-relative-compose info)
435 (bdf-info-baseline-offset info)
436 (bdf-info-font-bounding-box info))))
438 ;; Called from ps-mule-generate-glyph.
439 (defun bdf-generate-glyph (font-spec char)
440 (let ((font-name (ps-mule-font-spec-extra font-spec))
441 (code (ps-mule-encode-char char font-spec)))
442 (ps-mule-generate-bitmap-glyph font-spec char code
443 (bdf-get-bitmap font-name code))))
445 (provide 'ps-bdf)
447 ;;; ps-bdf.el ends here