- (setq ps-mule-charset-list nil
- ps-mule-header-charsets nil
- ps-mule-font-info-database
- (cond ((eq ps-multibyte-buffer 'non-latin-printer)
- ps-mule-font-info-database-ps)
- ((eq ps-multibyte-buffer 'bdf-font)
- ps-mule-font-info-database-bdf)
- ((eq ps-multibyte-buffer 'bdf-font-except-latin)
- ps-mule-font-info-database-ps-bdf)
- (t
- ps-mule-font-info-database-default)))
- (and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters
- ;; Initialize `ps-mule-charset-list'. If some characters aren't
- ;; printable, warn it.
- (let ((header-footer-list (ps-header-footer-string))
- unprintable-charsets)
- (setq ps-mule-charset-list
- (delq 'ascii (delq 'eight-bit-control
- (delq 'eight-bit-graphic
- (find-charset-region
- from to ps-print-translation-table))))
- ps-mule-header-charsets
- (delq 'ascii (delq 'eight-bit-control
- (delq 'eight-bit-graphic
- (find-charset-string
- (mapconcat
- 'identity header-footer-list "")
- ps-print-translation-table)))))
- (dolist (cs ps-mule-charset-list)
- (or (ps-mule-printable-p cs)
- (push cs unprintable-charsets)))
- (dolist (cs ps-mule-header-charsets)
- (or (ps-mule-printable-p cs)
- (memq cs unprintable-charsets)
- (push cs unprintable-charsets)))
- (when unprintable-charsets
- (ps-mule-show-warning unprintable-charsets from to
- header-footer-list)
- (or
- (y-or-n-p "Font for some characters not found, continue anyway? ")
- (error "Printing cancelled")))
-
- (or ps-mule-composition-prologue-generated
- (let ((use-composition (nth 2 (find-composition from to))))
- (or use-composition
- (let (str)
- (while header-footer-list
- (setq str (car header-footer-list))
- (if (and (stringp str)
- (nth 2 (find-composition 0 (length str) str)))
- (setq use-composition t
- header-footer-list nil)
- (setq header-footer-list (cdr header-footer-list))))))
- (when use-composition
- (progn
- (ps-mule-prologue-generated)
- (ps-output-prologue ps-mule-composition-prologue)
- (setq ps-mule-composition-prologue-generated t)))))))
-
- (setq ps-mule-current-charset 'ascii)
-
- (if (or ps-mule-charset-list ps-mule-header-charsets)
- (dolist (elt (append ps-mule-header-charsets ps-mule-charset-list))
- (ps-mule-prologue-generated)
- (ps-mule-init-external-library (ps-mule-get-font-spec elt 'normal))))
-
- ;; If ASCII font is also specified in ps-mule-font-info-database,
- ;; use it instead of what specified in ps-font-info-database.
- (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
- (if font-spec
- (progn
- (ps-mule-prologue-generated)
- (ps-mule-init-external-library font-spec)
- (let ((ps-current-font 0))
- (dolist (font (ps-font-alist 'ps-font-for-text))
- ;; Be sure to download a glyph for SPACE in advance.
- (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii font)
- " " 'ascii 'no-setfont)
- (setq ps-current-font (1+ ps-current-font)))))))
-
- ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font
- ;; and glyphs for the first occurrence of such characters.
- (if (and ps-mule-header-charsets
- (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1))
- (= (charset-dimension (car ps-mule-header-charsets)) 1))
- (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets)
- 'normal)))
- (if font-spec
- ;; Be sure to download glyphs for "0123456789/" in advance for page
- ;; numbering.
- (let ((ps-current-font 0))
- (ps-mule-prepare-font font-spec "0123456789/" 'ascii t t)))))
-
- (if ps-mule-charset-list
- ;; We must change this regexp for multi-byte buffer.
- (setq ps-control-or-escape-regexp
- (cond ((eq ps-print-control-characters '8-bit)
- "[^\040-\176]")
- ((eq ps-print-control-characters 'control-8-bit)
- (string-as-multibyte "[^\040-\176\240-\377]"))
- ((eq ps-print-control-characters 'control)
- (string-as-multibyte "[^\040-\176\200-\377]"))
- (t (string-as-multibyte "[^\000-\011\013\015-\377]"))))))
+ (auto-compose-region from to)
+ (if (and (not (find-composition from to))
+ (save-excursion
+ (goto-char from)
+ (= (skip-chars-forward "\x00-\xFF" to) to)))
+ ;; All characters can be printed by normal PostScript fonts.
+ (setq ps-basic-plot-string-function 'ps-basic-plot-string
+ ps-encode-header-string-function 'identity)
+ (setq ps-basic-plot-string-function 'ps-mule-plot-string
+ ps-encode-header-string-function 'ps-mule-encode-header-string
+ ps-mule-font-info-database
+ (cond ((eq ps-multibyte-buffer 'non-latin-printer)
+ ps-mule-font-info-database-ps)
+ ((eq ps-multibyte-buffer 'bdf-font)
+ ps-mule-font-info-database-bdf)
+ ((eq ps-multibyte-buffer 'bdf-font-except-latin)
+ ps-mule-font-info-database-ps-bdf)
+ (t
+ ps-mule-font-info-database-default)))
+
+ ;; Be sure to have font information for Latin-1.
+ (or (assq 'iso-8859-1 ps-mule-font-info-database)
+ (setq ps-mule-font-info-database
+ (cons '(iso-8859-1 (normal nil nil))
+ ps-mule-font-info-database)))
+
+ ;; Generate ps-mule-font-spec-tables.
+ (let ((font-spec-alist (make-vector 4 nil))
+ (id-max 0)
+ (font-id 0)
+ font-info-list)
+ ;; Generate properly ordered font-info-list from
+ ;; ps-mule-font-info-database.
+ (let ((charset-list
+ (copy-sequence (get-language-info current-language-environment
+ 'charset))))
+ (setq charset-list (cons 'iso-8859-1 (delq 'iso-8859-1 charset-list)))
+ (dolist (charset charset-list)
+ (let ((font-info (assq charset ps-mule-font-info-database)))
+ (and font-info
+ (setq font-info-list (cons font-info font-info-list)))))
+ (dolist (font-info ps-mule-font-info-database)
+ (or (memq (car font-info) charset-list)
+ (setq font-info-list (cons font-info font-info-list))))
+ (setq font-info-list (nreverse font-info-list)))
+
+ ;; Store FONT-SPECs in each element of font-spec-alist.
+ (dolist (font-info font-info-list)
+ (let ((font-spec-vec (make-vector 4 nil))
+ (charset (car font-info))
+ encoding font-spec)
+ (dolist (e (cdr font-info))
+ (setq encoding (or (nth 3 e) charset)
+ font-spec (vector id-max charset font-id
+ (nth 1 e) (nth 2 e) encoding
+ (or (nth 4 e) (charset-dimension encoding))
+ nil)
+ id-max (1+ id-max))
+ (if (ps-mule-check-font font-spec)
+ (aset font-spec-vec
+ (cond ((eq (car e) 'normal) 0)
+ ((eq (car e) 'bold) 1)
+ ((eq (car e) 'italic) 2)
+ (t 3)) font-spec)))
+ (when (aref font-spec-vec 0)
+ (or (aref font-spec-vec 3)
+ (aset font-spec-vec 3 (or (aref font-spec-vec 1)
+ (aref font-spec-vec 2)
+ (aref font-spec-vec 0))))
+ (or (aref font-spec-vec 1)
+ (aset font-spec-vec 1 (aref font-spec-vec 0)))
+ (or (aref font-spec-vec 2)
+ (aset font-spec-vec 2 (aref font-spec-vec 1)))
+ (dotimes (i 4)
+ (aset font-spec-alist i
+ (nconc (aref font-spec-alist i)
+ (list (cons charset (aref font-spec-vec i))))))
+ (setq font-id (1+ font-id)))))
+
+ ;; Make four FONT-SPEC-TABLEs and set them in
+ ;; ps-mule-font-spec-tables. Each char table has one extra slot
+ ;; whose value is an element of font-spec-alist.
+ (setq ps-mule-font-spec-tables (make-vector 4 nil))
+ (put 'font-spec-table 'char-table-extra-slots 1)
+ (dotimes (i 4)
+ (let ((table (make-char-table 'font-spec-table)))
+ (aset ps-mule-font-spec-tables i table)
+ (set-char-table-extra-slot table 0 (aref font-spec-alist i))
+ ;; Be sure to have glyphs for "0123456789/" in advance for
+ ;; page numbering.
+ (let ((str " 0123456789/"))
+ (dotimes (i (length str))
+ (or (vectorp (ps-mule-get-font-spec (aref str i) table nil))
+ (error "ASCII font not available")))))))
+
+ (ps-mule-prologue-generated)
+ (if (find-composition from to)
+ (ps-mule-composition-prologue-generated))))
+
+(defun ps-mule-restruct-output-list (list tail)
+ (dolist (elt list)
+ (if (listp elt)
+ (setq tail (ps-mule-restruct-output-list elt tail))
+ (setcdr tail (cons elt (cdr tail)))
+ (setq tail (cdr tail))))
+ tail)
+
+(defun ps-mule-redefine-font (font-number fonttag size ps-font)
+ (let* ((font-type (aref ps-mule-font-number-to-type font-number))
+ (font-spec-alist (char-table-extra-slot
+ (aref ps-mule-font-spec-tables font-type) 0)))
+ (ps-output-prologue
+ (list (if (ps-mule-font-spec-src (cdr (car font-spec-alist)))
+ ;; We ignore a font specfied in ps-font-info-database.
+ (format "/V%s VTOP%d def\n" fonttag font-type)
+ (format "/V%s [ VTOP%d aload pop ] def\n
+V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
+ fonttag font-type fonttag ps-font ps-font))
+ (format "/%s ETOP%d V%s %f ReDefFont\n"
+ fonttag font-type fonttag size)))))