lisp/ps-bdf.el

   1 ;;; ps-bdf.el --- BDF font file handler for ps-print
   2
   3 ;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
   6 ;;   2008
   7 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   8 ;;   Registration Number H14PRO021
   9
  10 ;; Copyright (C) 2003
  11 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
  12 ;;   Registration Number H13PRO009
  13
  14 ;; Keywords: wp, BDF, font, PostScript
  15 ;; Maintainer: Kenichi Handa <handa@m17n.org>
  16
  17 ;; This file is part of GNU Emacs.
  18
  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.
  23
  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.
  28
  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/>.
  31
  32 ;;; Commentary:
  33
  34 ;; Functions for getting bitmap information from X's BDF font file are
  35 ;; provided.
  36
  37 ;;; Code:
  38
  39 (eval-and-compile
  40   (require 'ps-mule))
  41
  42 ;;;###autoload
  43 (defvar bdf-directory-list
  44   (if (memq system-type '(ms-dos windows-nt))
  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 (memq system-type '(ms-dos windows-nt))
  53      (setq bdf-directory-list
  54            (list (expand-file-name "fonts/bdf" installation-directory))))
  55
  56 (defun bdf-expand-file-name (bdfname)
  57   "Return an absolute path name of a `BDF' font file BDFNAME.
  58 It searches directories listed in the variable `bdf-directory-list'
  59 for BDFNAME."
  60   (if (file-name-absolute-p bdfname)
  61       (and (file-readable-p bdfname)
  62            bdfname)
  63     (catch 'tag
  64       (dolist (dir bdf-directory-list)
  65         (let ((absolute-path (expand-file-name bdfname dir)))
  66           (if (file-readable-p absolute-path)
  67             (throw 'tag absolute-path)))))))
  68
  69 (defsubst bdf-file-mod-time (filename)
  70   "Return modification time of FILENAME.
  71 The value is a list of two integers, the first integer has high-order
  72 16 bits, the second has low 16 bits."
  73   (nth 5 (file-attributes filename)))
  74
  75 (defun bdf-file-newer-than-time (filename mod-time)
  76   "Return non-nil if and only if FILENAME is newer than MOD-TIME.
  77 MOD-TIME is a modification time as a list of two integers, the first
  78 integer has high-order 16 bits, the second has low 16 bits."
  79   (let* ((new-mod-time (bdf-file-mod-time filename))
  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 BDFNAME must be an absolute file name.
  89 If BDFNAME doesn't exist, return nil."
  90   (and (file-readable-p bdfname)
  91        (let ((buf (generate-new-buffer " *bdf-work*"))
  92              (coding-system-for-read 'no-conversion))
  93          (save-excursion
  94            (set-buffer buf)
  95            (insert-file-contents bdfname)
  96            buf))))
  97
  98 (defvar bdf-cache-file (if (eq system-type 'ms-dos)
  99                            ;; convert-standard-filename doesn't
 100                            ;; guarantee that the .el extension will be
 101                            ;; preserved.
 102                            "~/_bdfcache.el"
 103                          (convert-standard-filename "~/.bdfcache.el"))
 104   "Name of cache file which contains information of `BDF' font files.")
 105
 106 (defvar bdf-cache nil
 107   "Cached information of `BDF' font files.  It is a list of FONT-INFO.
 108 FONT-INFO is a list of the following format:
 109     (ABSOLUTE-FILE-NAME MOD-TIME SIZE FONT-BOUNDING-BOX
 110      RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
 111 See the documentation of the function `bdf-read-font-info' for more detail.")
 112
 113 (defun bdf-read-cache ()
 114   "Return a cached information about `BDF' font files from a cache file.
 115 The variable `bdf-cache-file' holds the cache file name.
 116 If the cache file is not readable, this return nil."
 117   (setq bdf-cache nil)
 118   (condition-case nil
 119       (and (file-readable-p bdf-cache-file)
 120            (progn
 121              (load-file bdf-cache-file)
 122              (if (listp bdf-cache)
 123                  bdf-cache
 124                (setq bdf-cache nil))))
 125     (error nil)))
 126
 127 (defun bdf-write-cache ()
 128   "Write out cached information of `BDF' font file to a file.
 129 The variable `bdf-cache-file' holds the cache file name.
 130 The file is written if and only if the file already exists and writable."
 131   (and bdf-cache
 132        (file-exists-p bdf-cache-file)
 133        (file-writable-p bdf-cache-file)
 134        (write-region (format "(setq bdf-cache '%S)\n" bdf-cache)
 135                      nil bdf-cache-file)))
 136
 137 (defun bdf-set-cache (font-info)
 138   "Cache FONT-INFO as information about one `BDF' font file.
 139 FONT-INFO is a list of the following format:
 140     (ABSOLUTE-FILE-NAME MOD-TIME SIZE FONT-BOUNDING-BOX
 141      RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
 142 See the documentation of the function `bdf-read-font-info' for more detail."
 143   (let ((slot (assoc (car font-info) bdf-cache)))
 144     (if slot
 145         (setcdr slot (cdr font-info))
 146       (setq bdf-cache (cons font-info bdf-cache)))))
 147
 148 (defun bdf-initialize ()
 149   "Initialize `bdf' library."
 150   (and (bdf-read-cache)
 151        (add-hook 'kill-emacs-hook 'bdf-write-cache)))
 152
 153 (defun bdf-compact-code (code code-range)
 154   (if (or (< code (aref code-range 4))
 155           (> code (aref code-range 5)))
 156       (setq code (aref code-range 6)))
 157   (+ (* (- (lsh code -8) (aref code-range 0))
 158         (1+ (- (aref code-range 3) (aref code-range 2))))
 159      (- (logand code 255) (aref code-range 2))))
 160
 161 (defun bdf-expand-code (code code-range)
 162   (let ((code0-range (1+ (- (aref code-range 3) (aref code-range 2)))))
 163     (+ (* (+ (/ code code0-range) (aref code-range 0)) 256)
 164        (+ (% code code0-range) (aref code-range 2)))))
 165
 166 (defun bdf-search-and-read (match limit)
 167   (goto-char (point-min))
 168   (and (search-forward match limit t)
 169        (progn
 170          (goto-char (match-end 0))
 171          (read (current-buffer)))))
 172
 173 (defun bdf-read-font-info (bdfname)
 174   "Read `BDF' font file BDFNAME and return information (FONT-INFO) of the file.
 175 BDFNAME must be an absolute file name.
 176 FONT-INFO is a list of the following format:
 177     (BDFFILE MOD-TIME FONT-BOUNDING-BOX
 178      RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
 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 on 72 dpi device.  This value is got
 184 from SIZE record of the 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 information 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* ((buf (bdf-find-file bdfname))
 210          (maxlen 0)
 211          (relative-compose 'false)
 212          (baseline-offset 0)
 213          size
 214          dpi
 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 "\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))))
 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               (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))))
 286
 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))
 293
 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)))))
 300
 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)))
 306
 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))
 316
 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))
 334
 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))))
 390
 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))))
 405
 406 ;;; Interface to ps-mule.el
 407
 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))
 413
 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))))))))
 426
 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))))
 437
 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))))
 444
 445 (provide 'ps-bdf)
 446
 447 ;; arch-tag: 9b875ba8-565a-4ecf-acaa-30cee732c898
 448 ;;; ps-bdf.el ends here