1;;; ps-mule.el --- provide multi-byte character facility to ps-print 2 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> 7;; Kenichi Handa <handa@m17n.org> (multi-byte characters) 8;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters) 9;; Vinicius Jose Latorre <viniciusjl@ig.com.br> 10;; Keywords: wp, print, PostScript, multibyte, mule 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., 51 Franklin Street, Fifth Floor, 27;; Boston, MA 02110-1301, 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 the default settings which 50;; is by default for printing buffer with only ASCII 51;; and Latin characters. The default setting can be 52;; changed by setting the variable 53;; `ps-mule-font-info-database-default' differently. 54;; The initial value of this variable is 55;; `ps-mule-font-info-database-latin' (see 56;; documentation). 57;; 58;; `non-latin-printer' This is the value to use when you have a japanese 59;; or korean PostScript printer and want to print 60;; buffer with ASCII, Latin-1, Japanese (JISX0208 and 61;; JISX0201-Kana) and Korean characters. At present, 62;; it was not tested the Korean characters printing. 63;; If you have a korean PostScript printer, please, 64;; test it. 65;; 66;; `bdf-font' This is the value to use when you want to print 67;; buffer with BDF fonts. BDF fonts include both latin 68;; and non-latin fonts. BDF (Bitmap Distribution 69;; Format) is a format used for distributing X's font 70;; source file. BDF fonts are included in 71;; `intlfonts-1.2' which is a collection of X11 fonts 72;; for all characters supported by Emacs. In order to 73;; use this value, be sure to have installed 74;; `intlfonts-1.2' and set the variable 75;; `bdf-directory-list' appropriately (see ps-bdf.el 76;; for documentation of this variable). 77;; 78;; `bdf-font-except-latin' This is like `bdf-font' except that it is used 79;; PostScript default fonts to print ASCII and Latin-1 80;; characters. This is convenient when you want or 81;; need to use both latin and non-latin characters on 82;; the same buffer. See `ps-font-family', 83;; `ps-header-font-family' and `ps-font-info-database'. 84;; 85;; Any other value is treated as nil. 86;; 87;; The default is nil. 88;; 89;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 90 91;;; Code: 92 93(eval-and-compile 94 (require 'ps-print) 95 96 ;; to avoid XEmacs compilation gripes 97 (defvar leading-code-private-22 157) 98 (or (fboundp 'charset-bytes) 99 (defun charset-bytes (charset) 1)) ; ascii 100 (or (fboundp 'charset-dimension) 101 (defun charset-dimension (charset) 1)) ; ascii 102 (or (fboundp 'charset-id) 103 (defun charset-id (charset) 0)) ; ascii 104 (or (fboundp 'charset-width) 105 (defun charset-width (charset) 1)) ; ascii 106 (or (fboundp 'find-charset-region) 107 (defun find-charset-region (beg end &optional table) 108 (list 'ascii))) 109 (or (fboundp 'char-valid-p) 110 (defun char-valid-p (char) 111 (< (following-char) 256))) 112 (or (fboundp 'split-char) 113 (defun split-char (char) 114 (list (if (char-valid-p char) 115 'ascii 116 'unknow) 117 char))) 118 (or (fboundp 'char-width) 119 (defun char-width (char) 1)) ; ascii 120 (or (fboundp 'chars-in-region) 121 (defun chars-in-region (beg end) 122 (- (max beg end) (min beg end)))) 123 (or (fboundp 'forward-point) 124 (defun forward-point (arg) 125 (save-excursion 126 (let ((count (abs arg)) 127 (step (if (zerop arg) 128 0 129 (/ arg arg)))) 130 (while (and (> count 0) 131 (< (point-min) (point)) (< (point) (point-max))) 132 (forward-char step) 133 (setq count (1- count))) 134 (+ (point) (* count step)))))) 135 (or (fboundp 'decompose-composite-char) 136 (defun decompose-composite-char (char &optional type 137 with-composition-rule) 138 nil)) 139 (or (fboundp 'encode-coding-string) 140 (defun encode-coding-string (string coding-system &optional nocopy) 141 (if nocopy 142 string 143 (copy-sequence string)))) 144 (or (fboundp 'coding-system-p) 145 (defun coding-system-p (obj) nil)) 146 (or (fboundp 'ccl-execute-on-string) 147 (defun ccl-execute-on-string (ccl-prog status str 148 &optional contin unibyte-p) 149 str)) 150 (or (fboundp 'define-ccl-program) 151 (defmacro define-ccl-program (name ccl-program &optional doc) 152 `(defconst ,name nil ,doc))) 153 (or (fboundp 'multibyte-string-p) 154 (defun multibyte-string-p (str) 155 (let ((len (length str)) 156 (i 0) 157 multibyte) 158 (while (and (< i len) (not (setq multibyte (> (aref str i) 255)))) 159 (setq i (1+ i))) 160 multibyte))) 161 (or (fboundp 'string-make-multibyte) 162 (defalias 'string-make-multibyte 'copy-sequence)) 163 (or (fboundp 'encode-char) 164 (defun encode-char (ch ccs) 165 ch))) 166 167 168;;;###autoload 169(defcustom ps-multibyte-buffer nil 170 "*Specifies the multi-byte buffer handling. 171 172Valid values are: 173 174 nil This is the value to use the default settings which 175 is by default for printing buffer with only ASCII 176 and Latin characters. The default setting can be 177 changed by setting the variable 178 `ps-mule-font-info-database-default' differently. 179 The initial value of this variable is 180 `ps-mule-font-info-database-latin' (see 181 documentation). 182 183 `non-latin-printer' This is the value to use when you have a Japanese 184 or Korean PostScript printer and want to print 185 buffer with ASCII, Latin-1, Japanese (JISX0208 and 186 JISX0201-Kana) and Korean characters. At present, 187 it was not tested the Korean characters printing. 188 If you have a korean PostScript printer, please, 189 test it. 190 191 `bdf-font' This is the value to use when you want to print 192 buffer with BDF fonts. BDF fonts include both latin 193 and non-latin fonts. BDF (Bitmap Distribution 194 Format) is a format used for distributing X's font 195 source file. BDF fonts are included in 196 `intlfonts-1.2' which is a collection of X11 fonts 197 for all characters supported by Emacs. In order to 198 use this value, be sure to have installed 199 `intlfonts-1.2' and set the variable 200 `bdf-directory-list' appropriately (see ps-bdf.el for 201 documentation of this variable). 202 203 `bdf-font-except-latin' This is like `bdf-font' except that it is used 204 PostScript default fonts to print ASCII and Latin-1 205 characters. This is convenient when you want or 206 need to use both latin and non-latin characters on 207 the same buffer. See `ps-font-family', 208 `ps-header-font-family' and `ps-font-info-database'. 209 210Any other value is treated as nil." 211 :type '(choice (const non-latin-printer) (const bdf-font) 212 (const bdf-font-except-latin) (const :tag "nil" nil)) 213 :group 'ps-print-font) 214 215(defvar ps-mule-font-info-database 216 nil 217 "Alist of charsets with the corresponding font information. 218Each element has the form: 219 220 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...) 221 222Where 223 224CHARSET is a charset (symbol) for this font family, 225 226FONT-TYPE is a font type: normal, bold, italic, or bold-italic. 227 228FONT-SRC is a font source: builtin, bdf, vflib, or nil. 229 230 If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name. 231 232 If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of 233 alternative font names. To use this font, the external library `ps-bdf' 234 is required. 235 236 If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows. 237 To use this font, the external library `vflib' is required. 238 239 If FONT-SRC is nil, a proper ASCII font in the variable 240 `ps-font-info-database' is used. This is useful for Latin-1 characters. 241 242ENCODING is a coding system to encode a string of characters of CHARSET into a 243proper string matching an encoding of the specified font. ENCODING may be a 244function that does this encoding. In this case, the function is called with 245one argument, the string to encode, and it should return an encoded string. 246 247BYTES specifies how many bytes each character has in the encoded byte 248sequence; it should be 1 or 2. 249 250All multi-byte characters are printed by fonts specified in this database 251regardless of a font family of ASCII characters. The exception is Latin-1 252characters which are printed by the same font as ASCII characters, thus obey 253font family. 254 255See also the variable `ps-font-info-database'.") 256 257(defconst ps-mule-font-info-database-latin 258 '((latin-iso8859-1 259 (normal nil nil iso-latin-1))) 260 "Sample setting of `ps-mule-font-info-database' to use latin fonts.") 261 262(defcustom ps-mule-font-info-database-default 263 ps-mule-font-info-database-latin 264 "*The default setting to use when `ps-multibyte-buffer' is nil." 265 :type '(symbol :tag "Multi-Byte Buffer Database Font Default") 266 :group 'ps-print-font) 267 268(defconst ps-mule-font-info-database-ps 269 '((katakana-jisx0201 270 (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1) 271 (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1) 272 (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)) 273 (latin-jisx0201 274 (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1) 275 (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1)) 276 (japanese-jisx0208 277 (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2) 278 (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2)) 279 (korean-ksc5601 280 (normal builtin "Munhwa-Regular-KSC-EUC-H" ps-mule-encode-7bit 2) 281 (bold builtin "Munhwa-Bold-KSC-EUC-H" ps-mule-encode-7bit 2)) 282 ) 283 "Sample setting of the `ps-mule-font-info-database' to use builtin PS font. 284 285Currently, data for Japanese and Korean PostScript printers are listed.") 286 287(defconst ps-mule-font-info-database-bdf 288 '((ascii 289 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1) 290 (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") nil 1) 291 (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") nil 1) 292 (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") nil 1)) 293 (latin-iso8859-1 294 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") iso-latin-1 1) 295 (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1) 296 (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1) 297 (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1)) 298 (latin-iso8859-2 299 (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1)) 300 (latin-iso8859-3 301 (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1)) 302 (latin-iso8859-4 303 (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1)) 304 (thai-tis620 305 (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1)) 306 (greek-iso8859-7 307 (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1)) 308 ;; (arabic-iso8859-6 nil) ; not yet available 309 (hebrew-iso8859-8 310 (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1)) 311 (katakana-jisx0201 312 (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1)) 313 (latin-jisx0201 314 (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1)) 315 (cyrillic-iso8859-5 316 (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1)) 317 (latin-iso8859-9 318 (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1)) 319 (japanese-jisx0208-1978 320 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) 321 (chinese-gb2312 322 (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2)) 323 (japanese-jisx0208 324 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) 325 (korean-ksc5601 326 (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2)) 327 (japanese-jisx0212 328 (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2)) 329 (chinese-cns11643-1 330 (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2)) 331 (chinese-cns11643-2 332 (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2)) 333 (chinese-big5-1 334 (normal bdf "taipei24.bdf" chinese-big5 2)) 335 (chinese-big5-2 336 (normal bdf "taipei24.bdf" chinese-big5 2)) 337 (chinese-sisheng 338 (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1)) 339 (ipa 340 (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1)) 341 (vietnamese-viscii-lower 342 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1)) 343 (vietnamese-viscii-upper 344 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1)) 345 (arabic-digit 346 (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1)) 347 (arabic-1-column 348 (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1)) 349 ;; (ascii-right-to-left nil) ; not yet available 350 (lao 351 (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1)) 352 (arabic-2-column 353 (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1)) 354 (indian-is13194 355 (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1)) 356 (indian-1-column 357 (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2)) 358 (tibetan-1-column 359 (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2)) 360 (ethiopic 361 (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2)) 362 (chinese-cns11643-3 363 (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2)) 364 (chinese-cns11643-4 365 (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2)) 366 (chinese-cns11643-5 367 (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2)) 368 (chinese-cns11643-6 369 (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2)) 370 (chinese-cns11643-7 371 (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2)) 372 (indian-2-column 373 (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2)) 374 (tibetan 375 (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf") 376 ps-mule-encode-7bit 2)) 377 (mule-unicode-0100-24ff 378 (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)) 379 (mule-unicode-2500-33ff 380 (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)) 381 (mule-unicode-e000-ffff 382 (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))) 383 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. 384BDF (Bitmap Distribution Format) is a format used for distributing X's font 385source file. 386 387Current default value list for BDF fonts is included in `intlfonts-1.2' 388which is a collection of X11 fonts for all characters supported by Emacs. 389 390Using this list as default value to `ps-mule-font-info-database', all 391characters including ASCII and Latin-1 are printed by BDF fonts. 392 393See also `ps-mule-font-info-database-ps-bdf'.") 394 395(defconst ps-mule-font-info-database-ps-bdf 396 (cons (car ps-mule-font-info-database-latin) 397 (cdr (cdr ps-mule-font-info-database-bdf))) 398 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. 399 400Current default value list for BDF fonts is included in `intlfonts-1.2' 401which is a collection of X11 fonts for all characters supported by Emacs. 402 403Using this list as default value to `ps-mule-font-info-database', all 404characters except ASCII and Latin-1 characters are printed with BDF fonts. 405ASCII and Latin-1 characters are printed with PostScript font specified 406by `ps-font-family' and `ps-header-font-family'. 407 408See also `ps-mule-font-info-database-bdf'.") 409 410;; Two typical encoding functions for PostScript fonts. 411 412(defun ps-mule-encode-7bit (string) 413 (ps-mule-encode-bit string 0)) 414 415(defun ps-mule-encode-8bit (string) 416 (ps-mule-encode-bit string 128)) 417 418(defun ps-mule-encode-bit (string delta) 419 (let* ((dim (charset-dimension (char-charset (string-to-char string)))) 420 (len (* (length string) dim)) 421 (str (make-string len 0)) 422 (i 0) 423 (j 0)) 424 (if (= dim 1) 425 (while (< j len) 426 (aset str j 427 (+ (nth 1 (split-char (aref string i))) delta)) 428 (setq i (1+ i) 429 j (1+ j))) 430 (while (< j len) 431 (let ((split (split-char (aref string i)))) 432 (aset str j (+ (nth 1 split) delta)) 433 (aset str (1+ j) (+ (nth 2 split) delta)) 434 (setq i (1+ i) 435 j (+ j 2))))) 436 str)) 437 438;; Special encoding function for Ethiopic. 439(if (boundp 'mule-version) ; only if mule package is loaded 440 (define-ccl-program ccl-encode-ethio-unicode 441 `(1 442 ((read r2) 443 (loop 444 (if (r2 == ,leading-code-private-22) 445 ((read r0) 446 (if (r0 == ,(charset-id 'ethiopic)) 447 ((read r1 r2) 448 (r1 &= 127) (r2 &= 127) 449 (call ccl-encode-ethio-font) 450 (write r1) 451 (write-read-repeat r2)) 452 ((write r2 r0) 453 (repeat)))) 454 (write-read-repeat r2)))))) 455 ;; to avoid compilation gripes 456 (defvar ccl-encode-ethio-unicode nil)) 457 458(if (boundp 'mule-version) 459 ;; bound mule-version 460 (defun ps-mule-encode-ethiopic (string) 461 (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode) 462 (make-vector 9 nil) 463 string)) 464 ;; unbound mule-version 465 (defun ps-mule-encode-ethiopic (string) 466 string)) 467 468;; Special encoding for mule-unicode-* characters. 469(defun ps-mule-encode-ucs2 (string) 470 (let* ((len (length string)) 471 (str (make-string (* 2 len) 0)) 472 (i 0) 473 (j 0) 474 ch hi lo) 475 (while (< i len) 476 (setq ch (encode-char (aref string i) 'ucs) 477 hi (lsh ch -8) 478 lo (logand ch 255)) 479 (aset str j hi) 480 (aset str (1+ j) lo) 481 (setq i (1+ i) 482 j (+ j 2))) 483 str)) 484 485;; A charset which we are now processing. 486(defvar ps-mule-current-charset nil) 487 488(defun ps-mule-get-font-spec (charset font-type) 489 "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE. 490FONT-SPEC is a list that has the form: 491 492 (FONT-SRC FONT-NAME ENCODING BYTES) 493 494FONT-SPEC is extracted from `ps-mule-font-info-database'. 495 496See the documentation of `ps-mule-font-info-database' for the meaning of each 497element of the list." 498 (let ((slot (cdr (assq charset ps-mule-font-info-database)))) 499 (and slot 500 (cdr (or (assq font-type slot) 501 (and (eq font-type 'bold-italic) 502 (or (assq 'bold slot) (assq 'italic slot))) 503 (assq 'normal slot)))))) 504 505;; Functions to access each element of FONT-SPEC. 506(defsubst ps-mule-font-spec-src (font-spec) (car font-spec)) 507(defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec)) 508(defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec)) 509(defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec)) 510 511(defsubst ps-mule-printable-p (charset) 512 "Non-nil if characters in CHARSET is printable." 513 ;; ASCII and Latin-1 are always printable. 514 (or (eq charset 'ascii) 515 (eq charset 'latin-iso8859-1) 516 (ps-mule-get-font-spec charset 'normal))) 517 518(defconst ps-mule-external-libraries 519 '((builtin nil nil 520 nil nil nil) 521 (bdf ps-bdf nil 522 bdf-generate-prologue bdf-generate-font bdf-generate-glyphs) 523 (pcf nil nil 524 pcf-generate-prologue pcf-generate-font pcf-generate-glyphs) 525 (vflib nil nil 526 vflib-generate-prologue vflib-generate-font vflib-generate-glyphs)) 527 "Alist of information of external libraries to support PostScript printing. 528Each element has the form: 529 530 (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC) 531 532FONT-SRC is the font source: builtin, bdf, pcf, or vflib. 533 534FEATURE is the feature that provide a facility to handle FONT-SRC. Except for 535`builtin' FONT-SRC, this feature is automatically `require'd before handling 536FONT-SRC. Currently, we only have the feature `ps-bdf'. 537 538INITIALIZED-P indicates if this library is initialized or not. 539 540PROLOGUE-FUNC is a function to generate PostScript code which define several 541PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is 542called with no argument, and should return a list of strings. 543 544FONT-FUNC is a function to generate PostScript code which define a new font. It 545is called with one argument FONT-SPEC, and should return a list of strings. 546 547GLYPHS-FUNC is a function to generate PostScript code which define glyphs of 548characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES, 549and should return a list of strings.") 550 551(defun ps-mule-init-external-library (font-spec) 552 "Initialize external library specified by FONT-SPEC for PostScript printing. 553See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning." 554 (let* ((font-src (ps-mule-font-spec-src font-spec)) 555 (slot (assq font-src ps-mule-external-libraries))) 556 (or (not font-src) 557 (nth 2 slot) 558 (let ((func (nth 3 slot))) 559 (if func 560 (progn 561 (require (nth 1 slot)) 562 (ps-output-prologue (funcall func)))) 563 (setcar (nthcdr 2 slot) t))))) 564 565;; Cached glyph information of fonts, alist of: 566;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...) 567;; cache CODE0 CODE1 ...) 568(defvar ps-mule-font-cache nil) 569 570(defun ps-mule-generate-font (font-spec charset &optional header-p) 571 "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET. 572 573If optional 3rd arg HEADER-P is non-nil, generate codes to define a header 574font." 575 (let* ((font-name (ps-mule-font-spec-name font-spec)) 576 (font-name (if (consp font-name) (car font-name) font-name)) 577 (font-cache (assoc font-name ps-mule-font-cache)) 578 (font-src (ps-mule-font-spec-src font-spec)) 579 (func (nth 4 (assq font-src ps-mule-external-libraries))) 580 (font-size (if header-p (if (eq ps-current-font 0) 581 ps-header-title-font-size-internal 582 ps-header-font-size-internal) 583 ps-font-size-internal)) 584 (current-font (+ ps-current-font (if header-p 10 0))) 585 (scaled-font-name 586 (cond (header-p 587 (format "h%d" ps-current-font)) 588 ((eq charset 'ascii) 589 (format "f%d" ps-current-font)) 590 (t 591 (format "f%02x-%d" (charset-id charset) ps-current-font))))) 592 (and func (not font-cache) 593 (ps-output-prologue (funcall func charset font-spec))) 594 (ps-output-prologue 595 (list (format "/%s %f /%s Def%sFontMule\n" 596 scaled-font-name font-size font-name 597 (if (or header-p 598 (eq ps-mule-current-charset 'ascii)) 599 "Ascii" "")))) 600 (if font-cache 601 (setcar (cdr font-cache) 602 (cons (cons current-font scaled-font-name) 603 (nth 1 font-cache))) 604 (setq font-cache (list font-name 605 (list (cons current-font scaled-font-name)) 606 'cache) 607 ps-mule-font-cache (cons font-cache ps-mule-font-cache))) 608 font-cache)) 609 610(defun ps-mule-generate-glyphs (font-spec code-list) 611 "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC." 612 (let* ((font-src (ps-mule-font-spec-src font-spec)) 613 (func (nth 5 (assq font-src ps-mule-external-libraries)))) 614 (and func 615 (ps-output-prologue 616 (funcall func font-spec code-list 617 (ps-mule-font-spec-bytes font-spec)))))) 618 619(defun ps-mule-prepare-font (font-spec string charset 620 &optional no-setfont header-p) 621 "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC. 622 623The generated code is inserted on prologue part except the code that sets the 624current font (using PostScript procedure `FM'). 625 626If optional 4th arg NO-SETFONT is non-nil, don't generate the code for setting 627the current font. 628 629If optional 5th arg HEADER-P is non-nil, generate a code for setting a header 630font." 631 (let* ((font-name (ps-mule-font-spec-name font-spec)) 632 (font-name (if (consp font-name) (car font-name) font-name)) 633 (current-font (+ ps-current-font (if header-p 10 0))) 634 (font-cache (assoc font-name ps-mule-font-cache))) 635 (or (and font-cache (assq current-font (nth 1 font-cache))) 636 (setq font-cache (ps-mule-generate-font font-spec charset header-p))) 637 (or no-setfont 638 (let ((new-font (cdr (assq current-font (nth 1 font-cache))))) 639 (or (equal new-font ps-last-font) 640 (progn 641 (ps-output (format "/%s FM\n" new-font)) 642 (setq ps-last-font new-font))))) 643 (if (nth 5 (assq (ps-mule-font-spec-src font-spec) 644 ps-mule-external-libraries)) 645 ;; We have to generate PostScript codes which define glyphs. 646 (let* ((cached-codes (nthcdr 2 font-cache)) 647 (bytes (ps-mule-font-spec-bytes font-spec)) 648 (len (length string)) 649 (i 0) 650 newcodes code) 651 (while (< i len) 652 (setq code (if (= bytes 1) 653 (aref string i) 654 (+ (* (aref string i) 256) (aref string (1+ i))))) 655 (or (memq code cached-codes) 656 (progn 657 (setq newcodes (cons code newcodes)) 658 (setcdr cached-codes (cons code (cdr cached-codes))))) 659 (setq i (+ i bytes))) 660 (and newcodes 661 (ps-mule-generate-glyphs font-spec newcodes)))))) 662 663;;;###autoload 664(defun ps-mule-prepare-ascii-font (string) 665 "Setup special ASCII font for STRING. 666STRING should contain only ASCII characters." 667 (let ((font-spec 668 (ps-mule-get-font-spec 669 'ascii 670 (car (nth ps-current-font (ps-font-alist 'ps-font-for-text)))))) 671 (and font-spec 672 (ps-mule-prepare-font font-spec string 'ascii)))) 673 674;;;###autoload 675(defun ps-mule-set-ascii-font () 676 (unless (eq ps-mule-current-charset 'ascii) 677 (ps-set-font ps-current-font) 678 (setq ps-mule-current-charset 'ascii))) 679 680;; List of charsets of multi-byte characters in a text being printed. 681;; If the text doesn't contain any multi-byte characters (i.e. only ASCII), 682;; the value is nil. 683(defvar ps-mule-charset-list nil) 684 685;; This is a PostScript code inserted in the header of generated PostScript. 686(defconst ps-mule-prologue 687 "%%%% Start of Mule Section 688 689%% Working dictionary for general use. 690/MuleDict 10 dict def 691 692%% Adjust /RelativeCompose properly by checking /BaselineOffset. 693/AdjustRelativeCompose { % fontdict |- fontdict 694 dup length 2 add dict begin 695 { 1 index /FID ne { def } { pop pop } ifelse } forall 696 currentdict /BaselineOffset known { 697 BaselineOffset false eq { /BaselineOffset 0 def } if 698 } { 699 /BaselineOffset 0 def 700 } ifelse 701 currentdict /RelativeCompose known not { 702 /RelativeCompose [ 0 0.1 ] def 703 } { 704 RelativeCompose false ne { 705 [ BaselineOffset RelativeCompose BaselineOffset add 706 [ FontMatrix { FontSize div } forall ] transform ] 707 /RelativeCompose exch def 708 } if 709 } ifelse 710 currentdict 711 end 712} def 713 714%% Define already scaled font for non-ASCII character sets. 715/DefFontMule { % fontname size basefont |- -- 716 findfont exch scalefont AdjustRelativeCompose definefont pop 717} bind def 718 719%% Define already scaled font for ASCII character sets. 720/DefAsciiFontMule { % fontname size basefont |- 721 MuleDict begin 722 findfont dup /Encoding get /ISOLatin1Encoding exch def 723 exch scalefont AdjustRelativeCompose reencodeFontISO 724 end 725} def 726 727/CurrentFont false def 728 729%% Set the specified font to use. 730%% For non-ASCII font, don't install Ascent, etc. 731/FM { % fontname |- -- 732 /font exch def 733 font /f0 eq font /f1 eq font /f2 eq font /f3 eq or or or { 734 font F 735 } { 736 font findfont setfont 737 } ifelse 738} bind def 739 740%% Show vacant box for characters which don't have appropriate font. 741/SB { % count column |- -- 742 SpaceWidth mul /w exch def 743 1 exch 1 exch { %for 744 pop 745 gsave 746 0 setlinewidth 747 0 Descent rmoveto w 0 rlineto 748 0 LineHeight rlineto w neg 0 rlineto closepath stroke 749 grestore 750 w 0 rmoveto 751 } for 752} bind def 753 754%% Flag to tell if we are now handling a composition. This is 755%% defined here because both composition handler and bitmap font 756%% handler require it. 757/Composing false def 758 759%%%% End of Mule Section 760 761" 762 "PostScript code for printing multi-byte characters.") 763 764(defvar ps-mule-prologue-generated nil) 765 766(defun ps-mule-prologue-generated () 767 (unless ps-mule-prologue-generated 768 (ps-output-prologue ps-mule-prologue) 769 (setq ps-mule-prologue-generated t))) 770 771(defun ps-mule-find-wrappoint (from to char-width &optional composition) 772 "Find the longest sequence which is printable in the current line. 773 774The search starts at FROM and goes until TO. 775 776Optional 4th arg COMPOSITION, if non-nil, is information of 777composition starting at FROM. 778 779If COMPOSITION is nil, it is assumed that all characters between FROM 780and TO belong to a charset in `ps-mule-current-charset'. Otherwise, 781it is assumed that all characters between FROM and TO belong to the 782same composition. 783 784CHAR-WIDTH is the average width of ASCII characters in the current font. 785 786Returns the value: 787 788 (ENDPOS . RUN-WIDTH) 789 790Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of 791the sequence." 792 (if (or composition (eq ps-mule-current-charset 'composition)) 793 ;; We must draw one char by one. 794 (let ((run-width (if composition 795 (nth 5 composition) 796 (* (char-width (char-after from)) char-width)))) 797 (if (> run-width ps-width-remaining) 798 (cons from ps-width-remaining) 799 (cons (if composition 800 (nth 1 composition) 801 (1+ from)) 802 run-width))) 803 ;; We assume that all characters in this range have the same width. 804 (setq char-width (* char-width (charset-width ps-mule-current-charset))) 805 (let ((run-width (* (abs (- from to)) char-width))) 806 (if (> run-width ps-width-remaining) 807 (cons (min to 808 (save-excursion 809 (goto-char from) 810 (forward-point 811 (truncate (/ ps-width-remaining char-width))))) 812 ps-width-remaining) 813 (cons to run-width))))) 814 815;;;###autoload 816(defun ps-mule-plot-string (from to &optional bg-color) 817 "Generate PostScript code for plotting characters in the region FROM and TO. 818 819It is assumed that all characters in this region belong to the same charset. 820 821Optional argument BG-COLOR specifies background color. 822 823Returns the value: 824 825 (ENDPOS . RUN-WIDTH) 826 827Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of 828the sequence." 829 (let ((ch (char-after from))) 830 (setq ps-mule-current-charset 831 (char-charset (or (aref ps-print-translation-table ch) ch)))) 832 (let* ((wrappoint (ps-mule-find-wrappoint 833 from to (ps-avg-char-width 'ps-font-for-text))) 834 (to (car wrappoint)) 835 (font-type (car (nth ps-current-font 836 (ps-font-alist 'ps-font-for-text)))) 837 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) 838 (string (buffer-substring-no-properties from to))) 839 (dotimes (i (length string)) 840 (let ((ch (aref ps-print-translation-table (aref string i)))) 841 (if ch 842 (aset string i ch)))) 843 (cond 844 ((= from to) 845 ;; We can't print any more characters in the current line. 846 nil) 847 848 (font-spec 849 ;; We surely have a font for printing this character set. 850 (ps-output-string (ps-mule-string-encoding font-spec string)) 851 (ps-output " S\n")) 852 853 ((eq ps-mule-current-charset 'latin-iso8859-1) 854 ;; Latin-1 can be printed by a normal ASCII font. 855 (ps-output-string (ps-mule-string-ascii string)) 856 (ps-output " S\n")) 857 858 ;; This case is obsolete for Emacs 21. 859 ((eq ps-mule-current-charset 'composition) 860 (ps-mule-plot-composition from (1+ from) bg-color)) 861 862 (t 863 ;; No way to print this charset. Just show a vacant box of an 864 ;; appropriate width. 865 (ps-output (format "%d %d SB\n" 866 (length string) 867 (if (eq ps-mule-current-charset 'composition) 868 (char-width (char-after from)) 869 (charset-width ps-mule-current-charset)))))) 870 wrappoint)) 871 872;;;###autoload 873(defun ps-mule-plot-composition (from to &optional bg-color) 874 "Generate PostScript code for plotting composition in the region FROM and TO. 875 876It is assumed that all characters in this region belong to the same 877composition. 878 879Optional argument BG-COLOR specifies background color. 880 881Returns the value: 882 883 (ENDPOS . RUN-WIDTH) 884 885Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of 886the sequence." 887 (let* ((composition (find-composition from nil nil t)) 888 (wrappoint (ps-mule-find-wrappoint 889 from to (ps-avg-char-width 'ps-font-for-text) 890 composition)) 891 (to (car wrappoint)) 892 (font-type (car (nth ps-current-font 893 (ps-font-alist 'ps-font-for-text))))) 894 (if (< from to) 895 ;; We can print this composition in the current line. 896 (let ((components (nth 2 composition))) 897 (ps-mule-plot-components 898 (ps-mule-prepare-font-for-components components font-type) 899 (if (nth 3 composition) "RLC" "RBC")))) 900 wrappoint)) 901 902;; Prepare font of FONT-TYPE for printing COMPONENTS. By side effect, 903;; change character elements in COMPONENTS to the form: 904;; ENCODED-STRING or (FONTNAME . ENCODED-STRING) 905;; and change rule elements to the encoded value (integer). 906;; The latter form is used if we much change font for the character. 907 908(defun ps-mule-prepare-font-for-components (components font-type) 909 (let ((len (length components)) 910 (i 0) 911 elt) 912 (while (< i len) 913 (setq elt (aref components i)) 914 (if (consp elt) 915 ;; ELT is a composition rule. 916 (setq elt (encode-composition-rule elt)) 917 ;; ELT is a glyph character. 918 (let* ((charset (char-charset elt)) 919 (font (or (eq charset ps-mule-current-charset) 920 (if (eq charset 'ascii) 921 (format "/f%d" ps-current-font) 922 (format "/f%02x-%d" 923 (charset-id charset) ps-current-font)))) 924 str) 925 (setq ps-mule-current-charset charset 926 str (ps-mule-string-encoding 927 (ps-mule-get-font-spec charset font-type) 928 (char-to-string elt) 929 'no-setfont)) 930 (if (stringp font) 931 (setq elt (cons font str) ps-last-font font) 932 (setq elt str)))) 933 (aset components i elt) 934 (setq i (1+ i)))) 935 components) 936 937(defun ps-mule-plot-components (components tail) 938 (let ((elt (aref components 0)) 939 (len (length components)) 940 (i 1)) 941 (ps-output "[ ") 942 (if (stringp elt) 943 (ps-output-string elt) 944 (ps-output (car elt) " ") 945 (ps-output-string (cdr elt))) 946 (while (< i len) 947 (setq elt (aref components i) i (1+ i)) 948 (ps-output " ") 949 (cond ((stringp elt) 950 (ps-output-string elt)) 951 ((consp elt) 952 (ps-output (car elt) " ") 953 (ps-output-string (cdr elt))) 954 (t ; i.e. (integerp elt) 955 (ps-output (format "%d" elt))))) 956 (ps-output " ] " tail "\n"))) 957 958;; Composite font support 959 960(defvar ps-mule-composition-prologue-generated nil) 961 962(defconst ps-mule-composition-prologue 963 "%%%% Character composition handler 964/RelativeCompositionSkip 0.4 def 965 966%% Get a bounding box (relative to currentpoint) of STR. 967/GetPathBox { % str |- -- 968 gsave 969 currentfont /FontType get 3 eq { %ifelse 970 stringwidth pop pop 971 } { 972 currentpoint /y exch def /x exch def 973 false charpath flattenpath pathbbox 974 y sub /URY exch def x sub /URX exch def 975 y sub /LLY exch def x sub /LLX exch def 976 } ifelse 977 grestore 978} bind def 979 980%% Apply effects (underline, strikeout, overline, box) to the 981%% rectangle specified by TOP BOTTOM LEFT RIGHT. 982/SpecialEffect { % -- |- -- 983 currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def 984 dup LEFT add /xx exch def RIGHT add /XX exch def 985 %% Adjust positions for future shadowing. 986 Effect 8 and 0 ne { 987 /yy yy Yshadow add def 988 /XX XX Xshadow add def 989 } if 990 Effect 1 and 0 ne { UnderlinePosition Hline } if % underline 991 Effect 2 and 0 ne { StrikeoutPosition Hline } if % strikeout 992 Effect 4 and 0 ne { OverlinePosition Hline } if % overline 993 bg { % background 994 true 995 Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse 996 } if 997 Effect 16 and 0 ne { false 0 doBox } if % box 998} def 999 1000%% Show STR with effects (shadow, outline). 1001/ShowWithEffect { % str |- -- 1002 Effect 8 and 0 ne { dup doShadow } if 1003 Effect 32 and 0 ne { true doOutline } { show } ifelse 1004} def 1005 1006%% Draw COMPONENTS which have the form [ font0? [str0 xoff0 yoff0] ... ]. 1007/ShowComponents { % components |- - 1008 LEFT 0 lt { LEFT neg 0 rmoveto } if 1009 { 1010 dup type /nametype eq { % font 1011 FM 1012 } { % [ str xoff yoff ] 1013 gsave 1014 aload pop rmoveto ShowWithEffect 1015 grestore 1016 } ifelse 1017 } forall 1018 RIGHT 0 rmoveto 1019} def 1020 1021%% Show relative composition. 1022/RLC { % [ font0? str0 font1? str1 ... fontN? strN ] |- -- 1023 /components exch def 1024 /Composing true def 1025 /first true def 1026 gsave 1027 [ components { 1028 /elt exch def 1029 elt type /nametype eq { % font 1030 elt dup FM 1031 } { first { % first string 1032 /first false def 1033 elt GetPathBox 1034 %% Bounding box of overall glyphs. 1035 /LEFT LLX def 1036 /RIGHT URX def 1037 /TOP URY def 1038 /BOTTOM LLY def 1039 currentfont /RelativeCompose known { 1040 /relative currentfont /RelativeCompose get def 1041 relative false eq { 1042 %% Disable relative composition by setting sufficiently low 1043 %% and high positions. 1044 /relative [ -100000 100000 ] def 1045 } if 1046 } { 1047 /relative [ -100000 100000 ] def 1048 } ifelse 1049 [ elt 0 0 ] 1050 } { % other strings 1051 elt GetPathBox 1052 [ elt % str 1053 LLX 0 lt { RIGHT } { 0 } ifelse % xoff 1054 LLY relative 1 get ge { % compose on TOP 1055 TOP LLY sub RelativeCompositionSkip add % yoff 1056 /TOP TOP URY LLY sub add RelativeCompositionSkip add def 1057 } { URY relative 0 get le { % compose under BOTTOM 1058 BOTTOM URY sub RelativeCompositionSkip sub % yoff 1059 /BOTTOM BOTTOM URY LLY sub sub 1060 RelativeCompositionSkip sub def 1061 } { 1062 0 % yoff 1063 URY TOP gt { /TOP URY def } if 1064 LLY BOTTOM lt { /BOTTOM LLY def } if 1065 } ifelse } ifelse 1066 ] 1067 URX RIGHT gt { /RIGHT URX def } if 1068 } ifelse } ifelse 1069 } forall ] /components exch def 1070 grestore 1071 1072 %% Reflect special effects. 1073 SpecialEffect 1074 1075 %% Draw components while ignoring effects other than shadow and outline. 1076 components ShowComponents 1077 /Composing false def 1078 1079} def 1080 1081%% Show rule-base composition. 1082/RBC { % [ font0? str0 rule1 font1? str1 rule2 ... strN ] |- -- 1083 /components exch def 1084 /Composing true def 1085 /first true def 1086 gsave 1087 [ components { 1088 /elt exch def 1089 elt type /nametype eq { % font 1090 elt dup FM 1091 } { elt type /integertype eq { % rule 1092 %% This RULE decoding should be compatible with macro 1093 %% COMPOSITION_DECODE_RULE in emacs/src/composite.h. 1094 elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def 1095 elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def 1096 } { first { % first string 1097 /first false def 1098 elt GetPathBox 1099 %% Bounding box of overall glyphs. 1100 /LEFT LLX def 1101 /RIGHT URX def 1102 /TOP URY def 1103 /BOTTOM LLY def 1104 /WIDTH RIGHT LEFT sub def 1105 [ elt 0 0 ] 1106 } { % other strings 1107 elt GetPathBox 1108 /width URX LLX sub def 1109 /height URY LLY sub def 1110 /left LEFT [ 0 WIDTH 2 div WIDTH ] grefx get add 1111 [ 0 width 2 div width ] nrefx get sub def 1112 /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get 1113 [ height LLY neg 0 height 2 div ] nrefy get sub def 1114 %% Update bounding box 1115 left LEFT lt { /LEFT left def } if 1116 left width add RIGHT gt { /RIGHT left width add def } if 1117 /WIDTH RIGHT LEFT sub def 1118 bottom BOTTOM lt { /BOTTOM bottom def } if 1119 bottom height add TOP gt { /TOP bottom height add def } if 1120 [ elt left LLX sub bottom LLY sub ] 1121 } ifelse } ifelse } ifelse 1122 } forall ] /components exch def 1123 grestore 1124 1125 %% Reflect special effects. 1126 SpecialEffect 1127 1128 %% Draw components while ignoring effects other than shadow and outline. 1129 components ShowComponents 1130 1131 /Composing false def 1132} def 1133%%%% End of character composition handler 1134 1135" 1136 "PostScript code for printing character composition.") 1137 1138(defun ps-mule-string-ascii (str) 1139 (ps-set-font ps-current-font) 1140 (string-as-unibyte (encode-coding-string str 'iso-latin-1))) 1141 1142;; Encode STR for a font specified by FONT-SPEC and return the result. 1143;; If necessary, it generates the PostScript code for the font and glyphs to 1144;; print STR. If optional 4th arg HEADER-P is non-nil, it is assumed that STR 1145;; is for headers. 1146(defun ps-mule-string-encoding (font-spec str &optional no-setfont header-p) 1147 (let ((encoding (ps-mule-font-spec-encoding font-spec))) 1148 (setq str 1149 (string-as-unibyte 1150 (cond ((coding-system-p encoding) 1151 (encode-coding-string str encoding)) 1152 ((functionp encoding) 1153 (funcall encoding str)) 1154 (encoding 1155 (error "Invalid coding system or function: %s" encoding)) 1156 (t 1157 str)))) 1158 (if (ps-mule-font-spec-src font-spec) 1159 (ps-mule-prepare-font font-spec str ps-mule-current-charset 1160 (or no-setfont header-p) 1161 header-p) 1162 (or no-setfont 1163 (ps-set-font ps-current-font))) 1164 str)) 1165 1166;; Bitmap font support 1167 1168(defvar ps-mule-bitmap-prologue-generated nil) 1169 1170(defconst ps-mule-bitmap-prologue 1171 "%%%% Bitmap font handler 1172 1173/str7 7 string def % working area 1174 1175%% We grow the dictionary one bunch (1024 entries) by one. 1176/BitmapDictArray 256 array def 1177/BitmapDictLength 1024 def 1178/BitmapDictIndex -1 def 1179 1180/NewBitmapDict { % -- |- -- 1181 /BitmapDictIndex BitmapDictIndex 1 add def 1182 BitmapDictArray BitmapDictIndex BitmapDictLength dict put 1183} bind def 1184 1185%% Make at least one dictionary. 1186NewBitmapDict 1187 1188/AddBitmap { % gloval-charname bitmap-data |- -- 1189 BitmapDictArray BitmapDictIndex get 1190 dup length BitmapDictLength ge { 1191 pop 1192 NewBitmapDict 1193 BitmapDictArray BitmapDictIndex get 1194 } if 1195 3 1 roll put 1196} bind def 1197 1198/GetBitmap { % gloval-charname |- bitmap-data 1199 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for 1200 load 1201 0 1 BitmapDictIndex { pop end } for 1202} bind def 1203 1204%% Return a global character name which can be used as a key in the 1205%% bitmap dictionary. 1206/GlobalCharName { % fontidx code1 code2 |- gloval-charname 1207 exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put 1208 str7 cvn 1209} bind def 1210 1211%% Character code holder for a 2-byte character. 1212/FirstCode -1 def 1213 1214%% Glyph rendering procedure 1215/BuildGlyphCommon { % fontdict charname |- -- 1216 1 index /FontDimension get 1 eq { /FirstCode 0 store } if 1217 NameIndexDict exch get % STACK: fontdict charcode 1218 FirstCode 0 lt { %ifelse 1219 %% This is the first byte of a 2-byte character. Just 1220 %% remember it for the moment. 1221 /FirstCode exch store 1222 pop 1223 0 0 setcharwidth 1224 } { 1225 1 index /FontSize get /size exch def 1226 1 index /FontSpaceWidthRatio get /ratio exch def 1227 1 index /FontIndex get exch FirstCode exch 1228 GlobalCharName GetBitmap /bmp exch def 1229 %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ] 1230 Composing { %ifelse 1231 /FontMatrix get [ exch { size div } forall ] /mtrx exch def 1232 bmp 3 get bmp 4 get mtrx transform 1233 /LLY exch def /LLX exch def 1234 bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform 1235 /URY exch def /URX exch def 1236 } { 1237 pop 1238 } ifelse 1239 /FirstCode -1 store 1240 1241 bmp 0 get size div 0 % wx wy 1242 setcharwidth % We can't use setcachedevice here. 1243 1244 bmp 1 get 0 gt bmp 2 get 0 gt and { 1245 bmp 1 get bmp 2 get % width height 1246 true % polarity 1247 [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix 1248 bmp 5 1 getinterval cvx % datasrc 1249 imagemask 1250 } if 1251 } ifelse 1252} bind def 1253 1254/BuildCharCommon { 1255 1 index /Encoding get exch get 1256 1 index /BuildGlyph get exec 1257} bind def 1258 1259%% Bitmap font creator 1260 1261%% Common Encoding shared by all bitmap fonts. 1262/EncodingCommon 256 array def 1263%% Mapping table from character name to character code. 1264/NameIndexDict 256 dict def 12650 1 255 { %for 1266 /idx exch def 1267 /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67 1268 EncodingCommon idx idxname put 1269 NameIndexDict idxname idx put 1270} for 1271 1272/GlobalFontIndex 0 def 1273 1274%% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- 1275/BitmapFont { 1276 15 dict begin 1277 /FontBBox exch def 1278 /BaselineOffset exch def 1279 /RelativeCompose exch def 1280 /FontSize exch def 1281 /FontBBox [ FontBBox { FontSize div } forall ] def 1282 FontBBox 2 get FontBBox 0 get sub exch div 1283 /FontSpaceWidthRatio exch def 1284 /FontDimension exch def 1285 /FontIndex GlobalFontIndex def 1286 /FontType 3 def 1287 /FontMatrix matrix def 1288 /Encoding EncodingCommon def 1289 /BuildGlyph { BuildGlyphCommon } def 1290 /BuildChar { BuildCharCommon } def 1291 currentdict end 1292 definefont pop 1293 /GlobalFontIndex GlobalFontIndex 1 add def 1294} bind def 1295 1296%% Define a new bitmap font. 1297%% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- 1298/NF { 1299 /fbbx exch def 1300 %% Convert BDF's FontBoundingBox to PostScript's FontBBox 1301 [ fbbx 2 get fbbx 3 get 1302 fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ] 1303 BitmapFont 1304} bind def 1305 1306%% Define a glyph for the specified font and character. 1307/NG { % fontname charcode bitmap-data |- -- 1308 /bmp exch def 1309 exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put 1310 /FontIndex get exch 1311 dup 256 idiv exch 256 mod GlobalCharName 1312 bmp AddBitmap 1313} bind def 1314%%%% End of bitmap font handler 1315 1316") 1317 1318;; External library support. 1319 1320;; The following three functions are to be called from external 1321;; libraries which support bitmap fonts (e.g. `bdf') to get 1322;; appropriate PostScript code. 1323 1324(defun ps-mule-generate-bitmap-prologue () 1325 (unless ps-mule-bitmap-prologue-generated 1326 (setq ps-mule-bitmap-prologue-generated t) 1327 (list ps-mule-bitmap-prologue))) 1328 1329(defun ps-mule-generate-bitmap-font (&rest args) 1330 (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args))) 1331 1332(defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap) 1333 (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n" 1334 font-name code 1335 dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3) 1336 bitmap)) 1337 1338;; Mule specific initializers. 1339 1340;;;###autoload 1341(defun ps-mule-initialize () 1342 "Initialize global data for printing multi-byte characters." 1343 (setq ps-mule-font-cache nil 1344 ps-mule-prologue-generated nil 1345 ps-mule-composition-prologue-generated nil 1346 ps-mule-bitmap-prologue-generated nil) 1347 (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil)) 1348 ps-mule-external-libraries)) 1349 1350(defvar ps-mule-header-charsets nil) 1351 1352;;;###autoload 1353(defun ps-mule-encode-header-string (string fonttag) 1354 "Generate PostScript code for ploting STRING by font FONTTAG. 1355FONTTAG should be a string \"/h0\" or \"/h1\"." 1356 (setq string (cond ((not (stringp string)) 1357 "") 1358 ((multibyte-string-p string) 1359 (copy-sequence string)) 1360 (t 1361 (string-make-multibyte string)))) 1362 (when ps-mule-header-charsets 1363 (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1) 1364 ;; Latin1 characters can be printed by the standard PostScript 1365 ;; font. Converts the other non-ASCII characters to `?'. 1366 (let ((len (length string)) 1367 (i 0)) 1368 (while (< i len) 1369 (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1)) 1370 (aset string i ??)) 1371 (setq i (1+ i))) 1372 (setq string (encode-coding-string string 'iso-latin-1))) 1373 ;; We must prepare a font for the first non-ASCII and non-Latin1 1374 ;; character in STRING. 1375 (let* ((ps-current-font (if (string= fonttag "/h0") 0 1)) 1376 (ps-mule-current-charset (car ps-mule-header-charsets)) 1377 (font-type (car (nth ps-current-font 1378 (ps-font-alist 'ps-font-for-header)))) 1379 (font-spec (ps-mule-get-font-spec ps-mule-current-charset 1380 font-type))) 1381 (if (or (not font-spec) 1382 (/= (charset-dimension ps-mule-current-charset) 1)) 1383 ;; We don't have a proper font, or we can't print them on 1384 ;; header because this kind of charset is not ASCII 1385 ;; compatible. 1386 (let ((len (length string)) 1387 (i 0)) 1388 (while (< i len) 1389 (or (memq (char-charset (aref string i)) 1390 '(ascii latin-iso8859-1)) 1391 (aset string i ??)) 1392 (setq i (1+ i))) 1393 (setq string (encode-coding-string string 'iso-latin-1))) 1394 (let ((charsets (list 'ascii (car ps-mule-header-charsets))) 1395 (len (length string)) 1396 (i 0)) 1397 (while (< i len) 1398 (or (memq (char-charset (aref string i)) charsets) 1399 (aset string i ??)) 1400 (setq i (1+ i)))) 1401 (setq string (ps-mule-string-encoding font-spec string nil t)))))) 1402 string) 1403 1404(defun ps-mule-show-warning (charsets from to header-footer-list) 1405 (let ((table (make-category-table)) 1406 (buf (current-buffer)) 1407 (max-unprintable-chars 15) 1408 char-pos-list) 1409 (define-category ?u "Unprintable charset" table) 1410 (dolist (cs charsets) 1411 (modify-category-entry (make-char cs) ?u table)) 1412 (with-category-table table 1413 (save-excursion 1414 (goto-char from) 1415 (while (and (<= (length char-pos-list) max-unprintable-chars) 1416 (re-search-forward "\\cu" to t)) 1417 (or (aref ps-print-translation-table (preceding-char)) 1418 (push (cons (preceding-char) (1- (point))) char-pos-list))))) 1419 (with-output-to-temp-buffer "*Warning*" 1420 (with-current-buffer standard-output 1421 (when char-pos-list 1422 (let ((func #'(lambda (buf pos) 1423 (when (buffer-live-p buf) 1424 (pop-to-buffer buf) 1425 (goto-char pos)))) 1426 (more nil)) 1427 (if (>= (length char-pos-list) max-unprintable-chars) 1428 (setq char-pos-list (cdr char-pos-list) 1429 more t)) 1430 (insert "These characters in the buffer can't be printed:\n") 1431 (dolist (elt (nreverse char-pos-list)) 1432 (insert " ") 1433 (insert-text-button (string (car elt)) 1434 :type 'help-xref 1435 'help-echo 1436 "mouse-2, RET: jump to this character" 1437 'help-function func 1438 'help-args (list buf (cdr elt))) 1439 (insert ",")) 1440 (if more 1441 (insert " and more...") 1442 ;; Delete the last comma. 1443 (delete-char -1)) 1444 (insert "\nClick them to jump to the buffer position,\n" 1445 (substitute-command-keys "\ 1446or \\[universal-argument] \\[what-cursor-position] will give information about them.\n")))) 1447 1448 (with-category-table table 1449 (let (string-list idx) 1450 (dolist (elt header-footer-list) 1451 (when (stringp elt) 1452 (when (string-match "\\cu+" elt) 1453 (setq elt (copy-sequence elt)) 1454 (put-text-property (match-beginning 0) (match-end 0) 1455 'face 'highlight elt) 1456 (while (string-match "\\cu+" elt (match-end 0)) 1457 (put-text-property (match-beginning 0) (match-end 0) 1458 'face 'highlight elt)) 1459 (push elt string-list)))) 1460 (when string-list 1461 (insert 1462 "These highlighted characters in header/footer can't be printed:\n") 1463 (dolist (elt string-list) 1464 (insert " " elt "\n"))))))))) 1465 1466;;;###autoload 1467(defun ps-mule-begin-job (from to) 1468 "Start printing job for multi-byte chars between FROM and TO. 1469This checks if all multi-byte characters in the region are printable or not." 1470 (setq ps-mule-charset-list nil 1471 ps-mule-header-charsets nil 1472 ps-mule-font-info-database 1473 (cond ((eq ps-multibyte-buffer 'non-latin-printer) 1474 ps-mule-font-info-database-ps) 1475 ((eq ps-multibyte-buffer 'bdf-font) 1476 ps-mule-font-info-database-bdf) 1477 ((eq ps-multibyte-buffer 'bdf-font-except-latin) 1478 ps-mule-font-info-database-ps-bdf) 1479 (t 1480 ps-mule-font-info-database-default))) 1481 (and (boundp 'enable-multibyte-characters) 1482 enable-multibyte-characters 1483 ;; Initialize `ps-mule-charset-list'. If some characters aren't 1484 ;; printable, warn it. 1485 (let ((header-footer-list (ps-header-footer-string)) 1486 unprintable-charsets) 1487 (setq ps-mule-charset-list 1488 (delq 'ascii (delq 'eight-bit-control 1489 (delq 'eight-bit-graphic 1490 (find-charset-region 1491 from to ps-print-translation-table)))) 1492 ps-mule-header-charsets 1493 (delq 'ascii (delq 'eight-bit-control 1494 (delq 'eight-bit-graphic 1495 (find-charset-string 1496 (mapconcat 1497 'identity header-footer-list "") 1498 ps-print-translation-table))))) 1499 (dolist (cs ps-mule-charset-list) 1500 (or (ps-mule-printable-p cs) 1501 (push cs unprintable-charsets))) 1502 (dolist (cs ps-mule-header-charsets) 1503 (or (ps-mule-printable-p cs) 1504 (memq cs unprintable-charsets) 1505 (push cs unprintable-charsets))) 1506 (when unprintable-charsets 1507 (ps-mule-show-warning unprintable-charsets from to 1508 header-footer-list) 1509 (or 1510 (y-or-n-p "Font for some characters not found, continue anyway? ") 1511 (error "Printing cancelled"))) 1512 1513 (or ps-mule-composition-prologue-generated 1514 (let ((use-composition (nth 2 (find-composition from to)))) 1515 (or use-composition 1516 (let (str) 1517 (while header-footer-list 1518 (setq str (car header-footer-list)) 1519 (if (and (stringp str) 1520 (nth 2 (find-composition 0 (length str) str))) 1521 (setq use-composition t 1522 header-footer-list nil) 1523 (setq header-footer-list (cdr header-footer-list)))))) 1524 (when use-composition 1525 (progn 1526 (ps-mule-prologue-generated) 1527 (ps-output-prologue ps-mule-composition-prologue) 1528 (setq ps-mule-composition-prologue-generated t))))))) 1529 1530 (setq ps-mule-current-charset 'ascii) 1531 1532 (if (or ps-mule-charset-list ps-mule-header-charsets) 1533 (dolist (elt (append ps-mule-header-charsets ps-mule-charset-list)) 1534 (ps-mule-prologue-generated) 1535 (ps-mule-init-external-library (ps-mule-get-font-spec elt 'normal)))) 1536 1537 ;; If ASCII font is also specified in ps-mule-font-info-database, 1538 ;; use it instead of what specified in ps-font-info-database. 1539 (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal))) 1540 (if font-spec 1541 (progn 1542 (ps-mule-prologue-generated) 1543 (ps-mule-init-external-library font-spec) 1544 (let ((font (ps-font-alist 'ps-font-for-text)) 1545 (ps-current-font 0)) 1546 (while font 1547 ;; Be sure to download a glyph for SPACE in advance. 1548 (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii (car font)) 1549 " " 'ascii 'no-setfont) 1550 (setq font (cdr font) 1551 ps-current-font (1+ ps-current-font))))))) 1552 1553 ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font 1554 ;; and glyphs for the first occurrence of such characters. 1555 (if (and ps-mule-header-charsets 1556 (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1)) 1557 (= (charset-dimension (car ps-mule-header-charsets)) 1)) 1558 (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets) 1559 'normal))) 1560 (if font-spec 1561 ;; Be sure to download glyphs for "0123456789/" in advance for page 1562 ;; numbering. 1563 (let ((ps-current-font 0)) 1564 (ps-mule-prepare-font font-spec "0123456789/" 'ascii t t))))) 1565 1566 (if ps-mule-charset-list 1567 ;; We must change this regexp for multi-byte buffer. 1568 (setq ps-control-or-escape-regexp 1569 (cond ((eq ps-print-control-characters '8-bit) 1570 "[^\040-\176]") 1571 ((eq ps-print-control-characters 'control-8-bit) 1572 (string-as-multibyte "[^\040-\176\240-\377]")) 1573 ((eq ps-print-control-characters 'control) 1574 (string-as-multibyte "[^\040-\176\200-\377]")) 1575 (t (string-as-multibyte "[^\000-\011\013\015-\377]")))))) 1576 1577;;;###autoload 1578(defun ps-mule-begin-page () 1579 (setq ps-mule-current-charset 'ascii)) 1580 1581 1582(provide 'ps-mule) 1583 1584;;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe 1585;;; ps-mule.el ends here 1586