lisp/ps-bdf.el

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