-;;; 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, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005 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: wp, print, PostScript, multibyte, mule
-;; Time-stamp: <99/12/11 20:09:24 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:
;; 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).
;;
;;; 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
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 (and (boundp 'mule-version) ; only if mule package is loaded
- (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)))))
- ))
-
-;; For Emacs 20.4 and the earlier version.
-(eval-and-compile
- (when (and (boundp 'mule-version)
- (string< mule-version "5.0"))
- (defun encode-composition-rule (rule)
- (if (= (car rule) 4) (setcar rule 10))
- (if (= (cdr rule) 4) (setcdr rule 10))
- (+ (* (car rule) 12) (cdr rule)))
- (defun find-composition (pos &rest ignore)
- (let ((ch (char-after pos)))
- (if (eq (char-charset ch) 'composition)
- (let ((components (decompose-composite-char ch 'vector t)))
- (list pos (ps-mule-next-point pos) components
- (integerp (aref components 1)) nil
- (char-width ch))))))))
-
(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'
(defcustom ps-mule-font-info-database-default
ps-mule-font-info-database-latin
- "*The default setting to use if `ps-multibyte-buffer' is nil."
- :type '(repeat :tag "Multi-Byte Buffer Database Font Default"
- (list (symbol :tag "Charset")
- (repeat :inline t
- (list (choice :tag "Font Type"
- (const normal) (const bold)
- (const italic) (const bold-italic))
- (choice :tag "Font Source"
- (const builtin) (const ps-bdf)
- (const vflib)
- (other :tag "nil" nil))
- (list (string :tag "Font Name"))
- (function :tag "Encoding")
- (integer :tag "Bytes")))))
+ "*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
(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))
(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
;; 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
Optional 4th arg COMPOSITION, if non-nil, is information of
composition starting at FROM.
-If COMPOSTION is nil, it is assumed that all characters between 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.
(cons from ps-width-remaining)
(cons (if composition
(nth 1 composition)
- (ps-mule-next-point from))
+ (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.
;; This case is obsolete for Emacs 21.
((eq ps-mule-current-charset 'composition)
- (ps-mule-plot-composition from (ps-mule-next-point from) bg-color))
+ (ps-mule-plot-composition from (1+ from) bg-color))
(t
;; No way to print this charset. Just show a vacant box of an
;;;###autoload
(defun ps-mule-plot-composition (from to &optional bg-color)
- "Generate PostScript code for ploting composition in the region FROM and TO.
+ "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.
(defvar ps-mule-composition-prologue-generated nil)
(defconst ps-mule-composition-prologue
- "%%%% Character compositition handler
+ "%%%% Character composition handler
/RelativeCompositionSkip 0.4 def
%% Get a bounding box (relative to currentpoint) of STR.
Effect 32 and 0 ne { true doOutline } { show } ifelse
} def
-%% Draw COMPONETS which have the form [ font0? [str0 xoff0 yoff0] ... ].
-/ShowComponents { % compoents |- -
+%% 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
/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
} {
- %% Disable relative composition by setting sufficiently low
- %% and high positions.
/relative [ -100000 100000 ] def
} ifelse
[ elt 0 0 ]
elt dup FM
} { elt type /integertype eq { % rule
%% This RULE decoding should be compatible with macro
- %% COMPOSITION_DECODE_RULE in emcas/src/composite.h.
+ %% 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
} ifelse } ifelse } ifelse
} forall ] /components exch def
grestore
-
+
%% Reflect special effects.
SpecialEffect
-
+
%% Draw components while ignoring effects other than shadow and outline.
components ShowComponents
%%%% End of character composition handler
"
- "PostScript code for printing character compositition.")
+ "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)))
;; Encode STR for a font specified by FONT-SPEC and return the result.
-;; If necessary, Postscript codes for the font and glyphs to print
-;; STRING are generated.
-(defun ps-mule-string-encoding (font-spec str &optional no-setfont)
+;; 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 no-setfont)
+ (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))
} 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
(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 (and (nth 2 (find-composition from to))
- (not ps-mule-composition-prologue-generated))
- (progn
+ (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-output-prologue ps-mule-composition-prologue)
- (setq ps-mule-composition-prologue-generated t)))
-
- (if ps-mule-charset-list
- (let ((the-list ps-mule-charset-list)
- font-spec elt)
- (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-composition-prologue-generated))
- (ps-output-prologue ps-mule-composition-prologue)
- (setq ps-mule-composition-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