diff options
| author | Kenichi Handa | 1998-12-15 06:38:12 +0000 |
|---|---|---|
| committer | Kenichi Handa | 1998-12-15 06:38:12 +0000 |
| commit | 2cb842aeec54fc9234f62fbc3b35cd99ef0a3776 (patch) | |
| tree | e8da9908263a4005de0d542f38f4aead0ad82bdb | |
| parent | 9c423e6b0488e3554c20bd303606cc883d1fd471 (diff) | |
| download | emacs-2cb842aeec54fc9234f62fbc3b35cd99ef0a3776.tar.gz emacs-2cb842aeec54fc9234f62fbc3b35cd99ef0a3776.zip | |
New file. Mule related code extracted from
ps-print.el. Require ps-print, provide ps-mule.
(ps-multibyte-buffer): Add autoload cookie.
(ps-mule-prepare-ascii-font): New fun.
(ps-mule-set-ascii-font): New fun.
(ps-mule-skip-same-charset): Fun deleted.
(ps-mule-plot-string): Set ps-mule-current-charset.
(ps-mule-initialize): Add autload cookie. Don't set
ps-mule-font-info-database here.
(ps-mule-begin-job): Renamed from ps-mule-begin. Update
ps-mule-font-info-database and ps-control-or-escape-regexp.
(ps-mule-begin-page): New fun.
Doc fix. Require ps-print only when compiled.
(ps-mule-prologue-generated): New fun.
(ps-mule-plot-string): Add autoload cookie.
(ps-mule-begin-job): Call ps-mule-prologue-generated.
Programming uniformization and little code improvement.
(ps-mule-prepare-font): Programming uniformization.
(ps-mule-find-wrappoint, ps-mule-plot-rule-cmpchar)
(ps-mule-string-encoding, ps-mule-begin-job): Little code improvement.
Always require ps-print. Move some function
definitions for Emacs 20.2 and the earlier to ps-print.el.
(ps-mule-find-wrappoint): Make it work also with Emacs 20.2.
(ps-mule-begin-job): Delete nil and unknown from a
list of character sets found by find-charset-region.
| -rw-r--r-- | lisp/ps-mule.el | 1156 |
1 files changed, 1156 insertions, 0 deletions
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index e69de29bb2d..49dac6b89fb 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el | |||
| @@ -0,0 +1,1156 @@ | |||
| 1 | ;;; ps-mule.el --- Provide multi-byte character facility to ps-print. | ||
| 2 | |||
| 3 | ;; Copyright (C) 1998 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> | ||
| 6 | ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | ||
| 7 | ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | ||
| 8 | ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> | ||
| 9 | ;; Keywords: print, PostScript, multibyte, mule | ||
| 10 | ;; Time-stamp: <98/12/15 14:04:50 handa> | ||
| 11 | |||
| 12 | ;; This file is part of GNU Emacs. | ||
| 13 | |||
| 14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 15 | ;; it under the terms of the GNU General Public License as published by | ||
| 16 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 17 | ;; any later version. | ||
| 18 | |||
| 19 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 22 | ;; GNU General Public License for more details. | ||
| 23 | |||
| 24 | ;; You should have received a copy of the GNU General Public License | ||
| 25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 26 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 27 | ;; Boston, MA 02111-1307, USA. | ||
| 28 | |||
| 29 | ;;; Commentary: | ||
| 30 | |||
| 31 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 32 | ;; | ||
| 33 | ;; About ps-mule | ||
| 34 | ;; ------------- | ||
| 35 | ;; | ||
| 36 | ;; This package is used for ps-print to print multi-byte buffer. | ||
| 37 | ;; | ||
| 38 | ;; See also ps-print.el. | ||
| 39 | ;; | ||
| 40 | ;; | ||
| 41 | ;; Printing Multi-byte Buffer | ||
| 42 | ;; -------------------------- | ||
| 43 | ;; | ||
| 44 | ;; The variable `ps-multibyte-buffer' specifies the ps-print multi-byte buffer | ||
| 45 | ;; handling. | ||
| 46 | ;; | ||
| 47 | ;; Valid values for `ps-multibyte-buffer' are: | ||
| 48 | ;; | ||
| 49 | ;; nil This is the value to use when you are printing | ||
| 50 | ;; buffer with only ASCII and Latin characters. | ||
| 51 | ;; | ||
| 52 | ;; `non-latin-printer' This is the value to use when you have a japanese | ||
| 53 | ;; or korean PostScript printer and want to print | ||
| 54 | ;; buffer with ASCII, Latin-1, Japanese (JISX0208 and | ||
| 55 | ;; JISX0201-Kana) and Korean characters. At present, | ||
| 56 | ;; it was not tested the Korean characters printing. | ||
| 57 | ;; If you have a korean PostScript printer, please, | ||
| 58 | ;; test it. | ||
| 59 | ;; | ||
| 60 | ;; `bdf-font' This is the value to use when you want to print | ||
| 61 | ;; buffer with BDF fonts. BDF fonts include both latin | ||
| 62 | ;; and non-latin fonts. BDF (Bitmap Distribution | ||
| 63 | ;; Format) is a format used for distributing X's font | ||
| 64 | ;; source file. BDF fonts are included in | ||
| 65 | ;; `intlfonts-1.1' which is a collection of X11 fonts | ||
| 66 | ;; for all characters supported by Emacs. In order to | ||
| 67 | ;; use this value, be sure to have installed | ||
| 68 | ;; `intlfonts-1.1' and set the variable | ||
| 69 | ;; `bdf-directory-list' appropriately (see ps-bdf.el | ||
| 70 | ;; for documentation of this variable). | ||
| 71 | ;; | ||
| 72 | ;; `bdf-font-except-latin' This is like `bdf-font' except that it is used | ||
| 73 | ;; PostScript default fonts to print ASCII and Latin-1 | ||
| 74 | ;; characters. This is convenient when you want or | ||
| 75 | ;; need to use both latin and non-latin characters on | ||
| 76 | ;; the same buffer. See `ps-font-family', | ||
| 77 | ;; `ps-header-font-family' and `ps-font-info-database'. | ||
| 78 | ;; | ||
| 79 | ;; Any other value is treated as nil. | ||
| 80 | ;; | ||
| 81 | ;; The default is nil. | ||
| 82 | ;; | ||
| 83 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 84 | |||
| 85 | ;;; Code: | ||
| 86 | |||
| 87 | (eval-and-compile (require 'ps-print)) | ||
| 88 | |||
| 89 | ;;;###autoload | ||
| 90 | (defcustom ps-multibyte-buffer nil | ||
| 91 | "*Specifies the multi-byte buffer handling. | ||
| 92 | |||
| 93 | Valid values are: | ||
| 94 | |||
| 95 | nil This is the value to use when you are printing | ||
| 96 | buffer with only ASCII and Latin characters. | ||
| 97 | |||
| 98 | `non-latin-printer' This is the value to use when you have a japanese | ||
| 99 | or korean PostScript printer and want to print | ||
| 100 | buffer with ASCII, Latin-1, Japanese (JISX0208 and | ||
| 101 | JISX0201-Kana) and Korean characters. At present, | ||
| 102 | it was not tested the Korean characters printing. | ||
| 103 | If you have a korean PostScript printer, please, | ||
| 104 | test it. | ||
| 105 | |||
| 106 | `bdf-font' This is the value to use when you want to print | ||
| 107 | buffer with BDF fonts. BDF fonts include both latin | ||
| 108 | and non-latin fonts. BDF (Bitmap Distribution | ||
| 109 | Format) is a format used for distributing X's font | ||
| 110 | source file. BDF fonts are included in | ||
| 111 | `intlfonts-1.1' which is a collection of X11 fonts | ||
| 112 | for all characters supported by Emacs. In order to | ||
| 113 | use this value, be sure to have installed | ||
| 114 | `intlfonts-1.1' and set the variable | ||
| 115 | `bdf-directory-list' appropriately (see ps-bdf.el for | ||
| 116 | documentation of this variable). | ||
| 117 | |||
| 118 | `bdf-font-except-latin' This is like `bdf-font' except that it is used | ||
| 119 | PostScript default fonts to print ASCII and Latin-1 | ||
| 120 | characters. This is convenient when you want or | ||
| 121 | need to use both latin and non-latin characters on | ||
| 122 | the same buffer. See `ps-font-family', | ||
| 123 | `ps-header-font-family' and `ps-font-info-database'. | ||
| 124 | |||
| 125 | Any other value is treated as nil." | ||
| 126 | :type '(choice (const non-latin-printer) (const bdf-font) | ||
| 127 | (const bdf-font-except-latin) (other :tag "nil" nil)) | ||
| 128 | :group 'ps-print-font) | ||
| 129 | |||
| 130 | ;; For Emacs 20.2 and the earlier version. | ||
| 131 | (eval-and-compile | ||
| 132 | (if (not (string< mule-version "4.0")) | ||
| 133 | (progn | ||
| 134 | (defalias 'ps-mule-next-point '1+) | ||
| 135 | (defalias 'ps-mule-chars-in-string 'length) | ||
| 136 | (defalias 'ps-mule-string-char 'aref) | ||
| 137 | (defsubst ps-mule-next-index (str i) (1+ i))) | ||
| 138 | (defun ps-mule-next-point (arg) | ||
| 139 | (save-excursion (goto-char arg) (forward-char 1) (point))) | ||
| 140 | (defun ps-mule-chars-in-string (string) | ||
| 141 | (/ (length string) | ||
| 142 | (charset-bytes (char-charset (string-to-char string))))) | ||
| 143 | (defun ps-mule-string-char (string idx) | ||
| 144 | (string-to-char (substring string idx))) | ||
| 145 | (defun ps-mule-next-index (string i) | ||
| 146 | (+ i (charset-bytes (char-charset (string-to-char string)))))) | ||
| 147 | ) | ||
| 148 | |||
| 149 | (defvar ps-mule-font-info-database | ||
| 150 | nil | ||
| 151 | "Alist of charsets with the corresponding font information. | ||
| 152 | Each element has the form: | ||
| 153 | |||
| 154 | (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...) | ||
| 155 | |||
| 156 | Where | ||
| 157 | |||
| 158 | CHARSET is a charset (symbol) for this font family, | ||
| 159 | |||
| 160 | FONT-TYPE is a font type: normal, bold, italic, or bold-italic. | ||
| 161 | |||
| 162 | FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil. | ||
| 163 | |||
| 164 | If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name. | ||
| 165 | |||
| 166 | If FONT-SRC is bdf, FONT-NAME is a BDF font file name. To use this font, | ||
| 167 | the external library `ps-bdf' is required. | ||
| 168 | |||
| 169 | If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows. | ||
| 170 | To use this font, the external library `vflib' is required. | ||
| 171 | |||
| 172 | If FONT-SRC is nil, a proper ASCII font in the variable | ||
| 173 | `ps-font-info-database' is used. This is useful for Latin-1 characters. | ||
| 174 | |||
| 175 | ENCODING is a coding system to encode a string of characters of CHARSET into a | ||
| 176 | proper string matching an encoding of the specified font. ENCODING may be a | ||
| 177 | function that does this encoding. In this case, the function is called with | ||
| 178 | one argument, the string to encode, and it should return an encoded string. | ||
| 179 | |||
| 180 | BYTES specifies how many bytes each character has in the encoded byte | ||
| 181 | sequence; it should be 1 or 2. | ||
| 182 | |||
| 183 | All multi-byte characters are printed by fonts specified in this database | ||
| 184 | regardless of a font family of ASCII characters. The exception is Latin-1 | ||
| 185 | characters which are printed by the same font as ASCII characters, thus obey | ||
| 186 | font family. | ||
| 187 | |||
| 188 | See also the variable `ps-font-info-database'.") | ||
| 189 | |||
| 190 | (defconst ps-mule-font-info-database-latin | ||
| 191 | '((latin-iso8859-1 | ||
| 192 | (normal nil nil iso-latin-1))) | ||
| 193 | "Sample setting of `ps-mule-font-info-database' to use latin fonts.") | ||
| 194 | |||
| 195 | (defconst ps-mule-font-info-database-ps | ||
| 196 | '((katakana-jisx0201 | ||
| 197 | (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1) | ||
| 198 | (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1) | ||
| 199 | (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)) | ||
| 200 | (latin-jisx0201 | ||
| 201 | (normat builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1) | ||
| 202 | (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1)) | ||
| 203 | (japanese-jisx0208 | ||
| 204 | (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2) | ||
| 205 | (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2)) | ||
| 206 | (korean-ksc5601 | ||
| 207 | (normal builtin "Batang-Medium-KSC-H" ps-mule-encode-7bit 2) | ||
| 208 | (bold builtin " Gulim-Medium-KSC-H" ps-mule-encode-7bit 2)) | ||
| 209 | ) | ||
| 210 | "Sample setting of the `ps-mule-font-info-database' to use builtin PS font. | ||
| 211 | |||
| 212 | Currently, data for Japanese and Korean PostScript printers are listed.") | ||
| 213 | |||
| 214 | (defconst ps-mule-font-info-database-bdf | ||
| 215 | '((ascii | ||
| 216 | (normal bdf "etl24-latin1.bdf" nil 1) | ||
| 217 | (bold bdf "etl16b-latin1.bdf" iso-latin-1 1) | ||
| 218 | (italic bdf "etl16i-latin1.bdf" iso-latin-1 1) | ||
| 219 | (bold-italic bdf "etl16bi-latin1.bdf" iso-latin-1 1)) | ||
| 220 | (latin-iso8859-1 | ||
| 221 | (normal bdf "etl24-latin1.bdf" iso-latin-1 1) | ||
| 222 | (bold bdf "etl16b-latin1.bdf" iso-latin-1 1) | ||
| 223 | (italic bdf "etl16i-latin1.bdf" iso-latin-1 1) | ||
| 224 | (bold-italic bdf "etl16bi-latin1.bdf" iso-latin-1 1)) | ||
| 225 | (latin-iso8859-2 | ||
| 226 | (normal bdf "etl24-latin2.bdf" iso-latin-2 1)) | ||
| 227 | (latin-iso8859-3 | ||
| 228 | (normal bdf "etl24-latin3.bdf" iso-latin-3 1)) | ||
| 229 | (latin-iso8859-4 | ||
| 230 | (normal bdf "etl24-latin4.bdf" iso-latin-4 1)) | ||
| 231 | (thai-tis620 | ||
| 232 | (normal bdf "thai-24.bdf" thai-tis620 1)) | ||
| 233 | (greek-iso8859-7 | ||
| 234 | (normal bdf "etl24-greek.bdf" greek-iso-8bit 1)) | ||
| 235 | ;; (arabic-iso8859-6 nil) ; not yet available | ||
| 236 | (hebrew-iso8859-8 | ||
| 237 | (normal bdf "etl24-hebrew.bdf" hebrew-iso-8bit 1)) | ||
| 238 | (katakana-jisx0201 | ||
| 239 | (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1)) | ||
| 240 | (latin-jisx0201 | ||
| 241 | (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1)) | ||
| 242 | (cyrillic-iso8859-5 | ||
| 243 | (normal bdf "etl24-cyrillic.bdf" cyrillic-iso-8bit 1)) | ||
| 244 | (latin-iso8859-9 | ||
| 245 | (normal bdf "etl24-latin5.bdf" iso-latin-5 1)) | ||
| 246 | (japanese-jisx0208-1978 | ||
| 247 | (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) | ||
| 248 | (chinese-gb2312 | ||
| 249 | (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2)) | ||
| 250 | (japanese-jisx0208 | ||
| 251 | (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) | ||
| 252 | (korean-ksc5601 | ||
| 253 | (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2)) | ||
| 254 | (japanese-jisx0212 | ||
| 255 | (normal bdf "jisksp40.bdf" ps-mule-encode-7bit 2)) | ||
| 256 | (chinese-cns11643-1 | ||
| 257 | (normal bdf "cns-1-40.bdf" ps-mule-encode-7bit 2)) | ||
| 258 | (chinese-cns11643-2 | ||
| 259 | (normal bdf "cns-2-40.bdf" ps-mule-encode-7bit 2)) | ||
| 260 | (chinese-big5-1 | ||
| 261 | (normal bdf "taipei24.bdf" chinese-big5 2)) | ||
| 262 | (chinese-big5-2 | ||
| 263 | (normal bdf "taipei24.bdf" chinese-big5 2)) | ||
| 264 | (chinese-sisheng | ||
| 265 | (normal bdf "etl24-sisheng.bdf" ps-mule-encode-8bit 1)) | ||
| 266 | (ipa | ||
| 267 | (normal bdf "etl24-ipa.bdf" ps-mule-encode-8bit 1)) | ||
| 268 | (vietnamese-viscii-lower | ||
| 269 | (normal bdf "etl24-viscii.bdf" vietnamese-viscii 1)) | ||
| 270 | (vietnamese-viscii-upper | ||
| 271 | (normal bdf "etl24-viscii.bdf" vietnamese-viscii 1)) | ||
| 272 | (arabic-digit | ||
| 273 | (normal bdf "etl24-arabic0.bdf" ps-mule-encode-7bit 1)) | ||
| 274 | (arabic-1-column | ||
| 275 | (normal bdf "etl24-arabic1.bdf" ps-mule-encode-7bit 1)) | ||
| 276 | ;; (ascii-right-to-left nil) ; not yet available | ||
| 277 | (lao | ||
| 278 | (normal bdf "mule-lao-24.bdf" lao 1)) | ||
| 279 | (arabic-2-column | ||
| 280 | (normal bdf "etl24-arabic2.bdf" ps-mule-encode-7bit 1)) | ||
| 281 | (indian-is13194 | ||
| 282 | (normal bdf "mule-iscii-24.bdf" ps-mule-encode-7bit 1)) | ||
| 283 | (indian-1-column | ||
| 284 | (normal bdf "mule-indian-1col-24.bdf" ps-mule-encode-7bit 2)) | ||
| 285 | (tibetan-1-column | ||
| 286 | (normal bdf "mule-tibmdx-1col-24.bdf" ps-mule-encode-7bit 2)) | ||
| 287 | (ethiopic | ||
| 288 | (normal bdf "ethiomx24f-uni.bdf" ps-mule-encode-ethiopic 2)) | ||
| 289 | (chinese-cns11643-3 | ||
| 290 | (normal bdf "cns-3-40.bdf" ps-mule-encode-7bit 2)) | ||
| 291 | (chinese-cns11643-4 | ||
| 292 | (normal bdf "cns-4-40.bdf" ps-mule-encode-7bit 2)) | ||
| 293 | (chinese-cns11643-5 | ||
| 294 | (normal bdf "cns-5-40.bdf" ps-mule-encode-7bit 2)) | ||
| 295 | (chinese-cns11643-6 | ||
| 296 | (normal bdf "cns-6-40.bdf" ps-mule-encode-7bit 2)) | ||
| 297 | (chinese-cns11643-7 | ||
| 298 | (normal bdf "cns-7-40.bdf" ps-mule-encode-7bit 2)) | ||
| 299 | (indian-2-column | ||
| 300 | (normal bdf "mule-indian-24.bdf" ps-mule-encode-7bit 2)) | ||
| 301 | (tibetan | ||
| 302 | (normal bdf "mule-tibmdx-24.bdf" ps-mule-encode-7bit 2))) | ||
| 303 | "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. | ||
| 304 | BDF (Bitmap Distribution Format) is a format used for distributing X's font | ||
| 305 | source file. | ||
| 306 | |||
| 307 | Current default value list for BDF fonts is included in `intlfonts-1.1' which is | ||
| 308 | a collection of X11 fonts for all characters supported by Emacs. | ||
| 309 | |||
| 310 | Using this list as default value to `ps-mule-font-info-database', all characters | ||
| 311 | including ASCII and Latin-1 are printed by BDF fonts. | ||
| 312 | |||
| 313 | See also `ps-mule-font-info-database-ps-bdf'.") | ||
| 314 | |||
| 315 | (defconst ps-mule-font-info-database-ps-bdf | ||
| 316 | (cons (car ps-mule-font-info-database-latin) | ||
| 317 | (cdr (cdr ps-mule-font-info-database-bdf))) | ||
| 318 | "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. | ||
| 319 | |||
| 320 | Current default value list for BDF fonts is included in `intlfonts-1.1' which is | ||
| 321 | a collection of X11 fonts for all characters supported by Emacs. | ||
| 322 | |||
| 323 | Using this list as default value to `ps-mule-font-info-database', all characters | ||
| 324 | except ASCII and Latin-1 characters are printed by BDF fonts. ASCII and Latin-1 | ||
| 325 | characters are printed by PostScript font specified by `ps-font-family' and | ||
| 326 | `ps-header-font-family'. | ||
| 327 | |||
| 328 | See also `ps-mule-font-info-database-bdf'.") | ||
| 329 | |||
| 330 | ;; Two typical encoding functions for PostScript fonts. | ||
| 331 | |||
| 332 | (defun ps-mule-encode-7bit (string) | ||
| 333 | (ps-mule-encode-bit string 0)) | ||
| 334 | |||
| 335 | (defun ps-mule-encode-8bit (string) | ||
| 336 | (ps-mule-encode-bit string 128)) | ||
| 337 | |||
| 338 | (defun ps-mule-encode-bit (string delta) | ||
| 339 | (let* ((dim (charset-dimension (char-charset (string-to-char string)))) | ||
| 340 | (len (* (ps-mule-chars-in-string string) dim)) | ||
| 341 | (str (make-string len 0)) | ||
| 342 | (i 0) | ||
| 343 | (j 0)) | ||
| 344 | (if (= dim 1) | ||
| 345 | (while (< j len) | ||
| 346 | (aset str j | ||
| 347 | (+ (nth 1 (split-char (ps-mule-string-char string i))) delta)) | ||
| 348 | (setq i (ps-mule-next-index string i) | ||
| 349 | j (1+ j))) | ||
| 350 | (while (< j len) | ||
| 351 | (let ((split (split-char (ps-mule-string-char string i)))) | ||
| 352 | (aset str j (+ (nth 1 split) delta)) | ||
| 353 | (aset str (1+ j) (+ (nth 2 split) delta)) | ||
| 354 | (setq i (ps-mule-next-index string i) | ||
| 355 | j (+ j 2))))) | ||
| 356 | str)) | ||
| 357 | |||
| 358 | ;; Special encoding function for Ethiopic. | ||
| 359 | (define-ccl-program ccl-encode-ethio-unicode | ||
| 360 | `(1 | ||
| 361 | ((read r2) | ||
| 362 | (loop | ||
| 363 | (if (r2 == ,leading-code-private-22) | ||
| 364 | ((read r0) | ||
| 365 | (if (r0 == ,(charset-id 'ethiopic)) | ||
| 366 | ((read r1 r2) | ||
| 367 | (r1 &= 127) (r2 &= 127) | ||
| 368 | (call ccl-encode-ethio-font) | ||
| 369 | (write r1) | ||
| 370 | (write-read-repeat r2)) | ||
| 371 | ((write r2 r0) | ||
| 372 | (repeat)))) | ||
| 373 | (write-read-repeat r2)))))) | ||
| 374 | |||
| 375 | (defun ps-mule-encode-ethiopic (string) | ||
| 376 | (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode) | ||
| 377 | (make-vector 9 nil) | ||
| 378 | string)) | ||
| 379 | |||
| 380 | ;; A charset which we are now processing. | ||
| 381 | (defvar ps-mule-current-charset nil) | ||
| 382 | |||
| 383 | (defun ps-mule-get-font-spec (charset font-type) | ||
| 384 | "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE. | ||
| 385 | FONT-SPEC is a list that has the form: | ||
| 386 | |||
| 387 | (FONT-SRC FONT-NAME ENCODING BYTES) | ||
| 388 | |||
| 389 | FONT-SPEC is extracted from `ps-mule-font-info-database'. | ||
| 390 | |||
| 391 | See the documentation of `ps-mule-font-info-database' for the meaning of each | ||
| 392 | element of the list." | ||
| 393 | (let ((slot (cdr (assq charset ps-mule-font-info-database)))) | ||
| 394 | (and slot | ||
| 395 | (cdr (or (assq font-type slot) | ||
| 396 | (and (eq font-type 'bold-italic) | ||
| 397 | (or (assq 'bold slot) (assq 'italic slot))) | ||
| 398 | (assq 'normal slot)))))) | ||
| 399 | |||
| 400 | ;; Functions to access each element of FONT-SPEC. | ||
| 401 | (defsubst ps-mule-font-spec-src (font-spec) (car font-spec)) | ||
| 402 | (defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec)) | ||
| 403 | (defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec)) | ||
| 404 | (defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec)) | ||
| 405 | |||
| 406 | (defsubst ps-mule-printable-p (charset) | ||
| 407 | "Non-nil if characters in CHARSET is printable." | ||
| 408 | (ps-mule-get-font-spec charset 'normal)) | ||
| 409 | |||
| 410 | (defconst ps-mule-external-libraries | ||
| 411 | '((builtin nil nil | ||
| 412 | nil nil nil) | ||
| 413 | (bdf ps-bdf nil | ||
| 414 | bdf-generate-prologue bdf-generate-font bdf-generate-glyphs) | ||
| 415 | (pcf nil nil | ||
| 416 | pcf-generate-prologue pcf-generate-font pcf-generate-glyphs) | ||
| 417 | (vflib nil nil | ||
| 418 | vflib-generate-prologue vflib-generate-font vflib-generate-glyphs)) | ||
| 419 | "Alist of information of external libraries to support PostScript printing. | ||
| 420 | Each element has the form: | ||
| 421 | |||
| 422 | (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC) | ||
| 423 | |||
| 424 | FONT-SRC is the font source: builtin, bdf, pcf, or vflib. | ||
| 425 | |||
| 426 | FEATURE is the feature that provide a facility to handle FONT-SRC. Except for | ||
| 427 | `builtin' FONT-SRC, this feature is automatically `require'd before handling | ||
| 428 | FONT-SRC. Currently, we only have the feature `ps-bdf'. | ||
| 429 | |||
| 430 | INITIALIZED-P indicates if this library is initialized or not. | ||
| 431 | |||
| 432 | PROLOGUE-FUNC is a function to generate PostScript code which define several | ||
| 433 | PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is | ||
| 434 | called with no argument, and should return a list of strings. | ||
| 435 | |||
| 436 | FONT-FUNC is a function to generate PostScript code which define a new font. It | ||
| 437 | is called with one argument FONT-SPEC, and should return a list of strings. | ||
| 438 | |||
| 439 | GLYPHS-FUNC is a function to generate PostScript code which define glyphs of | ||
| 440 | characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES, | ||
| 441 | and should return a list of strings.") | ||
| 442 | |||
| 443 | (defun ps-mule-init-external-library (font-spec) | ||
| 444 | "Initialize external library specified by FONT-SPEC for PostScript printing. | ||
| 445 | See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning." | ||
| 446 | (let* ((font-src (ps-mule-font-spec-src font-spec)) | ||
| 447 | (slot (assq font-src ps-mule-external-libraries))) | ||
| 448 | (or (not font-src) | ||
| 449 | (nth 2 slot) | ||
| 450 | (let ((func (nth 3 slot))) | ||
| 451 | (if func | ||
| 452 | (progn | ||
| 453 | (or (featurep (nth 1 slot)) (require (nth 1 slot))) | ||
| 454 | (ps-output-prologue (funcall func)))) | ||
| 455 | (setcar (nthcdr 2 slot) t))))) | ||
| 456 | |||
| 457 | ;; Cached glyph information of fonts, alist of: | ||
| 458 | ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...) | ||
| 459 | ;; cache CODE0 CODE1 ...) | ||
| 460 | (defvar ps-mule-font-cache nil) | ||
| 461 | |||
| 462 | (defun ps-mule-generate-font (font-spec charset) | ||
| 463 | "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET." | ||
| 464 | (let* ((font-cache (assoc (ps-mule-font-spec-name font-spec) | ||
| 465 | ps-mule-font-cache)) | ||
| 466 | (font-src (ps-mule-font-spec-src font-spec)) | ||
| 467 | (font-name (ps-mule-font-spec-name font-spec)) | ||
| 468 | (func (nth 4 (assq font-src ps-mule-external-libraries))) | ||
| 469 | (scaled-font-name | ||
| 470 | (if (eq charset 'ascii) | ||
| 471 | (format "f%d" ps-current-font) | ||
| 472 | (format "f%02x-%d" | ||
| 473 | (charset-id charset) ps-current-font)))) | ||
| 474 | (and func (not font-cache) | ||
| 475 | (ps-output-prologue (funcall func charset font-spec))) | ||
| 476 | (ps-output-prologue | ||
| 477 | (list (format "/%s %f /%s Def%sFontMule\n" | ||
| 478 | scaled-font-name ps-font-size font-name | ||
| 479 | (if (eq ps-mule-current-charset 'ascii) "Ascii" "")))) | ||
| 480 | (if font-cache | ||
| 481 | (setcar (cdr font-cache) | ||
| 482 | (cons (cons ps-current-font scaled-font-name) | ||
| 483 | (nth 1 font-cache))) | ||
| 484 | (setq font-cache (list font-name | ||
| 485 | (list (cons ps-current-font scaled-font-name)) | ||
| 486 | 'cache) | ||
| 487 | ps-mule-font-cache (cons font-cache ps-mule-font-cache))) | ||
| 488 | font-cache)) | ||
| 489 | |||
| 490 | (defun ps-mule-generate-glyphs (font-spec code-list) | ||
| 491 | "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC." | ||
| 492 | (let* ((font-src (ps-mule-font-spec-src font-spec)) | ||
| 493 | (func (nth 5 (assq font-src ps-mule-external-libraries)))) | ||
| 494 | (and func | ||
| 495 | (ps-output-prologue | ||
| 496 | (funcall func font-spec code-list | ||
| 497 | (ps-mule-font-spec-bytes font-spec)))))) | ||
| 498 | |||
| 499 | (defun ps-mule-prepare-font (font-spec string charset &optional no-setfont) | ||
| 500 | "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC. | ||
| 501 | |||
| 502 | The generated code is inserted on prologue part except the code that sets the | ||
| 503 | current font (using PostScript procedure `FM'). | ||
| 504 | |||
| 505 | If optional arg NO-SETFONT is non-nil, don't generate the code for setting the | ||
| 506 | current font." | ||
| 507 | (let ((font-cache (assoc (ps-mule-font-spec-name font-spec) | ||
| 508 | ps-mule-font-cache))) | ||
| 509 | (or (and font-cache (assq ps-current-font (nth 1 font-cache))) | ||
| 510 | (setq font-cache (ps-mule-generate-font font-spec charset))) | ||
| 511 | (or no-setfont | ||
| 512 | (let ((new-font (cdr (assq ps-current-font (nth 1 font-cache))))) | ||
| 513 | (or (equal new-font ps-last-font) | ||
| 514 | (progn | ||
| 515 | (ps-output (format "/%s FM\n" new-font)) | ||
| 516 | (setq ps-last-font new-font))))) | ||
| 517 | (if (nth 5 (assq (ps-mule-font-spec-src font-spec) | ||
| 518 | ps-mule-external-libraries)) | ||
| 519 | ;; We have to generate PostScript codes which define glyphs. | ||
| 520 | (let* ((cached-codes (nthcdr 2 font-cache)) | ||
| 521 | (bytes (ps-mule-font-spec-bytes font-spec)) | ||
| 522 | (len (length string)) | ||
| 523 | (i 0) | ||
| 524 | newcodes code) | ||
| 525 | (while (< i len) | ||
| 526 | (setq code (if (= bytes 1) | ||
| 527 | (aref string i) | ||
| 528 | (+ (* (aref string i) 256) (aref string (1+ i))))) | ||
| 529 | (or (memq code cached-codes) | ||
| 530 | (progn | ||
| 531 | (setq newcodes (cons code newcodes)) | ||
| 532 | (setcdr cached-codes (cons code (cdr cached-codes))))) | ||
| 533 | (setq i (+ i bytes))) | ||
| 534 | (and newcodes | ||
| 535 | (ps-mule-generate-glyphs font-spec newcodes)))))) | ||
| 536 | |||
| 537 | ;;;###autoload | ||
| 538 | (defun ps-mule-prepare-ascii-font (string) | ||
| 539 | "Setup special ASCII font for STRING. | ||
| 540 | STRING should contain only ASCII characters." | ||
| 541 | (let ((font-spec | ||
| 542 | (ps-mule-get-font-spec | ||
| 543 | 'ascii | ||
| 544 | (car (nth ps-current-font (ps-font-alist 'ps-font-for-text)))))) | ||
| 545 | (and font-spec | ||
| 546 | (ps-mule-prepare-font font-spec string 'ascii)))) | ||
| 547 | |||
| 548 | ;;;###autoload | ||
| 549 | (defun ps-mule-set-ascii-font () | ||
| 550 | (unless (eq ps-mule-current-charset 'ascii) | ||
| 551 | (ps-set-font ps-current-font) | ||
| 552 | (setq ps-mule-current-charset 'ascii))) | ||
| 553 | |||
| 554 | ;; List of charsets of multi-byte characters in a text being printed. | ||
| 555 | ;; If the text doesn't contain any multi-byte characters (i.e. only ASCII), | ||
| 556 | ;; the value is nil. | ||
| 557 | (defvar ps-mule-charset-list nil) | ||
| 558 | |||
| 559 | ;; This is a PostScript code inserted in the header of generated PostScript. | ||
| 560 | (defconst ps-mule-prologue | ||
| 561 | "%%%% Start of Mule Section | ||
| 562 | |||
| 563 | %% Working dictionary for general use. | ||
| 564 | /MuleDict 10 dict def | ||
| 565 | |||
| 566 | %% Define already scaled font for non-ASCII character sets. | ||
| 567 | /DefFontMule { % fontname size basefont |- -- | ||
| 568 | findfont exch scalefont definefont pop | ||
| 569 | } bind def | ||
| 570 | |||
| 571 | %% Define already scaled font for ASCII character sets. | ||
| 572 | /DefAsciiFontMule { % fontname size basefont |- | ||
| 573 | MuleDict begin | ||
| 574 | findfont dup /Encoding get /ISOLatin1Encoding exch def | ||
| 575 | exch scalefont reencodeFontISO | ||
| 576 | end | ||
| 577 | } def | ||
| 578 | |||
| 579 | %% Set the specified non-ASCII font to use. It doesn't install | ||
| 580 | %% Ascent, etc. | ||
| 581 | /FM { % fontname |- -- | ||
| 582 | findfont setfont | ||
| 583 | } bind def | ||
| 584 | |||
| 585 | %% Show vacant box for characters which don't have appropriate font. | ||
| 586 | /SB { % count column |- -- | ||
| 587 | SpaceWidth mul /w exch def | ||
| 588 | 1 exch 1 exch { %for | ||
| 589 | pop | ||
| 590 | gsave | ||
| 591 | 0 setlinewidth | ||
| 592 | 0 Descent rmoveto w 0 rlineto | ||
| 593 | 0 LineHeight rlineto w neg 0 rlineto closepath stroke | ||
| 594 | grestore | ||
| 595 | w 0 rmoveto | ||
| 596 | } for | ||
| 597 | } bind def | ||
| 598 | |||
| 599 | %% Flag to tell if we are now handling a composite character. This is | ||
| 600 | %% defined here because both composite character handler and bitmap font | ||
| 601 | %% handler require it. | ||
| 602 | /Cmpchar false def | ||
| 603 | |||
| 604 | %%%% End of Mule Section | ||
| 605 | |||
| 606 | " | ||
| 607 | "PostScript code for printing multi-byte characters.") | ||
| 608 | |||
| 609 | (defvar ps-mule-prologue-generated nil) | ||
| 610 | |||
| 611 | (defun ps-mule-prologue-generated () | ||
| 612 | (unless ps-mule-prologue-generated | ||
| 613 | (ps-output-prologue ps-mule-prologue) | ||
| 614 | (setq ps-mule-prologue-generated t))) | ||
| 615 | |||
| 616 | (defun ps-mule-find-wrappoint (from to char-width) | ||
| 617 | "Find the longest sequence which is printable in the current line. | ||
| 618 | |||
| 619 | The search starts at FROM and goes until TO. It is assumed that all characters | ||
| 620 | between FROM and TO belong to a charset in `ps-mule-current-charset'. | ||
| 621 | |||
| 622 | CHAR-WIDTH is the average width of ASCII characters in the current font. | ||
| 623 | |||
| 624 | Returns the value: | ||
| 625 | |||
| 626 | (ENDPOS . RUN-WIDTH) | ||
| 627 | |||
| 628 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | ||
| 629 | the sequence." | ||
| 630 | (if (eq ps-mule-current-charset 'composition) | ||
| 631 | ;; We must draw one char by one. | ||
| 632 | (let ((run-width (* (char-width (char-after from)) char-width))) | ||
| 633 | (if (> run-width ps-width-remaining) | ||
| 634 | (cons from ps-width-remaining) | ||
| 635 | (cons (ps-mule-next-point from) run-width))) | ||
| 636 | ;; We assume that all characters in this range have the same width. | ||
| 637 | (setq char-width (* char-width (charset-width ps-mule-current-charset))) | ||
| 638 | (let ((run-width (* (chars-in-region from to) char-width))) | ||
| 639 | (if (> run-width ps-width-remaining) | ||
| 640 | (cons (min to | ||
| 641 | (save-excursion | ||
| 642 | (goto-char from) | ||
| 643 | (forward-point | ||
| 644 | (truncate (/ ps-width-remaining char-width))))) | ||
| 645 | ps-width-remaining) | ||
| 646 | (cons to run-width))))) | ||
| 647 | |||
| 648 | ;;;###autoload | ||
| 649 | (defun ps-mule-plot-string (from to &optional bg-color) | ||
| 650 | "Generate PostScript code for ploting characters in the region FROM and TO. | ||
| 651 | |||
| 652 | It is assumed that all characters in this region belong to the same charset. | ||
| 653 | |||
| 654 | Optional argument BG-COLOR specifies background color. | ||
| 655 | |||
| 656 | Returns the value: | ||
| 657 | |||
| 658 | (ENDPOS . RUN-WIDTH) | ||
| 659 | |||
| 660 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | ||
| 661 | the sequence." | ||
| 662 | (setq ps-mule-current-charset (charset-after from)) | ||
| 663 | (let* ((wrappoint (ps-mule-find-wrappoint | ||
| 664 | from to (ps-avg-char-width 'ps-font-for-text))) | ||
| 665 | (to (car wrappoint)) | ||
| 666 | (font-type (car (nth ps-current-font | ||
| 667 | (ps-font-alist 'ps-font-for-text)))) | ||
| 668 | (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) | ||
| 669 | (string (buffer-substring-no-properties from to))) | ||
| 670 | (cond | ||
| 671 | ((= from to) | ||
| 672 | ;; We can't print any more characters in the current line. | ||
| 673 | nil) | ||
| 674 | |||
| 675 | (font-spec | ||
| 676 | ;; We surely have a font for printing this character set. | ||
| 677 | (ps-output-string (ps-mule-string-encoding font-spec string)) | ||
| 678 | (ps-output " S\n")) | ||
| 679 | |||
| 680 | ((eq ps-mule-current-charset 'latin-iso8859-1) | ||
| 681 | ;; Latin-1 can be printed by a normal ASCII font. | ||
| 682 | (ps-output-string (ps-mule-string-ascii string)) | ||
| 683 | (ps-output " S\n")) | ||
| 684 | |||
| 685 | ((eq ps-mule-current-charset 'composition) | ||
| 686 | (let* ((ch (char-after from)) | ||
| 687 | (width (char-width ch)) | ||
| 688 | (ch-list (decompose-composite-char ch 'list t))) | ||
| 689 | (if (consp (nth 1 ch-list)) | ||
| 690 | (ps-mule-plot-rule-cmpchar ch-list width font-type) | ||
| 691 | (ps-mule-plot-cmpchar ch-list width t font-type)))) | ||
| 692 | |||
| 693 | (t | ||
| 694 | ;; No way to print this charset. Just show a vacant box of an | ||
| 695 | ;; appropriate width. | ||
| 696 | (ps-output (format "%d %d SB\n" | ||
| 697 | (length string) | ||
| 698 | (if (eq ps-mule-current-charset 'composition) | ||
| 699 | (char-width (char-after from)) | ||
| 700 | (charset-width ps-mule-current-charset)))))) | ||
| 701 | wrappoint)) | ||
| 702 | |||
| 703 | ;; Composite font support | ||
| 704 | |||
| 705 | (defvar ps-mule-cmpchar-prologue-generated nil) | ||
| 706 | |||
| 707 | (defconst ps-mule-cmpchar-prologue | ||
| 708 | "%%%% Composite character handler | ||
| 709 | /CmpcharWidth 0 def | ||
| 710 | /CmpcharRelativeCompose 0 def | ||
| 711 | /CmpcharRelativeSkip 0.4 def | ||
| 712 | |||
| 713 | %% Get a bounding box (relative to currentpoint) of STR. | ||
| 714 | /GetPathBox { % str |- -- | ||
| 715 | gsave | ||
| 716 | currentfont /FontType get 3 eq { %ifelse | ||
| 717 | stringwidth pop pop | ||
| 718 | } { | ||
| 719 | currentpoint /y exch def pop | ||
| 720 | false charpath flattenpath pathbbox | ||
| 721 | y sub /URY exch def pop | ||
| 722 | y sub /LLY exch def pop | ||
| 723 | } ifelse | ||
| 724 | grestore | ||
| 725 | } bind def | ||
| 726 | |||
| 727 | %% Beginning of composite char. | ||
| 728 | /BC { % str xoff width |- -- | ||
| 729 | /Cmpchar true def | ||
| 730 | /CmpcharWidth exch def | ||
| 731 | currentfont /RelativeCompose known { | ||
| 732 | /CmpcharRelativeCompose currentfont /RelativeCompose get def | ||
| 733 | } { | ||
| 734 | /CmpcharRelativeCompose false def | ||
| 735 | } ifelse | ||
| 736 | /bgsave bg def /bgcolorsave bgcolor def | ||
| 737 | /Effectsave Effect def | ||
| 738 | gsave % Reflect effect only at first | ||
| 739 | /Effect Effect 1 2 add 4 add 16 add and def | ||
| 740 | /f0 findfont setfont ( ) 0 CmpcharWidth getinterval S | ||
| 741 | grestore | ||
| 742 | /Effect Effectsave 8 32 add and def % enable only shadow and outline | ||
| 743 | false BG | ||
| 744 | gsave SpaceWidth mul 0 rmoveto dup GetPathBox S grestore | ||
| 745 | /y currentpoint exch pop def | ||
| 746 | /HIGH URY y add def /LOW LLY y add def | ||
| 747 | } bind def | ||
| 748 | |||
| 749 | %% End of composite char. | ||
| 750 | /EC { % -- |- -- | ||
| 751 | /bg bgsave def /bgcolor bgcolorsave def | ||
| 752 | /Effect Effectsave def | ||
| 753 | /Cmpchar false def | ||
| 754 | CmpcharWidth SpaceWidth mul 0 rmoveto | ||
| 755 | } bind def | ||
| 756 | |||
| 757 | %% Rule base composition | ||
| 758 | /RBC { % str xoff gref nref |- -- | ||
| 759 | /nref exch def /gref exch def | ||
| 760 | gsave | ||
| 761 | SpaceWidth mul 0 rmoveto | ||
| 762 | dup | ||
| 763 | GetPathBox | ||
| 764 | [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get | ||
| 765 | [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get | ||
| 766 | sub /btm exch def | ||
| 767 | /top btm URY LLY sub add def | ||
| 768 | top HIGH gt { /HIGH top def } if | ||
| 769 | btm LOW lt { /LOW btm def } if | ||
| 770 | currentpoint pop btm LLY sub moveto | ||
| 771 | S | ||
| 772 | grestore | ||
| 773 | } bind def | ||
| 774 | |||
| 775 | %% Relative composition | ||
| 776 | /RLC { % str |- -- | ||
| 777 | gsave | ||
| 778 | dup GetPathBox | ||
| 779 | CmpcharRelativeCompose type /integertype eq { | ||
| 780 | LLY CmpcharRelativeCompose gt { % compose on top | ||
| 781 | currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto | ||
| 782 | /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def | ||
| 783 | } { URY 0 le { % compose under bottom | ||
| 784 | currentpoint pop LOW LLY add CmpcharRelativeSkip sub moveto | ||
| 785 | /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def | ||
| 786 | } if } ifelse } if | ||
| 787 | S | ||
| 788 | grestore | ||
| 789 | } bind def | ||
| 790 | %%%% End of composite character handler | ||
| 791 | |||
| 792 | " | ||
| 793 | "PostScript code for printing composite characters.") | ||
| 794 | |||
| 795 | (defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type) | ||
| 796 | (let ((leftmost 0.0) | ||
| 797 | (rightmost (float (char-width (car ch-rule-list)))) | ||
| 798 | (the-list (cons '(3 . 3) ch-rule-list)) | ||
| 799 | cmpchar-elements) | ||
| 800 | (while the-list | ||
| 801 | (let* ((this (car the-list)) | ||
| 802 | (gref (car this)) | ||
| 803 | (nref (cdr this)) | ||
| 804 | ;; X-axis info (0:left, 1:center, 2:right) | ||
| 805 | (gref-x (% gref 3)) | ||
| 806 | (nref-x (% nref 3)) | ||
| 807 | ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center) | ||
| 808 | (gref-y (if (= gref 4) 3 (/ gref 3))) | ||
| 809 | (nref-y (if (= nref 4) 3 (/ nref 3))) | ||
| 810 | (char (car (cdr the-list))) | ||
| 811 | (width (float (char-width char))) | ||
| 812 | left) | ||
| 813 | (setq left (+ leftmost | ||
| 814 | (* (- rightmost leftmost) gref-x 0.5) | ||
| 815 | (- (* nref-x width 0.5))) | ||
| 816 | cmpchar-elements (cons (list char left gref-y nref-y) | ||
| 817 | cmpchar-elements) | ||
| 818 | leftmost (min left leftmost) | ||
| 819 | rightmost (max (+ left width) rightmost) | ||
| 820 | the-list (nthcdr 2 the-list)))) | ||
| 821 | (if (< leftmost 0) | ||
| 822 | (let ((the-list cmpchar-elements) | ||
| 823 | elt) | ||
| 824 | (while the-list | ||
| 825 | (setq elt (car the-list) | ||
| 826 | the-list (cdr the-list)) | ||
| 827 | (setcar (cdr elt) (- (nth 1 elt) leftmost))))) | ||
| 828 | (ps-mule-plot-cmpchar (nreverse cmpchar-elements) | ||
| 829 | total-width nil font-type))) | ||
| 830 | |||
| 831 | (defun ps-mule-plot-cmpchar (elements total-width relativep font-type) | ||
| 832 | (let* ((elt (car elements)) | ||
| 833 | (ch (if relativep elt (car elt)))) | ||
| 834 | (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type)) | ||
| 835 | (ps-output (format " %d %d BC " | ||
| 836 | (if relativep 0 (nth 1 elt)) | ||
| 837 | total-width)) | ||
| 838 | (while (setq elements (cdr elements)) | ||
| 839 | (setq elt (car elements) | ||
| 840 | ch (if relativep elt (car elt))) | ||
| 841 | (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type)) | ||
| 842 | (ps-output (if relativep | ||
| 843 | " RLC " | ||
| 844 | (format " %d %d %d RBC " | ||
| 845 | (nth 1 elt) (nth 2 elt) (nth 3 elt)))))) | ||
| 846 | (ps-output "EC\n")) | ||
| 847 | |||
| 848 | (defun ps-mule-prepare-cmpchar-font (char font-type) | ||
| 849 | (let* ((ps-mule-current-charset (char-charset char)) | ||
| 850 | (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))) | ||
| 851 | (cond (font-spec | ||
| 852 | (ps-mule-string-encoding font-spec (char-to-string char))) | ||
| 853 | |||
| 854 | ((eq ps-mule-current-charset 'latin-iso8859-1) | ||
| 855 | (ps-mule-string-ascii (char-to-string char))) | ||
| 856 | |||
| 857 | (t | ||
| 858 | ;; No font for CHAR. | ||
| 859 | (ps-set-font ps-current-font) | ||
| 860 | " ")))) | ||
| 861 | |||
| 862 | (defun ps-mule-string-ascii (str) | ||
| 863 | (ps-set-font ps-current-font) | ||
| 864 | (string-as-unibyte (encode-coding-string str 'iso-latin-1))) | ||
| 865 | |||
| 866 | (defun ps-mule-string-encoding (font-spec str) | ||
| 867 | (let ((encoding (ps-mule-font-spec-encoding font-spec))) | ||
| 868 | (setq str | ||
| 869 | (string-as-unibyte | ||
| 870 | (cond ((coding-system-p encoding) | ||
| 871 | (encode-coding-string str encoding)) | ||
| 872 | ((functionp encoding) | ||
| 873 | (funcall encoding str)) | ||
| 874 | (encoding | ||
| 875 | (error "Invalid coding system or function: %s" encoding)) | ||
| 876 | (t | ||
| 877 | str)))) | ||
| 878 | (if (ps-mule-font-spec-src font-spec) | ||
| 879 | (ps-mule-prepare-font font-spec str ps-mule-current-charset) | ||
| 880 | (ps-set-font ps-current-font)) | ||
| 881 | str)) | ||
| 882 | |||
| 883 | ;; Bitmap font support | ||
| 884 | |||
| 885 | (defvar ps-mule-bitmap-prologue-generated nil) | ||
| 886 | |||
| 887 | (defconst ps-mule-bitmap-prologue | ||
| 888 | "%%%% Bitmap font handler | ||
| 889 | |||
| 890 | /str7 7 string def % working area | ||
| 891 | |||
| 892 | %% We grow the dictionary one bunch (1024 entries) by one. | ||
| 893 | /BitmapDictArray 256 array def | ||
| 894 | /BitmapDictLength 1024 def | ||
| 895 | /BitmapDictIndex -1 def | ||
| 896 | |||
| 897 | /NewBitmapDict { % -- |- -- | ||
| 898 | /BitmapDictIndex BitmapDictIndex 1 add def | ||
| 899 | BitmapDictArray BitmapDictIndex BitmapDictLength dict put | ||
| 900 | } bind def | ||
| 901 | |||
| 902 | %% Make at least one dictionary. | ||
| 903 | NewBitmapDict | ||
| 904 | |||
| 905 | /AddBitmap { % gloval-charname bitmap-data |- -- | ||
| 906 | BitmapDictArray BitmapDictIndex get | ||
| 907 | dup length BitmapDictLength ge { | ||
| 908 | pop | ||
| 909 | NewBitmapDict | ||
| 910 | BitmapDictArray BitmapDictIndex get | ||
| 911 | } if | ||
| 912 | 3 1 roll put | ||
| 913 | } bind def | ||
| 914 | |||
| 915 | /GetBitmap { % gloval-charname |- bitmap-data | ||
| 916 | 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for | ||
| 917 | load | ||
| 918 | 0 1 BitmapDictIndex { pop end } for | ||
| 919 | } bind def | ||
| 920 | |||
| 921 | %% Return a global character name which can be used as a key in the | ||
| 922 | %% bitmap dictionary. | ||
| 923 | /GlobalCharName { % fontidx code1 code2 |- gloval-charname | ||
| 924 | exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put | ||
| 925 | str7 cvn | ||
| 926 | } bind def | ||
| 927 | |||
| 928 | %% Character code holder for a 2-byte character. | ||
| 929 | /FirstCode -1 def | ||
| 930 | |||
| 931 | %% Glyph rendering procedure | ||
| 932 | /BuildGlyphCommon { % fontdict charname |- -- | ||
| 933 | 1 index /FontDimension get 1 eq { /FirstCode 0 store } if | ||
| 934 | NameIndexDict exch get % STACK: fontdict charcode | ||
| 935 | FirstCode 0 lt { %ifelse | ||
| 936 | %% This is the first byte of a 2-byte character. Just | ||
| 937 | %% remember it for the moment. | ||
| 938 | /FirstCode exch store | ||
| 939 | pop | ||
| 940 | 0 0 setcharwidth | ||
| 941 | } { | ||
| 942 | 1 index /FontSize get /size exch def | ||
| 943 | 1 index /FontSpaceWidthRatio get /ratio exch def | ||
| 944 | 1 index /FontIndex get exch FirstCode exch | ||
| 945 | GlobalCharName GetBitmap /bmp exch def | ||
| 946 | %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ] | ||
| 947 | Cmpchar { %ifelse | ||
| 948 | /FontMatrix get [ exch { size div } forall ] /mtrx exch def | ||
| 949 | bmp 3 get bmp 4 get mtrx transform | ||
| 950 | /LLY exch def pop | ||
| 951 | bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform | ||
| 952 | /URY exch def pop | ||
| 953 | } { | ||
| 954 | pop | ||
| 955 | } ifelse | ||
| 956 | /FirstCode -1 store | ||
| 957 | |||
| 958 | bmp 0 get SpaceWidthRatio ratio div mul size div 0 % wx wy | ||
| 959 | setcharwidth % We can't use setcachedevice here. | ||
| 960 | |||
| 961 | bmp 1 get 0 gt bmp 2 get 0 gt and { | ||
| 962 | bmp 1 get bmp 2 get % width height | ||
| 963 | true % polarity | ||
| 964 | [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix | ||
| 965 | bmp 5 1 getinterval cvx % datasrc | ||
| 966 | imagemask | ||
| 967 | } if | ||
| 968 | } ifelse | ||
| 969 | } bind def | ||
| 970 | |||
| 971 | /BuildCharCommon { | ||
| 972 | 1 index /Encoding get exch get | ||
| 973 | 1 index /BuildGlyph get exec | ||
| 974 | } bind def | ||
| 975 | |||
| 976 | %% Bitmap font creater | ||
| 977 | |||
| 978 | %% Common Encoding shared by all bitmap fonts. | ||
| 979 | /EncodingCommon 256 array def | ||
| 980 | %% Mapping table from character name to character code. | ||
| 981 | /NameIndexDict 256 dict def | ||
| 982 | 0 1 255 { %for | ||
| 983 | /idx exch def | ||
| 984 | /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67 | ||
| 985 | EncodingCommon idx idxname put | ||
| 986 | NameIndexDict idxname idx put | ||
| 987 | } for | ||
| 988 | |||
| 989 | /GlobalFontIndex 0 def | ||
| 990 | |||
| 991 | %% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- | ||
| 992 | /BitmapFont { | ||
| 993 | 15 dict begin | ||
| 994 | /FontBBox exch def | ||
| 995 | /BaselineOffset exch def | ||
| 996 | /RelativeCompose exch def | ||
| 997 | /FontSize exch def | ||
| 998 | /FontBBox [ FontBBox { FontSize div } forall ] def | ||
| 999 | FontBBox 2 get FontBBox 0 get sub exch div | ||
| 1000 | /FontSpaceWidthRatio exch def | ||
| 1001 | /FontDimension exch def | ||
| 1002 | /FontIndex GlobalFontIndex def | ||
| 1003 | /FontType 3 def | ||
| 1004 | /FontMatrix matrix def | ||
| 1005 | /Encoding EncodingCommon def | ||
| 1006 | /BuildGlyph { BuildGlyphCommon } def | ||
| 1007 | /BuildChar { BuildCharCommon } def | ||
| 1008 | currentdict end | ||
| 1009 | definefont pop | ||
| 1010 | /GlobalFontIndex GlobalFontIndex 1 add def | ||
| 1011 | } bind def | ||
| 1012 | |||
| 1013 | %% Define a new bitmap font. | ||
| 1014 | %% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- | ||
| 1015 | /NF { | ||
| 1016 | /fbbx exch def | ||
| 1017 | %% Convert BDF's FontBoundingBox to PostScript's FontBBox | ||
| 1018 | [ fbbx 2 get fbbx 3 get | ||
| 1019 | fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ] | ||
| 1020 | BitmapFont | ||
| 1021 | } bind def | ||
| 1022 | |||
| 1023 | %% Define a glyph for the specified font and character. | ||
| 1024 | /NG { % fontname charcode bitmap-data |- -- | ||
| 1025 | /bmp exch def | ||
| 1026 | exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put | ||
| 1027 | /FontIndex get exch | ||
| 1028 | dup 256 idiv exch 256 mod GlobalCharName | ||
| 1029 | bmp AddBitmap | ||
| 1030 | } bind def | ||
| 1031 | %%%% End of bitmap font handler | ||
| 1032 | |||
| 1033 | ") | ||
| 1034 | |||
| 1035 | ;; External library support. | ||
| 1036 | |||
| 1037 | ;; The following three functions are to be called from external | ||
| 1038 | ;; libraries which support bitmap fonts (e.g. `bdf') to get | ||
| 1039 | ;; appropriate PostScript code. | ||
| 1040 | |||
| 1041 | (defun ps-mule-generate-bitmap-prologue () | ||
| 1042 | (unless ps-mule-bitmap-prologue-generated | ||
| 1043 | (setq ps-mule-bitmap-prologue-generated t) | ||
| 1044 | (list ps-mule-bitmap-prologue))) | ||
| 1045 | |||
| 1046 | (defun ps-mule-generate-bitmap-font (&rest args) | ||
| 1047 | (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args))) | ||
| 1048 | |||
| 1049 | (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap) | ||
| 1050 | (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n" | ||
| 1051 | font-name code | ||
| 1052 | dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3) | ||
| 1053 | bitmap)) | ||
| 1054 | |||
| 1055 | ;; Mule specific initializers. | ||
| 1056 | |||
| 1057 | ;;;###autoload | ||
| 1058 | (defun ps-mule-initialize () | ||
| 1059 | "Initialize global data for printing multi-byte characters." | ||
| 1060 | (setq ps-mule-font-cache nil | ||
| 1061 | ps-mule-prologue-generated nil | ||
| 1062 | ps-mule-cmpchar-prologue-generated nil | ||
| 1063 | ps-mule-bitmap-prologue-generated nil) | ||
| 1064 | (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil)) | ||
| 1065 | ps-mule-external-libraries)) | ||
| 1066 | |||
| 1067 | ;;;###autoload | ||
| 1068 | (defun ps-mule-begin-job (from to) | ||
| 1069 | "Start printing job for multi-byte chars between FROM and TO. | ||
| 1070 | This checks if all multi-byte characters in the region are printable or not." | ||
| 1071 | (setq ps-mule-charset-list nil | ||
| 1072 | ps-mule-font-info-database | ||
| 1073 | (cond ((eq ps-multibyte-buffer 'non-latin-printer) | ||
| 1074 | ps-mule-font-info-database-ps) | ||
| 1075 | ((eq ps-multibyte-buffer 'bdf-font) | ||
| 1076 | ps-mule-font-info-database-bdf) | ||
| 1077 | ((eq ps-multibyte-buffer 'bdf-font-except-latin) | ||
| 1078 | ps-mule-font-info-database-ps-bdf) | ||
| 1079 | (t | ||
| 1080 | ps-mule-font-info-database-latin))) | ||
| 1081 | (and (boundp 'enable-multibyte-characters) | ||
| 1082 | enable-multibyte-characters | ||
| 1083 | ;; Initialize `ps-mule-charset-list'. If some characters aren't | ||
| 1084 | ;; printable, warn it. | ||
| 1085 | (let ((charsets (find-charset-region from to))) | ||
| 1086 | (setq charsets (delq 'ascii (delq 'unknown (delq nil charsets)))) | ||
| 1087 | (setq ps-mule-charset-list charsets) | ||
| 1088 | (save-excursion | ||
| 1089 | (goto-char from) | ||
| 1090 | (and (search-forward "\200" to t) | ||
| 1091 | (setq ps-mule-charset-list | ||
| 1092 | (cons 'composition ps-mule-charset-list)))) | ||
| 1093 | (while charsets | ||
| 1094 | (setq charsets | ||
| 1095 | (cond | ||
| 1096 | ((or (eq (car charsets) 'composition) | ||
| 1097 | (ps-mule-printable-p (car charsets))) | ||
| 1098 | (cdr charsets)) | ||
| 1099 | ((y-or-n-p | ||
| 1100 | "Font for some characters not found, continue anyway? ") | ||
| 1101 | nil) | ||
| 1102 | (t | ||
| 1103 | (error "Printing cancelled"))))))) | ||
| 1104 | |||
| 1105 | (setq ps-mule-current-charset 'ascii) | ||
| 1106 | |||
| 1107 | (if ps-mule-charset-list | ||
| 1108 | (let ((the-list ps-mule-charset-list) | ||
| 1109 | font-spec elt) | ||
| 1110 | (ps-mule-prologue-generated) | ||
| 1111 | ;; If external functions are necessary, generate prologues for them. | ||
| 1112 | (while the-list | ||
| 1113 | (setq elt (car the-list) | ||
| 1114 | the-list (cdr the-list)) | ||
| 1115 | (cond ((and (eq elt 'composition) | ||
| 1116 | (not ps-mule-cmpchar-prologue-generated)) | ||
| 1117 | (ps-output-prologue ps-mule-cmpchar-prologue) | ||
| 1118 | (setq ps-mule-cmpchar-prologue-generated t)) | ||
| 1119 | ((setq font-spec (ps-mule-get-font-spec elt 'normal)) | ||
| 1120 | (ps-mule-init-external-library font-spec)))))) | ||
| 1121 | |||
| 1122 | ;; If ASCII font is also specified in ps-mule-font-info-database, | ||
| 1123 | ;; use it istead of what specified in ps-font-info-database. | ||
| 1124 | (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal))) | ||
| 1125 | (if font-spec | ||
| 1126 | (progn | ||
| 1127 | (ps-mule-prologue-generated) | ||
| 1128 | (ps-mule-init-external-library font-spec) | ||
| 1129 | (let ((font (ps-font-alist 'ps-font-for-text)) | ||
| 1130 | (ps-current-font 0)) | ||
| 1131 | (while font | ||
| 1132 | ;; Be sure to download a glyph for SPACE in advance. | ||
| 1133 | (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii (car font)) | ||
| 1134 | " " 'ascii 'no-setfont) | ||
| 1135 | (setq font (cdr font) | ||
| 1136 | ps-current-font (1+ ps-current-font))))))) | ||
| 1137 | |||
| 1138 | (if ps-mule-charset-list | ||
| 1139 | ;; We must change this regexp for multi-byte buffer. | ||
| 1140 | (setq ps-control-or-escape-regexp | ||
| 1141 | (cond ((eq ps-print-control-characters '8-bit) | ||
| 1142 | "[^\040-\176]") | ||
| 1143 | ((eq ps-print-control-characters 'control-8-bit) | ||
| 1144 | (string-as-multibyte "[^\040-\176\240-\377]")) | ||
| 1145 | ((eq ps-print-control-characters 'control) | ||
| 1146 | (string-as-multibyte "[^\040-\176\200-\377]")) | ||
| 1147 | (t (string-as-multibyte "[^\000-\011\013\015-\377")))))) | ||
| 1148 | |||
| 1149 | ;;;###autoload | ||
| 1150 | (defun ps-mule-begin-page () | ||
| 1151 | (setq ps-mule-current-charset 'ascii)) | ||
| 1152 | |||
| 1153 | |||
| 1154 | (provide 'ps-mule) | ||
| 1155 | |||
| 1156 | ;;; ps-mule.el ends here | ||