Mercurial > emacs
changeset 37137:b960119b9c18
XEmacs compatibility. Doc fix.
(leading-code-private-22): Declare var if it's not declared yet.
(charset-bytes, charset-dimension, charset-id, charset-width)
(find-charset-region, split-char, char-width, chars-in-region)
(forward-point, decompose-composite-char, encode-coding-string)
(coding-system-p, ccl-execute-on-string, define-ccl-program):
Define funs if not defined yet.
(encode-composition-rule, find-composition): Define funs if not
loaded yet.
(ps-mule-prologue): PostScript code fix.
(ps-mule-generate-font): New arg HEADER-P. If it is
non-nil, generate font for the header strings.
(ps-mule-prepare-font): Likewise.
(ps-mule-generate-glyphs): Likewise.
(ps-mule-string-encoding): Likewise.
(ps-mule-header-charsets): New variable.
(ps-mule-encode-header-string): New function.
(ps-mule-header-string-charsets): New function.
(ps-mule-begin-job): Check charsets in the header strings. If there
are non-ASCII and non-Latin1 charsets, prepare fonts for them.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Mon, 02 Apr 2001 10:36:32 +0000 |
parents | 422bd2e720f2 |
children | b582e8e39870 |
files | lisp/ps-mule.el |
diffstat | 1 files changed, 242 insertions(+), 62 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ps-mule.el Mon Apr 02 10:35:44 2001 +0000 +++ b/lisp/ps-mule.el Mon Apr 02 10:36:32 2001 +0000 @@ -1,13 +1,13 @@ ;;; 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. @@ -68,10 +68,10 @@ ;; 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). ;; @@ -90,7 +90,63 @@ ;;; 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 @@ -121,10 +177,10 @@ 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). @@ -141,15 +197,17 @@ :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) @@ -159,24 +217,32 @@ (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. @@ -192,7 +258,7 @@ 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' @@ -343,7 +409,7 @@ 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 @@ -356,7 +422,7 @@ (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 @@ -506,30 +572,42 @@ ;; 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)) @@ -543,21 +621,26 @@ (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)) @@ -616,7 +699,7 @@ 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 @@ -698,7 +781,7 @@ 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. @@ -736,7 +819,7 @@ ;;;###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. @@ -787,7 +870,7 @@ ;;;###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. @@ -876,7 +959,7 @@ (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. @@ -919,8 +1002,8 @@ 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 @@ -1003,7 +1086,7 @@ 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 @@ -1046,16 +1129,17 @@ %%%% 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 @@ -1068,7 +1152,9 @@ (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)) @@ -1166,7 +1252,7 @@ 1 index /BuildGlyph get exec } bind def -%% Bitmap font creater +%% Bitmap font creator %% Common Encoding shared by all bitmap fonts. /EncodingCommon 256 array def @@ -1257,11 +1343,84 @@ (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) @@ -1283,6 +1442,15 @@ (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 @@ -1304,8 +1472,8 @@ (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. @@ -1320,7 +1488,7 @@ (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 @@ -1335,6 +1503,18 @@ (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