X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e62e3e6b5e68bb41e9783c1afad859af6fe816d8..c006623074918b4068bda65e3c5bcc076f2d8deb:/lisp/ps-bdf.el diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 28ef5ab019..750d724f9f 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -1,11 +1,13 @@ -;;; ps-bdf.el --- BDF font file handler for ps-print. +;;; ps-bdf.el --- BDF font file handler for ps-print -;; Copyright (C) 1998 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. +;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +;; Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +;; National Institute of Advanced Industrial Science and Technology (AIST) +;; Registration Number H14PRO021 -;; Keywords: BDF, font, PostScript -;; Maintainer: Kenichi Handa -;; Time-stamp: <98/11/26 15:09:23 kenichi> +;; Keywords: wp, BDF, font, PostScript +;; Maintainer: Kenichi Handa ;; This file is part of GNU Emacs. @@ -21,8 +23,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -31,15 +33,29 @@ ;;; Code: -(eval-when-compile (require 'ps-mule)) +(eval-and-compile + (require 'ps-mule) + + ;; to avoid XEmacs compilation gripes + (defvar installation-directory nil) + (defvar coding-system-for-read nil)) ;;;###autoload (defvar bdf-directory-list - nil - "*List of directories to search for `BDF' font files.") + (if (memq system-type '(ms-dos windows-nt)) + (list (expand-file-name "fonts/bdf" installation-directory)) + '("/usr/local/share/emacs/fonts/bdf")) + "*List of directories to search for `BDF' font files. +The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") + +;; MS-DOS and MS-Windows users like to move the binary around after +;; it's built, but the value above is computed at load-up time. +(and (memq system-type '(ms-dos windows-nt)) + (setq bdf-directory-list + (list (expand-file-name "fonts/bdf" installation-directory)))) (defun bdf-expand-file-name (bdfname) - "Return an abosolute path name of a `BDF' font file BDFNAME. + "Return an absolute path name of a `BDF' font file BDFNAME. It searches directories listed in the variable `bdf-directory-list' for BDFNAME." (if (file-name-absolute-p bdfname) @@ -88,7 +104,12 @@ If BDFNAME doesn't exist, return nil." (insert-file-contents file-name) buf))))) -(defvar bdf-cache-file "~/.bdfcache.el" +(defvar bdf-cache-file (if (eq system-type 'ms-dos) + ;; convert-standard-filename doesn't + ;; guarantee that the .el extension will be + ;; preserved. + "~/_bdfcache.el" + (convert-standard-filename "~/.bdfcache.el")) "Name of cache file which contains information of `BDF' font files.") (defvar bdf-cache nil @@ -115,7 +136,7 @@ If the cache file is not readable, this return nil." (defun bdf-write-cache () "Write out cached information of `BDF' font file to a file. The variable `bdf-cache-file' holds the cache file name. -The file is written if and only if the file alreay exists and writable." +The file is written if and only if the file already exists and writable." (and bdf-cache (file-exists-p bdf-cache-file) (file-writable-p bdf-cache-file) @@ -189,7 +210,7 @@ CODE-RANGE is a vector of minimum 1st byte, maximum 1st byte, minimum 2nd byte, maximum 2nd byte, minimum code, maximum code, and default code. For 1-byte fonts, the first two elements are 0. -MAXLEN is a maximum bytes of one glyph informaion in the font file. +MAXLEN is a maximum bytes of one glyph information in the font file. OFFSET-VECTOR is a vector of a file position which starts bitmap data of the glyph in the font file. @@ -203,7 +224,7 @@ CODE, where N and CODE are in the following relation: (relative-compose 'false) (baseline-offset 0) size - font-bounding-box + font-bounding-box default-char code-range offset-vector) @@ -231,7 +252,7 @@ CODE, where N and CODE are in the following relation: (setq size (read (current-buffer))) ;; The following kludgy code is t avoid bugs of several ;; fonts which have wrong SIZE record. - (and (<= size (/ (aref font-bounding-box 1) 2)) + (and (<= size (/ (aref font-bounding-box 1) 3)) (setq size (aref font-bounding-box 1))) (setq default-char (bdf-search-and-read "\nDEFAULT_CHAR" nil)) @@ -248,23 +269,25 @@ CODE, where N and CODE are in the following relation: (let ((min-code0 256) (min-code1 256) (min-code 65536) (max-code0 0) (max-code1 0) (max-code 0) - glyph glyph-list code0 code1 code bbx offset) + glyph glyph-list code0 code1 code offset) (while (search-forward "\nSTARTCHAR" nil t) (setq offset (line-beginning-position)) (search-forward "\nENCODING") - (setq code (read (current-buffer)) - code0 (lsh code -8) - code1 (logand code 255) - min-code (min min-code code) - max-code (max max-code code) - min-code0 (min min-code0 code0) - max-code0 (max max-code0 code0) - min-code1 (min min-code1 code1) - max-code1 (max max-code1 code1)) - (search-forward "ENDCHAR") - (setq maxlen (max maxlen (- (point) offset)) - glyph-list (cons (cons code offset) glyph-list))) + (setq code (read (current-buffer))) + (if (< code 0) + (search-forward "ENDCHAR") + (setq code0 (lsh code -8) + code1 (logand code 255) + min-code (min min-code code) + max-code (max max-code code) + min-code0 (min min-code0 code0) + max-code0 (max max-code0 code0) + min-code1 (min min-code1 code1) + max-code1 (max max-code1 code1)) + (search-forward "ENDCHAR") + (setq maxlen (max maxlen (- (point) offset)) + glyph-list (cons (cons code offset) glyph-list)))) (setq code-range (vector min-code0 max-code0 min-code1 max-code1 @@ -313,16 +336,36 @@ See the documentation of the function `bdf-read-font-info' for more detail." (bdf-set-cache font-info))) font-info)) +(defun bdf-find-font-info (bdfnames) + "Return information about `BDF' font file with alternative names BDFNAMES. + +If BDFNAMES is a list of file names, this function finds the first file +in the list which exists and is readable, then calls `bdf-get-font-info' +on that file name." + (let ((fnlist bdfnames) + (fname bdfnames)) + (if (consp fnlist) + (while (and fnlist + (progn + (setq fname (car fnlist)) + (null (bdf-expand-file-name fname)))) + (setq fname nil + fnlist (cdr fnlist)))) + (bdf-get-font-info (or fname (car bdfnames))))) + (defun bdf-read-bitmap (bdfname offset maxlen) - "Read `BDF' font file BDFNAME to get bitmap data at file poistion OFFSET. -BDFNAME is an abosolute path name of the font file. + "Read `BDF' font file BDFNAME to get bitmap data at file position OFFSET. +BDFNAME is an absolute path name of the font file. MAXLEN specifies how many bytes we should read at least. The value is a list of DWIDTH, BBX, and BITMAP-STRING. DWIDTH is a pixel width of a glyph. BBX is a bounding box of the glyph. BITMAP-STRING is a string representing bits by hexadecimal digits." - (let ((coding-system-for-read 'no-conversion) - dwidth bbx height yoff bitmap-string) + (let* ((coding-system-for-read 'no-conversion) + (bbx (elt (bdf-get-font-info bdfname) 4)) + (dwidth (elt bbx 0)) + (bitmap-string "") + height yoff) (condition-case nil (with-temp-buffer (insert-file-contents bdfname nil offset (+ offset maxlen)) @@ -333,7 +376,8 @@ BITMAP-STRING is a string representing bits by hexadecimal digits." (search-forward "\nBBX") (setq bbx (vector (read (current-buffer)) (read (current-buffer)) (read (current-buffer)) (read (current-buffer))) - height (aref bbx 1) yoff (aref bbx 3)) + height (aref bbx 1) + yoff (aref bbx 3)) (search-forward "\nBITMAP") (forward-line 1) (delete-region (point-min) (point)) @@ -368,9 +412,9 @@ The value is a list of CODE, DWIDTH, BBX, and BITMAP-STRING. DWIDTH is a pixel width of a glyph. BBX is a bounding box of the glyph. BITMAP-STRING is a string representing bits by hexadecimal digits." - (let* ((font-info (bdf-get-font-info bdfname)) + (let* ((font-info (bdf-find-font-info bdfname)) (absolute-path (bdf-info-absolute-path font-info)) - (font-bounding-box (bdf-info-font-bounding-box font-info)) + ;;(font-bounding-box (bdf-info-font-bounding-box font-info)) (maxlen (bdf-info-maxlen font-info)) (code-range (bdf-info-code-range font-info)) (offset-vector (bdf-info-offset-vector font-info))) @@ -392,7 +436,8 @@ BITMAP-STRING is a string representing bits by hexadecimal digits." ;; Called from ps-mule-generate-font. (defun bdf-generate-font (charset font-spec) (let* ((font-name (ps-mule-font-spec-name font-spec)) - (font-info (bdf-get-font-info font-name))) + (font-info (bdf-find-font-info font-name)) + (font-name (if (consp font-name) (car font-name) font-name))) (ps-mule-generate-bitmap-font font-name (ps-mule-font-spec-bytes font-spec) (charset-width charset) @@ -405,9 +450,12 @@ BITMAP-STRING is a string representing bits by hexadecimal digits." (defun bdf-generate-glyphs (font-spec code-list bytes) (let ((font-name (ps-mule-font-spec-name font-spec))) (mapcar '(lambda (x) - (apply 'ps-mule-generate-bitmap-glyph font-name x)) + (apply 'ps-mule-generate-bitmap-glyph + (if (consp font-name) (car font-name) font-name) + x)) (bdf-get-bitmaps font-name code-list)))) (provide 'ps-bdf) +;;; arch-tag: 9b875ba8-565a-4ecf-acaa-30cee732c898 ;;; ps-bdf.el ends here