lisp/ps-bdf.el

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