lisp/ps-bdf.el

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