;;; ps-mule.el --- Provide multi-byte character facility to ps-print.
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998,99,00,2001 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: <2000/08/01 11:17:35 vinicius>
+;; Time-stamp: <2001/03/16 18:50:59 Handa>
;; This file is part of GNU Emacs.
;; 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 '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))))
;;;###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).
: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")))
+ ;; For Emacs 20.2 and the earlier version.
+ (if (and (boundp 'mule-version)
+ (not (string< (symbol-value 'mule-version) "4.0")))
+ ;; mule package is loaded
(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)))
+ ;; mule package isn't loaded or mule version lesser than 4.0
(defun ps-mule-next-point (arg)
(save-excursion (goto-char arg) (forward-char 1) (point)))
(defun ps-mule-chars-in-string (string)
(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.
+ (if (and (boundp 'mule-version)
+ (string< (symbol-value 'mule-version) "5.0"))
+ ;; mule package is loaded and mule version is lesser than 5.0
+ (progn
+ (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)))))))
+ ;; mule package isn't loaded
+ (or (fboundp 'encode-composition-rule)
+ (defun encode-composition-rule (rule)
+ 130))
+ (or (fboundp 'find-composition)
+ (defun find-composition (pos &rest ignore)
+ nil))
))
-;; 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-SRC is a font source: builtin, ps-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'
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
+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
(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
+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
;; 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.
;;;###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.
;;;###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
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
%%%% 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's generated 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))
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 (if (multibyte-string-p string)
+ (copy-sequence string)
+ (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)))
+ (dotimes (i len)
+ (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1))
+ (aset string 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)))
+ (dotimes (i len)
+ (or (memq (char-charset (aref string i))
+ '(ascii latin-iso8859-1))
+ (aset string i ??)))
+ (setq string (encode-coding-string string 'iso-latin-1)))
+ (let ((charsets (list 'ascii (car ps-mule-header-charsets)))
+ (len (length string)))
+ (dotimes (i len)
+ (or (memq (char-charset (aref string i)) charsets)
+ (aset string i ??))))
+ (setq string (ps-mule-string-encoding font-spec string nil t))))))
+ string)
+
+;;;###autoload
+(defun ps-mule-header-string-charsets ()
+ "Return a list of character sets that appears in header strings."
+ (let ((str "")
+ len charset charset-list)
+ (when ps-print-header
+ (dolist (tail (list ps-left-header ps-right-header))
+ ;; Simulate what is done by ps-generate-header-line to get a
+ ;; string to plot.
+ (let ((count 0))
+ (dolist (elt tail)
+ (if (< count ps-header-lines)
+ (setq str (concat str (cond ((stringp elt) elt)
+ ((and (symbolp elt) (fboundp elt))
+ (funcall elt))
+ ((and (symbolp elt) (boundp elt))
+ (symbol-value elt))
+ (t "")))
+ count (1+ count)))))))
+ (setq len (length str))
+ (dotimes (i len)
+ (setq charset (char-charset (aref str i)))
+ (or (eq charset 'ascii)
+ (memq charset charset-list)
+ (setq charset-list (cons charset charset-list))))
+ charset-list))
+
;;;###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)
(and (search-forward "\200" to t)
(setq ps-mule-charset-list
(cons 'composition ps-mule-charset-list))))
+ ;; We also have to check non-ASCII charsets in the header strings.
+ (let ((tail (ps-mule-header-string-charsets)))
+ (while tail
+ (unless (eq (car tail) 'ascii)
+ (setq ps-mule-header-charsets
+ (cons (car tail) ps-mule-header-charsets))
+ (or (memq (car tail) charsets)
+ (setq charsets (cons (car tail) charsets))))
+ (setq tail (cdr tail))))
(while charsets
(setq charsets
(cond
(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)
+ (if (or ps-mule-charset-list ps-mule-header-charsets)
+ (let ((the-list (append ps-mule-header-charsets ps-mule-charset-list))
font-spec elt)
(ps-mule-prologue-generated)
;; If external functions are necessary, generate prologues for them.
(ps-mule-init-external-library font-spec))))))
;; 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 occurance of such characters.
+ (if (and ps-mule-header-charsets
+ (not (eq (car ps-mule-header-charsets) 'latin-iso8859-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
projects / emacs.git / commitdiff