-;;; ps-mule.el --- Provide multi-byte character facility to ps-print.
+;;; ps-mule.el --- provide multi-byte character facility to ps-print
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Keywords: print, PostScript, multibyte, mule
-;; Time-stamp: <99/02/19 13:15:52 vinicius>
+;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;; Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Keywords: wp, print, PostScript, multibyte, mule
+;; Time-stamp: <2003/05/14 22:19:41 vinicius>
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; About ps-mule
;; -------------
;;
;; Valid values for `ps-multibyte-buffer' are:
;;
-;; nil This is the value to use when you are printing
-;; buffer with only ASCII and Latin characters.
+;; nil This is the value to use the default settings which
+;; is by default for printing buffer with only ASCII
+;; and Latin characters. The default setting can be
+;; changed by setting the variable
+;; `ps-mule-font-info-database-default' differently.
+;; The initial value of this variable is
+;; `ps-mule-font-info-database-latin' (see
+;; documentation).
;;
;; `non-latin-printer' This is the value to use when you have a japanese
;; or korean PostScript printer and want to print
;; and non-latin fonts. BDF (Bitmap Distribution
;; Format) is a format used for distributing X's font
;; source file. BDF fonts are included in
-;; `intlfonts-1.1' which is a collection of X11 fonts
+;; `intlfonts-1.2' which is a collection of X11 fonts
;; for all characters supported by Emacs. In order to
;; use this value, be sure to have installed
-;; `intlfonts-1.1' and set the variable
+;; `intlfonts-1.2' and set the variable
;; `bdf-directory-list' appropriately (see ps-bdf.el
;; for documentation of this variable).
;;
;;
;; The default is nil.
;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
-(eval-and-compile (require 'ps-print))
+(eval-and-compile
+ (require 'ps-print)
+
+ ;; to avoid XEmacs compilation gripes
+ (defvar leading-code-private-22 157)
+ (or (fboundp 'charset-bytes)
+ (defun charset-bytes (charset) 1)) ; ascii
+ (or (fboundp 'charset-dimension)
+ (defun charset-dimension (charset) 1)) ; ascii
+ (or (fboundp 'charset-id)
+ (defun charset-id (charset) 0)) ; ascii
+ (or (fboundp 'charset-width)
+ (defun charset-width (charset) 1)) ; ascii
+ (or (fboundp 'find-charset-region)
+ (defun find-charset-region (beg end &optional table)
+ (list 'ascii)))
+ (or (fboundp 'char-valid-p)
+ (defun char-valid-p (char)
+ (< (following-char) 256)))
+ (or (fboundp 'split-char)
+ (defun split-char (char)
+ (list (if (char-valid-p char)
+ 'ascii
+ 'unknow)
+ char)))
+ (or (fboundp 'char-width)
+ (defun char-width (char) 1)) ; ascii
+ (or (fboundp 'chars-in-region)
+ (defun chars-in-region (beg end)
+ (- (max beg end) (min beg end))))
+ (or (fboundp 'forward-point)
+ (defun forward-point (arg)
+ (save-excursion
+ (let ((count (abs arg))
+ (step (if (zerop arg)
+ 0
+ (/ arg arg))))
+ (while (and (> count 0)
+ (< (point-min) (point)) (< (point) (point-max)))
+ (forward-char step)
+ (setq count (1- count)))
+ (+ (point) (* count step))))))
+ (or (fboundp 'decompose-composite-char)
+ (defun decompose-composite-char (char &optional type
+ with-composition-rule)
+ nil))
+ (or (fboundp 'encode-coding-string)
+ (defun encode-coding-string (string coding-system &optional nocopy)
+ (if nocopy
+ string
+ (copy-sequence string))))
+ (or (fboundp 'coding-system-p)
+ (defun coding-system-p (obj) nil))
+ (or (fboundp 'ccl-execute-on-string)
+ (defun ccl-execute-on-string (ccl-prog status str
+ &optional contin unibyte-p)
+ str))
+ (or (fboundp 'define-ccl-program)
+ (defmacro define-ccl-program (name ccl-program &optional doc)
+ `(defconst ,name nil ,doc)))
+ (or (fboundp 'multibyte-string-p)
+ (defun multibyte-string-p (str)
+ (let ((len (length str))
+ (i 0)
+ multibyte)
+ (while (and (< i len) (not (setq multibyte (> (aref str i) 255))))
+ (setq i (1+ i)))
+ multibyte)))
+ (or (fboundp 'string-make-multibyte)
+ (defalias 'string-make-multibyte 'copy-sequence))
+ (or (fboundp 'encode-char)
+ (defun encode-char (ch ccs)
+ ch)))
+
;;;###autoload
(defcustom ps-multibyte-buffer nil
changed by setting the variable
`ps-mule-font-info-database-default' differently.
The initial value of this variable is
- `ps-mule-font-info-database-latin' (which see).
+ `ps-mule-font-info-database-latin' (see
+ documentation).
`non-latin-printer' This is the value to use when you have a Japanese
or Korean PostScript printer and want to print
and non-latin fonts. BDF (Bitmap Distribution
Format) is a format used for distributing X's font
source file. BDF fonts are included in
- `intlfonts-1.1' which is a collection of X11 fonts
+ `intlfonts-1.2' which is a collection of X11 fonts
for all characters supported by Emacs. In order to
use this value, be sure to have installed
- `intlfonts-1.1' and set the variable
+ `intlfonts-1.2' and set the variable
`bdf-directory-list' appropriately (see ps-bdf.el for
documentation of this variable).
`ps-header-font-family' and `ps-font-info-database'.
Any other value is treated as nil."
- :type '(choice (const non-latin-printer) (const bdf-font)
- (const bdf-font-except-latin) (other :tag "nil" nil))
+ :type '(choice (const non-latin-printer) (const bdf-font)
+ (const bdf-font-except-latin) (const :tag "nil" nil))
:group 'ps-print-font)
-;; For Emacs 20.2 and the earlier version.
-(eval-and-compile
- (if (not (string< mule-version "4.0"))
- (progn
- (defalias 'ps-mule-next-point '1+)
- (defalias 'ps-mule-chars-in-string 'length)
- (defalias 'ps-mule-string-char 'aref)
- (defsubst ps-mule-next-index (str i) (1+ i)))
- (defun ps-mule-next-point (arg)
- (save-excursion (goto-char arg) (forward-char 1) (point)))
- (defun ps-mule-chars-in-string (string)
- (/ (length string)
- (charset-bytes (char-charset (string-to-char string)))))
- (defun ps-mule-string-char (string idx)
- (string-to-char (substring string idx)))
- (defun ps-mule-next-index (string i)
- (+ i (charset-bytes (char-charset (string-to-char string))))))
- )
-
(defvar ps-mule-font-info-database
nil
"Alist of charsets with the corresponding font information.
FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
-FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil.
+FONT-SRC is a font source: builtin, bdf, vflib, or nil.
- If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name.
+ If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name.
If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
alternative font names. To use this font, the external library `ps-bdf'
(normal nil nil iso-latin-1)))
"Sample setting of `ps-mule-font-info-database' to use latin fonts.")
-(defvar ps-mule-font-info-database-default
+(defcustom ps-mule-font-info-database-default
ps-mule-font-info-database-latin
- "The default setting to use if `ps-multibyte-buffer' (which see) is nil.")
+ "*The default setting to use when `ps-multibyte-buffer' is nil."
+ :type '(symbol :tag "Multi-Byte Buffer Database Font Default")
+ :group 'ps-print-font)
(defconst ps-mule-font-info-database-ps
'((katakana-jisx0201
(chinese-big5-2
(normal bdf "taipei24.bdf" chinese-big5 2))
(chinese-sisheng
- (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-8bit 1))
+ (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1))
(ipa
(normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
(vietnamese-viscii-lower
(arabic-2-column
(normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
(indian-is13194
- (normal bdf ("isci24-etl.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
+ (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
(indian-1-column
(normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
(tibetan-1-column
(indian-2-column
(normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
(tibetan
- (normal bdf ("tib24-mule.bdf" "mule-tibmdx-24.bdf") ps-mule-encode-7bit 2)))
+ (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")
+ ps-mule-encode-7bit 2))
+ (mule-unicode-0100-24ff
+ (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
+ (mule-unicode-2500-33ff
+ (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
+ (mule-unicode-e000-ffff
+ (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)))
"Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
BDF (Bitmap Distribution Format) is a format used for distributing X's font
source file.
-Current default value list for BDF fonts is included in `intlfonts-1.1' which is
-a collection of X11 fonts for all characters supported by Emacs.
+Current default value list for BDF fonts is included in `intlfonts-1.2'
+which is a collection of X11 fonts for all characters supported by Emacs.
-Using this list as default value to `ps-mule-font-info-database', all characters
-including ASCII and Latin-1 are printed by BDF fonts.
+Using this list as default value to `ps-mule-font-info-database', all
+characters including ASCII and Latin-1 are printed by BDF fonts.
See also `ps-mule-font-info-database-ps-bdf'.")
(cdr (cdr ps-mule-font-info-database-bdf)))
"Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
-Current default value list for BDF fonts is included in `intlfonts-1.1' which is
-a collection of X11 fonts for all characters supported by Emacs.
+Current default value list for BDF fonts is included in `intlfonts-1.2'
+which is a collection of X11 fonts for all characters supported by Emacs.
-Using this list as default value to `ps-mule-font-info-database', all characters
-except ASCII and Latin-1 characters are printed by BDF fonts. ASCII and Latin-1
-characters are printed by PostScript font specified by `ps-font-family' and
-`ps-header-font-family'.
+Using this list as default value to `ps-mule-font-info-database', all
+characters except ASCII and Latin-1 characters are printed with BDF fonts.
+ASCII and Latin-1 characters are printed with PostScript font specified
+by `ps-font-family' and `ps-header-font-family'.
See also `ps-mule-font-info-database-bdf'.")
(defun ps-mule-encode-bit (string delta)
(let* ((dim (charset-dimension (char-charset (string-to-char string))))
- (len (* (ps-mule-chars-in-string string) dim))
+ (len (* (length string) dim))
(str (make-string len 0))
(i 0)
(j 0))
(if (= dim 1)
(while (< j len)
(aset str j
- (+ (nth 1 (split-char (ps-mule-string-char string i))) delta))
- (setq i (ps-mule-next-index string i)
+ (+ (nth 1 (split-char (aref string i))) delta))
+ (setq i (1+ i)
j (1+ j)))
(while (< j len)
- (let ((split (split-char (ps-mule-string-char string i))))
+ (let ((split (split-char (aref string i))))
(aset str j (+ (nth 1 split) delta))
(aset str (1+ j) (+ (nth 2 split) delta))
- (setq i (ps-mule-next-index string i)
+ (setq i (1+ i)
j (+ j 2)))))
str))
;; Special encoding function for Ethiopic.
-(define-ccl-program ccl-encode-ethio-unicode
- `(1
- ((read r2)
- (loop
- (if (r2 == ,leading-code-private-22)
- ((read r0)
- (if (r0 == ,(charset-id 'ethiopic))
- ((read r1 r2)
- (r1 &= 127) (r2 &= 127)
- (call ccl-encode-ethio-font)
- (write r1)
- (write-read-repeat r2))
- ((write r2 r0)
- (repeat))))
- (write-read-repeat r2))))))
-
-(defun ps-mule-encode-ethiopic (string)
- (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
- (make-vector 9 nil)
- string))
+(if (boundp 'mule-version) ; only if mule package is loaded
+ (define-ccl-program ccl-encode-ethio-unicode
+ `(1
+ ((read r2)
+ (loop
+ (if (r2 == ,leading-code-private-22)
+ ((read r0)
+ (if (r0 == ,(charset-id 'ethiopic))
+ ((read r1 r2)
+ (r1 &= 127) (r2 &= 127)
+ (call ccl-encode-ethio-font)
+ (write r1)
+ (write-read-repeat r2))
+ ((write r2 r0)
+ (repeat))))
+ (write-read-repeat r2))))))
+ ;; to avoid compilation gripes
+ (defvar ccl-encode-ethio-unicode nil))
+
+(if (boundp 'mule-version)
+ ;; bound mule-version
+ (defun ps-mule-encode-ethiopic (string)
+ (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
+ (make-vector 9 nil)
+ string))
+ ;; unbound mule-version
+ (defun ps-mule-encode-ethiopic (string)
+ string))
+
+;; Special encoding for mule-unicode-* characters.
+(defun ps-mule-encode-ucs2 (string)
+ (let* ((len (length string))
+ (str (make-string (* 2 len) 0))
+ (i 0)
+ (j 0)
+ ch hi lo)
+ (while (< i len)
+ (setq ch (encode-char (aref string i) 'ucs)
+ hi (lsh ch -8)
+ lo (logand ch 255))
+ (aset str j hi)
+ (aset str (1+ j) lo)
+ (setq i (1+ i)
+ j (+ j 2)))
+ str))
;; A charset which we are now processing.
(defvar ps-mule-current-charset nil)
(defsubst ps-mule-printable-p (charset)
"Non-nil if characters in CHARSET is printable."
- (ps-mule-get-font-spec charset 'normal))
+ ;; ASCII and Latin-1 are always printable.
+ (or (eq charset 'ascii)
+ (eq charset 'latin-iso8859-1)
+ (ps-mule-get-font-spec charset 'normal)))
(defconst ps-mule-external-libraries
'((builtin nil nil
(let ((func (nth 3 slot)))
(if func
(progn
- (or (featurep (nth 1 slot)) (require (nth 1 slot)))
+ (require (nth 1 slot))
(ps-output-prologue (funcall func))))
(setcar (nthcdr 2 slot) t)))))
;; cache CODE0 CODE1 ...)
(defvar ps-mule-font-cache nil)
-(defun ps-mule-generate-font (font-spec charset)
- "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET."
+(defun ps-mule-generate-font (font-spec charset &optional header-p)
+ "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET.
+
+If optional 3rd arg HEADER-P is non-nil, generate codes to define a header
+font."
(let* ((font-name (ps-mule-font-spec-name font-spec))
(font-name (if (consp font-name) (car font-name) font-name))
(font-cache (assoc font-name ps-mule-font-cache))
(font-src (ps-mule-font-spec-src font-spec))
(func (nth 4 (assq font-src ps-mule-external-libraries)))
+ (font-size (if header-p (if (eq ps-current-font 0)
+ ps-header-title-font-size-internal
+ ps-header-font-size-internal)
+ ps-font-size-internal))
+ (current-font (+ ps-current-font (if header-p 10 0)))
(scaled-font-name
- (if (eq charset 'ascii)
- (format "f%d" ps-current-font)
- (format "f%02x-%d"
- (charset-id charset) ps-current-font))))
+ (cond (header-p
+ (format "h%d" ps-current-font))
+ ((eq charset 'ascii)
+ (format "f%d" ps-current-font))
+ (t
+ (format "f%02x-%d" (charset-id charset) ps-current-font)))))
(and func (not font-cache)
(ps-output-prologue (funcall func charset font-spec)))
(ps-output-prologue
(list (format "/%s %f /%s Def%sFontMule\n"
- scaled-font-name ps-font-size-internal font-name
- (if (eq ps-mule-current-charset 'ascii) "Ascii" ""))))
+ scaled-font-name font-size font-name
+ (if (or header-p
+ (eq ps-mule-current-charset 'ascii))
+ "Ascii" ""))))
(if font-cache
(setcar (cdr font-cache)
- (cons (cons ps-current-font scaled-font-name)
+ (cons (cons current-font scaled-font-name)
(nth 1 font-cache)))
(setq font-cache (list font-name
- (list (cons ps-current-font scaled-font-name))
+ (list (cons current-font scaled-font-name))
'cache)
ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
font-cache))
(funcall func font-spec code-list
(ps-mule-font-spec-bytes font-spec))))))
-(defun ps-mule-prepare-font (font-spec string charset &optional no-setfont)
+(defun ps-mule-prepare-font (font-spec string charset
+ &optional no-setfont header-p)
"Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
The generated code is inserted on prologue part except the code that sets the
current font (using PostScript procedure `FM').
-If optional arg NO-SETFONT is non-nil, don't generate the code for setting the
-current font."
+If optional 4th arg NO-SETFONT is non-nil, don't generate the code for setting
+the current font.
+
+If optional 5th arg HEADER-P is non-nil, generate a code for setting a header
+font."
(let* ((font-name (ps-mule-font-spec-name font-spec))
(font-name (if (consp font-name) (car font-name) font-name))
+ (current-font (+ ps-current-font (if header-p 10 0)))
(font-cache (assoc font-name ps-mule-font-cache)))
- (or (and font-cache (assq ps-current-font (nth 1 font-cache)))
- (setq font-cache (ps-mule-generate-font font-spec charset)))
+ (or (and font-cache (assq current-font (nth 1 font-cache)))
+ (setq font-cache (ps-mule-generate-font font-spec charset header-p)))
(or no-setfont
- (let ((new-font (cdr (assq ps-current-font (nth 1 font-cache)))))
+ (let ((new-font (cdr (assq current-font (nth 1 font-cache)))))
(or (equal new-font ps-last-font)
(progn
(ps-output (format "/%s FM\n" new-font))
dup length 2 add dict begin
{ 1 index /FID ne { def } { pop pop } ifelse } forall
currentdict /BaselineOffset known {
- BaselineOffset false eq { /BaselinfOffset 0 def } if
+ BaselineOffset false eq { /BaselineOffset 0 def } if
} {
/BaselineOffset 0 def
} ifelse
/RelativeCompose [ 0 0.1 ] def
} {
RelativeCompose false ne {
- [ BaselineOffset RelativeCompose BaselineOffset add
- [ FontMatrix { FontSize div } forall ] transform ]
- /RelativeCompose exch def
+ [ BaselineOffset RelativeCompose BaselineOffset add
+ [ FontMatrix { FontSize div } forall ] transform ]
+ /RelativeCompose exch def
} if
} ifelse
currentdict
end
} def
-%% Set the specified non-ASCII font to use. It doesn't install
-%% Ascent, etc.
+/CurrentFont false def
+
+%% Set the specified font to use.
+%% For non-ASCII font, don't install Ascent, etc.
/FM { % fontname |- --
- findfont setfont
+ /font exch def
+ font /f0 eq font /f1 eq font /f2 eq font /f3 eq or or or {
+ font F
+ } {
+ font findfont setfont
+ } ifelse
} bind def
%% Show vacant box for characters which don't have appropriate font.
} for
} bind def
-%% Flag to tell if we are now handling a composite character. This is
-%% defined here because both composite character handler and bitmap font
+%% Flag to tell if we are now handling a composition. This is
+%% defined here because both composition handler and bitmap font
%% handler require it.
-/Cmpchar false def
+/Composing false def
%%%% End of Mule Section
(ps-output-prologue ps-mule-prologue)
(setq ps-mule-prologue-generated t)))
-(defun ps-mule-find-wrappoint (from to char-width)
+(defun ps-mule-find-wrappoint (from to char-width &optional composition)
"Find the longest sequence which is printable in the current line.
-The search starts at FROM and goes until TO. It is assumed that all characters
-between FROM and TO belong to a charset in `ps-mule-current-charset'.
+The search starts at FROM and goes until TO.
+
+Optional 4th arg COMPOSITION, if non-nil, is information of
+composition starting at FROM.
+
+If COMPOSITION is nil, it is assumed that all characters between FROM
+and TO belong to a charset in `ps-mule-current-charset'. Otherwise,
+it is assumed that all characters between FROM and TO belong to the
+same composition.
CHAR-WIDTH is the average width of ASCII characters in the current font.
Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence."
- (if (eq ps-mule-current-charset 'composition)
+ (if (or composition (eq ps-mule-current-charset 'composition))
;; We must draw one char by one.
- (let ((run-width (* (char-width (char-after from)) char-width)))
+ (let ((run-width (if composition
+ (nth 5 composition)
+ (* (char-width (char-after from)) char-width))))
(if (> run-width ps-width-remaining)
(cons from ps-width-remaining)
- (cons (ps-mule-next-point from) run-width)))
+ (cons (if composition
+ (nth 1 composition)
+ (1+ from))
+ run-width)))
;; We assume that all characters in this range have the same width.
(setq char-width (* char-width (charset-width ps-mule-current-charset)))
- (let ((run-width (* (chars-in-region from to) char-width)))
+ (let ((run-width (* (abs (- from to)) char-width)))
(if (> run-width ps-width-remaining)
(cons (min to
(save-excursion
;;;###autoload
(defun ps-mule-plot-string (from to &optional bg-color)
- "Generate PostScript code for ploting characters in the region FROM and TO.
+ "Generate PostScript code for plotting characters in the region FROM and TO.
It is assumed that all characters in this region belong to the same charset.
Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence."
- (setq ps-mule-current-charset (charset-after from))
+ (let ((ch (char-after from)))
+ (setq ps-mule-current-charset
+ (char-charset (or (aref ps-print-translation-table ch) ch))))
(let* ((wrappoint (ps-mule-find-wrappoint
from to (ps-avg-char-width 'ps-font-for-text)))
(to (car wrappoint))
(ps-font-alist 'ps-font-for-text))))
(font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
(string (buffer-substring-no-properties from to)))
+ (dotimes (i (length string))
+ (let ((ch (aref ps-print-translation-table (aref string i))))
+ (if ch
+ (aset string i ch))))
(cond
((= from to)
;; We can't print any more characters in the current line.
(ps-output-string (ps-mule-string-ascii string))
(ps-output " S\n"))
+ ;; This case is obsolete for Emacs 21.
((eq ps-mule-current-charset 'composition)
- (let* ((ch (char-after from))
- (width (char-width ch))
- (ch-list (decompose-composite-char ch 'list t)))
- (if (consp (nth 1 ch-list))
- (ps-mule-plot-rule-cmpchar ch-list width font-type)
- (ps-mule-plot-cmpchar ch-list width t font-type))))
+ (ps-mule-plot-composition from (1+ from) bg-color))
(t
;; No way to print this charset. Just show a vacant box of an
(charset-width ps-mule-current-charset))))))
wrappoint))
+;;;###autoload
+(defun ps-mule-plot-composition (from to &optional bg-color)
+ "Generate PostScript code for plotting composition in the region FROM and TO.
+
+It is assumed that all characters in this region belong to the same
+composition.
+
+Optional argument BG-COLOR specifies background color.
+
+Returns the value:
+
+ (ENDPOS . RUN-WIDTH)
+
+Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
+the sequence."
+ (let* ((composition (find-composition from nil nil t))
+ (wrappoint (ps-mule-find-wrappoint
+ from to (ps-avg-char-width 'ps-font-for-text)
+ composition))
+ (to (car wrappoint))
+ (font-type (car (nth ps-current-font
+ (ps-font-alist 'ps-font-for-text)))))
+ (if (< from to)
+ ;; We can print this composition in the current line.
+ (let ((components (nth 2 composition)))
+ (ps-mule-plot-components
+ (ps-mule-prepare-font-for-components components font-type)
+ (if (nth 3 composition) "RLC" "RBC"))))
+ wrappoint))
+
+;; Prepare font of FONT-TYPE for printing COMPONENTS. By side effect,
+;; change character elements in COMPONENTS to the form:
+;; ENCODED-STRING or (FONTNAME . ENCODED-STRING)
+;; and change rule elements to the encoded value (integer).
+;; The latter form is used if we much change font for the character.
+
+(defun ps-mule-prepare-font-for-components (components font-type)
+ (let ((len (length components))
+ (i 0)
+ elt)
+ (while (< i len)
+ (setq elt (aref components i))
+ (if (consp elt)
+ ;; ELT is a composition rule.
+ (setq elt (encode-composition-rule elt))
+ ;; ELT is a glyph character.
+ (let* ((charset (char-charset elt))
+ (font (or (eq charset ps-mule-current-charset)
+ (if (eq charset 'ascii)
+ (format "/f%d" ps-current-font)
+ (format "/f%02x-%d"
+ (charset-id charset) ps-current-font))))
+ str)
+ (setq ps-mule-current-charset charset
+ str (ps-mule-string-encoding
+ (ps-mule-get-font-spec charset font-type)
+ (char-to-string elt)
+ 'no-setfont))
+ (if (stringp font)
+ (setq elt (cons font str) ps-last-font font)
+ (setq elt str))))
+ (aset components i elt)
+ (setq i (1+ i))))
+ components)
+
+(defun ps-mule-plot-components (components tail)
+ (let ((elt (aref components 0))
+ (len (length components))
+ (i 1))
+ (ps-output "[ ")
+ (if (stringp elt)
+ (ps-output-string elt)
+ (ps-output (car elt) " ")
+ (ps-output-string (cdr elt)))
+ (while (< i len)
+ (setq elt (aref components i) i (1+ i))
+ (ps-output " ")
+ (cond ((stringp elt)
+ (ps-output-string elt))
+ ((consp elt)
+ (ps-output (car elt) " ")
+ (ps-output-string (cdr elt)))
+ (t ; i.e. (integerp elt)
+ (ps-output (format "%d" elt)))))
+ (ps-output " ] " tail "\n")))
+
;; Composite font support
-(defvar ps-mule-cmpchar-prologue-generated nil)
+(defvar ps-mule-composition-prologue-generated nil)
-(defconst ps-mule-cmpchar-prologue
- "%%%% Composite character handler
-/CmpcharWidth 0 def
-/CmpcharRelativeCompose 0 def
-/CmpcharRelativeSkip 0.4 def
+(defconst ps-mule-composition-prologue
+ "%%%% Character composition handler
+/RelativeCompositionSkip 0.4 def
%% Get a bounding box (relative to currentpoint) of STR.
/GetPathBox { % str |- --
grestore
} bind def
-%% Beginning of composite char.
-/BC { % str xoff width |- --
- /Cmpchar true def
- /CmpcharWidth exch def
- currentfont /RelativeCompose known {
- /CmpcharRelativeCompose currentfont /RelativeCompose get def
- } {
- /CmpcharRelativeCompose false def
- } ifelse
- /bgsave bg def /bgcolorsave bgcolor def
- /Effectsave Effect def
- gsave % Reflect effect only at first
- /Effect Effect 1 2 add 4 add 16 add and def
- /f0 findfont setfont ( ) 0 CmpcharWidth getinterval S
- grestore
- /Effect Effectsave 8 32 add and def % enable only shadow and outline
- false BG
- gsave
- SpaceWidth mul 0 rmoveto dup GetPathBox S
- /RIGHT currentpoint pop def
- grestore
- /y currentpoint exch pop def
- /HIGH URY y add def /LOW LLY y add def
-} bind def
+%% Apply effects (underline, strikeout, overline, box) to the
+%% rectangle specified by TOP BOTTOM LEFT RIGHT.
+/SpecialEffect { % -- |- --
+ currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def
+ dup LEFT add /xx exch def RIGHT add /XX exch def
+ %% Adjust positions for future shadowing.
+ Effect 8 and 0 ne {
+ /yy yy Yshadow add def
+ /XX XX Xshadow add def
+ } if
+ Effect 1 and 0 ne { UnderlinePosition Hline } if % underline
+ Effect 2 and 0 ne { StrikeoutPosition Hline } if % strikeout
+ Effect 4 and 0 ne { OverlinePosition Hline } if % overline
+ bg { % background
+ true
+ Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse
+ } if
+ Effect 16 and 0 ne { false 0 doBox } if % box
+} def
-%% End of composite char.
-/EC { % -- |- --
- /bg bgsave def /bgcolor bgcolorsave def
- /Effect Effectsave def
- /Cmpchar false def
- CmpcharRelativeCompose false eq {
- CmpcharWidth SpaceWidth mul 0 rmoveto
- } {
- RIGHT currentpoint exch pop moveto
- } ifelse
-} bind def
+%% Show STR with effects (shadow, outline).
+/ShowWithEffect { % str |- --
+ Effect 8 and 0 ne { dup doShadow } if
+ Effect 32 and 0 ne { true doOutline } { show } ifelse
+} def
+
+%% Draw COMPONENTS which have the form [ font0? [str0 xoff0 yoff0] ... ].
+/ShowComponents { % components |- -
+ LEFT 0 lt { LEFT neg 0 rmoveto } if
+ {
+ dup type /nametype eq { % font
+ FM
+ } { % [ str xoff yoff ]
+ gsave
+ aload pop rmoveto ShowWithEffect
+ grestore
+ } ifelse
+ } forall
+ RIGHT 0 rmoveto
+} def
-%% Rule base composition
-/RBC { % str xoff gref nref |- --
- /nref exch def /gref exch def
+%% Show relative composition.
+/RLC { % [ font0? str0 font1? str1 ... fontN? strN ] |- --
+ /components exch def
+ /Composing true def
+ /first true def
gsave
- SpaceWidth mul 0 rmoveto
- dup
- GetPathBox
- [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get
- [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get
- sub /btm exch def
- /top btm URY LLY sub add def
- top HIGH gt { /HIGH top def } if
- btm LOW lt { /LOW btm def } if
- currentpoint pop btm LLY sub moveto
- S
+ [ components {
+ /elt exch def
+ elt type /nametype eq { % font
+ elt dup FM
+ } { first { % first string
+ /first false def
+ elt GetPathBox
+ %% Bounding box of overall glyphs.
+ /LEFT LLX def
+ /RIGHT URX def
+ /TOP URY def
+ /BOTTOM LLY def
+ currentfont /RelativeCompose known {
+ /relative currentfont /RelativeCompose get def
+ relative false eq {
+ %% Disable relative composition by setting sufficiently low
+ %% and high positions.
+ /relative [ -100000 100000 ] def
+ } if
+ } {
+ /relative [ -100000 100000 ] def
+ } ifelse
+ [ elt 0 0 ]
+ } { % other strings
+ elt GetPathBox
+ [ elt % str
+ LLX 0 lt { RIGHT } { 0 } ifelse % xoff
+ LLY relative 1 get ge { % compose on TOP
+ TOP LLY sub RelativeCompositionSkip add % yoff
+ /TOP TOP URY LLY sub add RelativeCompositionSkip add def
+ } { URY relative 0 get le { % compose under BOTTOM
+ BOTTOM URY sub RelativeCompositionSkip sub % yoff
+ /BOTTOM BOTTOM URY LLY sub sub
+ RelativeCompositionSkip sub def
+ } {
+ 0 % yoff
+ URY TOP gt { /TOP URY def } if
+ LLY BOTTOM lt { /BOTTOM LLY def } if
+ } ifelse } ifelse
+ ]
+ URX RIGHT gt { /RIGHT URX def } if
+ } ifelse } ifelse
+ } forall ] /components exch def
grestore
- /CmpcharRelativeCompose false def
-} bind def
-%% Relative composition
-/RLC { % str |- --
+ %% Reflect special effects.
+ SpecialEffect
+
+ %% Draw components while ignoring effects other than shadow and outline.
+ components ShowComponents
+ /Composing false def
+
+} def
+
+%% Show rule-base composition.
+/RBC { % [ font0? str0 rule1 font1? str1 rule2 ... strN ] |- --
+ /components exch def
+ /Composing true def
+ /first true def
gsave
- dup GetPathBox
- LLX 0 lt { RIGHT currentpoint exch pop moveto } if
- CmpcharRelativeCompose type /arraytype eq {
- LLY CmpcharRelativeCompose 1 get ge { % compose on top
- currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto
- /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def
- } { URY CmpcharRelativeCompose 0 get le { % compose under bottom
- currentpoint pop LOW URY sub CmpcharRelativeSkip sub moveto
- /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def
- } {
- /y currentpoint exch pop def
- y URY add dup HIGH gt { /HIGH exch def } { pop } ifelse
- y LLY add dup LOW lt { /LOW exch def } { pop } ifelse
- } ifelse } ifelse } if
- S
+ [ components {
+ /elt exch def
+ elt type /nametype eq { % font
+ elt dup FM
+ } { elt type /integertype eq { % rule
+ %% This RULE decoding should be compatible with macro
+ %% COMPOSITION_DECODE_RULE in emacs/src/composite.h.
+ elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def
+ elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def
+ } { first { % first string
+ /first false def
+ elt GetPathBox
+ %% Bounding box of overall glyphs.
+ /LEFT LLX def
+ /RIGHT URX def
+ /TOP URY def
+ /BOTTOM LLY def
+ /WIDTH RIGHT LEFT sub def
+ [ elt 0 0 ]
+ } { % other strings
+ elt GetPathBox
+ /width URX LLX sub def
+ /height URY LLY sub def
+ /left LEFT [ 0 WIDTH 2 div WIDTH ] grefx get add
+ [ 0 width 2 div width ] nrefx get sub def
+ /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get
+ [ height LLY neg 0 height 2 div ] nrefy get sub def
+ %% Update bounding box
+ left LEFT lt { /LEFT left def } if
+ left width add RIGHT gt { /RIGHT left width add def } if
+ /WIDTH RIGHT LEFT sub def
+ bottom BOTTOM lt { /BOTTOM bottom def } if
+ bottom height add TOP gt { /TOP bottom height add def } if
+ [ elt left LLX sub bottom LLY sub ]
+ } ifelse } ifelse } ifelse
+ } forall ] /components exch def
grestore
-} bind def
-%%%% End of composite character handler
+
+ %% Reflect special effects.
+ SpecialEffect
+
+ %% Draw components while ignoring effects other than shadow and outline.
+ components ShowComponents
+
+ /Composing false def
+} def
+%%%% End of character composition handler
"
- "PostScript code for printing composite characters.")
-
-(defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type)
- (let ((leftmost 0.0)
- (rightmost (float (char-width (car ch-rule-list))))
- (the-list (cons '(3 . 3) ch-rule-list))
- cmpchar-elements)
- (while the-list
- (let* ((this (car the-list))
- (gref (car this))
- (nref (cdr this))
- ;; X-axis info (0:left, 1:center, 2:right)
- (gref-x (% gref 3))
- (nref-x (% nref 3))
- ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center)
- (gref-y (if (= gref 4) 3 (/ gref 3)))
- (nref-y (if (= nref 4) 3 (/ nref 3)))
- (char (car (cdr the-list)))
- (width (float (char-width char)))
- left)
- (setq left (+ leftmost
- (* (- rightmost leftmost) gref-x 0.5)
- (- (* nref-x width 0.5)))
- cmpchar-elements (cons (list char left gref-y nref-y)
- cmpchar-elements)
- leftmost (min left leftmost)
- rightmost (max (+ left width) rightmost)
- the-list (nthcdr 2 the-list))))
- (if (< leftmost 0)
- (let ((the-list cmpchar-elements)
- elt)
- (while the-list
- (setq elt (car the-list)
- the-list (cdr the-list))
- (setcar (cdr elt) (- (nth 1 elt) leftmost)))))
- (ps-mule-plot-cmpchar (nreverse cmpchar-elements)
- total-width nil font-type)))
-
-(defun ps-mule-plot-cmpchar (elements total-width relativep font-type)
- (let* ((elt (car elements))
- (ch (if relativep elt (car elt))))
- (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
- (ps-output (format " %d %d BC "
- (if relativep 0 (nth 1 elt))
- total-width))
- (while (setq elements (cdr elements))
- (setq elt (car elements)
- ch (if relativep elt (car elt)))
- (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
- (ps-output (if relativep
- " RLC "
- (format " %d %d %d RBC "
- (nth 1 elt) (nth 2 elt) (nth 3 elt))))))
- (ps-output "EC\n"))
-
-(defun ps-mule-prepare-cmpchar-font (char font-type)
- (let* ((ps-mule-current-charset (char-charset char))
- (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)))
- (cond (font-spec
- (ps-mule-string-encoding font-spec (char-to-string char)))
-
- ((eq ps-mule-current-charset 'latin-iso8859-1)
- (ps-mule-string-ascii (char-to-string char)))
-
- (t
- ;; No font for CHAR.
- (ps-set-font ps-current-font)
- " "))))
+ "PostScript code for printing character composition.")
(defun ps-mule-string-ascii (str)
(ps-set-font ps-current-font)
(string-as-unibyte (encode-coding-string str 'iso-latin-1)))
-(defun ps-mule-string-encoding (font-spec str)
+;; Encode STR for a font specified by FONT-SPEC and return the result.
+;; If necessary, it generates the PostScript code for the font and glyphs to
+;; print STR. If optional 4th arg HEADER-P is non-nil, it is assumed that STR
+;; is for headers.
+(defun ps-mule-string-encoding (font-spec str &optional no-setfont header-p)
(let ((encoding (ps-mule-font-spec-encoding font-spec)))
(setq str
(string-as-unibyte
(t
str))))
(if (ps-mule-font-spec-src font-spec)
- (ps-mule-prepare-font font-spec str ps-mule-current-charset)
- (ps-set-font ps-current-font))
+ (ps-mule-prepare-font font-spec str ps-mule-current-charset
+ (or no-setfont header-p)
+ header-p)
+ (or no-setfont
+ (ps-set-font ps-current-font)))
str))
;; Bitmap font support
1 index /FontIndex get exch FirstCode exch
GlobalCharName GetBitmap /bmp exch def
%% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]
- Cmpchar { %ifelse
+ Composing { %ifelse
/FontMatrix get [ exch { size div } forall ] /mtrx exch def
bmp 3 get bmp 4 get mtrx transform
/LLY exch def /LLX exch def
} ifelse
/FirstCode -1 store
- bmp 0 get SpaceWidthRatio ratio div mul size div 0 % wx wy
+ bmp 0 get size div 0 % wx wy
setcharwidth % We can't use setcachedevice here.
bmp 1 get 0 gt bmp 2 get 0 gt and {
1 index /BuildGlyph get exec
} bind def
-%% Bitmap font creater
+%% Bitmap font creator
%% Common Encoding shared by all bitmap fonts.
/EncodingCommon 256 array def
"Initialize global data for printing multi-byte characters."
(setq ps-mule-font-cache nil
ps-mule-prologue-generated nil
- ps-mule-cmpchar-prologue-generated nil
+ ps-mule-composition-prologue-generated nil
ps-mule-bitmap-prologue-generated nil)
(mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
ps-mule-external-libraries))
+(defvar ps-mule-header-charsets nil)
+
+;;;###autoload
+(defun ps-mule-encode-header-string (string fonttag)
+ "Generate PostScript code for ploting STRING by font FONTTAG.
+FONTTAG should be a string \"/h0\" or \"/h1\"."
+ (setq string (cond ((not (stringp string))
+ "")
+ ((multibyte-string-p string)
+ (copy-sequence string))
+ (t
+ (string-make-multibyte string))))
+ (when ps-mule-header-charsets
+ (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1)
+ ;; Latin1 characters can be printed by the standard PostScript
+ ;; font. Converts the other non-ASCII characters to `?'.
+ (let ((len (length string))
+ (i 0))
+ (while (< i len)
+ (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1))
+ (aset string i ??))
+ (setq i (1+ i)))
+ (setq string (encode-coding-string string 'iso-latin-1)))
+ ;; We must prepare a font for the first non-ASCII and non-Latin1
+ ;; character in STRING.
+ (let* ((ps-current-font (if (string= fonttag "/h0") 0 1))
+ (ps-mule-current-charset (car ps-mule-header-charsets))
+ (font-type (car (nth ps-current-font
+ (ps-font-alist 'ps-font-for-header))))
+ (font-spec (ps-mule-get-font-spec ps-mule-current-charset
+ font-type)))
+ (if (or (not font-spec)
+ (/= (charset-dimension ps-mule-current-charset) 1))
+ ;; We don't have a proper font, or we can't print them on
+ ;; header because this kind of charset is not ASCII
+ ;; compatible.
+ (let ((len (length string))
+ (i 0))
+ (while (< i len)
+ (or (memq (char-charset (aref string i))
+ '(ascii latin-iso8859-1))
+ (aset string i ??))
+ (setq i (1+ i)))
+ (setq string (encode-coding-string string 'iso-latin-1)))
+ (let ((charsets (list 'ascii (car ps-mule-header-charsets)))
+ (len (length string))
+ (i 0))
+ (while (< i len)
+ (or (memq (char-charset (aref string i)) charsets)
+ (aset string i ??))
+ (setq i (1+ i))))
+ (setq string (ps-mule-string-encoding font-spec string nil t))))))
+ string)
+
+(defun ps-mule-show-warning (charsets from to header-footer-list)
+ (let ((table (make-category-table))
+ (buf (current-buffer))
+ (max-unprintable-chars 15)
+ char-pos-list)
+ (define-category ?u "Unprintable charset" table)
+ (dolist (cs charsets)
+ (modify-category-entry (make-char cs) ?u table))
+ (with-category-table table
+ (save-excursion
+ (goto-char from)
+ (while (and (<= (length char-pos-list) max-unprintable-chars)
+ (re-search-forward "\\cu" to t))
+ (or (aref ps-print-translation-table (preceding-char))
+ (push (cons (preceding-char) (1- (point))) char-pos-list)))))
+ (with-output-to-temp-buffer "*Warning*"
+ (with-current-buffer standard-output
+ (when char-pos-list
+ (let ((func #'(lambda (buf pos)
+ (when (buffer-live-p buf)
+ (pop-to-buffer buf)
+ (goto-char pos))))
+ (more nil))
+ (if (>= (length char-pos-list) max-unprintable-chars)
+ (setq char-pos-list (cdr char-pos-list)
+ more t))
+ (insert "These characters in the buffer can't be printed:\n")
+ (dolist (elt (nreverse char-pos-list))
+ (insert " ")
+ (insert-text-button (string (car elt))
+ :type 'help-xref
+ 'help-echo
+ "mouse-2, RET: jump to this character"
+ 'help-function func
+ 'help-args (list buf (cdr elt)))
+ (insert ","))
+ (if more
+ (insert " and more...")
+ ;; Delete the last comma.
+ (delete-char -1))
+ (insert "\nClick them to jump to the buffer position,\n"
+ (substitute-command-keys "\
+or \\[universal-argument] \\[what-cursor-position] will give information about them.\n"))))
+
+ (with-category-table table
+ (let (string-list idx)
+ (dolist (elt header-footer-list)
+ (when (stringp elt)
+ (when (string-match "\\cu+" elt)
+ (setq elt (copy-sequence elt))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'highlight elt)
+ (while (string-match "\\cu+" elt (match-end 0))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'highlight elt))
+ (push elt string-list))))
+ (when string-list
+ (insert
+ "These highlighted characters in header/footer can't be printed:\n")
+ (dolist (elt string-list)
+ (insert " " elt "\n")))))))))
+
;;;###autoload
(defun ps-mule-begin-job (from to)
"Start printing job for multi-byte chars between FROM and TO.
This checks if all multi-byte characters in the region are printable or not."
(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)
enable-multibyte-characters
;; Initialize `ps-mule-charset-list'. If some characters aren't
;; printable, warn it.
- (let ((charsets (find-charset-region from to)))
- (setq charsets (delq 'ascii (delq 'unknown (delq nil charsets)))
- ps-mule-charset-list charsets)
- (save-excursion
- (goto-char from)
- (and (search-forward "\200" to t)
- (setq ps-mule-charset-list
- (cons 'composition ps-mule-charset-list))))
- (while charsets
- (setq charsets
- (cond
- ((or (eq (car charsets) 'composition)
- (ps-mule-printable-p (car charsets)))
- (cdr charsets))
- ((y-or-n-p
- "Font for some characters not found, continue anyway? ")
- nil)
- (t
- (error "Printing cancelled")))))))
+ (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 ps-mule-charset-list
- (let ((the-list ps-mule-charset-list)
- font-spec elt)
+ (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)
- ;; If external functions are necessary, generate prologues for them.
- (while the-list
- (setq elt (car the-list)
- the-list (cdr the-list))
- (cond ((and (eq elt 'composition)
- (not ps-mule-cmpchar-prologue-generated))
- (ps-output-prologue ps-mule-cmpchar-prologue)
- (setq ps-mule-cmpchar-prologue-generated t))
- ((setq font-spec (ps-mule-get-font-spec elt 'normal))
- (ps-mule-init-external-library font-spec))))))
+ (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 istead of what specified in ps-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
(setq font (cdr font)
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
(provide 'ps-mule)
+;;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe
;;; ps-mule.el ends here