Lines Matching +defs:ps +defs:mule +defs:encode +defs:header +defs:string
0 ;;; ps-mule.el --- provide multi-byte character facility to ps-print
10 ;; Keywords: wp, print, PostScript, multibyte, mule
33 ;; About ps-mule
36 ;; This package is used for ps-print to print multi-byte buffer.
38 ;; See also ps-print.el.
44 ;; The variable `ps-multibyte-buffer' specifies the ps-print multi-byte buffer
47 ;; Valid values for `ps-multibyte-buffer' are:
53 ;; `ps-mule-font-info-database-default' differently.
55 ;; `ps-mule-font-info-database-latin' (see
75 ;; `bdf-directory-list' appropriately (see ps-bdf.el
82 ;; the same buffer. See `ps-font-family',
83 ;; `ps-header-font-family' and `ps-font-info-database'.
94 (require 'ps-print)
139 (or (fboundp 'encode-coding-string)
140 (defun encode-coding-string (string coding-system &optional nocopy)
142 string
143 (copy-sequence string))))
146 (or (fboundp 'ccl-execute-on-string)
147 (defun ccl-execute-on-string (ccl-prog status str
153 (or (fboundp 'multibyte-string-p)
154 (defun multibyte-string-p (str)
161 (or (fboundp 'string-make-multibyte)
162 (defalias 'string-make-multibyte 'copy-sequence))
163 (or (fboundp 'encode-char)
164 (defun encode-char (ch ccs)
169 (defcustom ps-multibyte-buffer nil
178 `ps-mule-font-info-database-default' differently.
180 `ps-mule-font-info-database-latin' (see
200 `bdf-directory-list' appropriately (see ps-bdf.el for
207 the same buffer. See `ps-font-family',
208 `ps-header-font-family' and `ps-font-info-database'.
213 :group 'ps-print-font)
215 (defvar ps-mule-font-info-database
233 alternative font names. To use this font, the external library `ps-bdf'
240 `ps-font-info-database' is used. This is useful for Latin-1 characters.
242 ENCODING is a coding system to encode a string of characters of CHARSET into a
243 proper string matching an encoding of the specified font. ENCODING may be a
245 one argument, the string to encode, and it should return an encoded string.
255 See also the variable `ps-font-info-database'.")
257 (defconst ps-mule-font-info-database-latin
260 "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
262 (defcustom ps-mule-font-info-database-default
263 ps-mule-font-info-database-latin
264 "*The default setting to use when `ps-multibyte-buffer' is nil."
266 :group 'ps-print-font)
268 (defconst ps-mule-font-info-database-ps
270 (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1)
271 (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
272 (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
274 (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
275 (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
277 (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
278 (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
280 (normal builtin "Munhwa-Regular-KSC-EUC-H" ps-mule-encode-7bit 2)
281 (bold builtin "Munhwa-Bold-KSC-EUC-H" ps-mule-encode-7bit 2))
283 "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
287 (defconst ps-mule-font-info-database-bdf
312 (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1))
314 (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1))
320 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
322 (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2))
324 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
326 (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2))
328 (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2))
330 (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2))
332 (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2))
338 (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1))
340 (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
346 (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1))
348 (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1))
351 (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1))
353 (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
355 (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
357 (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
359 (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2))
361 (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2))
363 (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2))
365 (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2))
367 (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2))
369 (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2))
371 (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2))
373 (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
375 (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")
376 ps-mule-encode-7bit 2))
377 (mule-unicode-0100-24ff
378 (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
379 (mule-unicode-2500-33ff
380 (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
381 (mule-unicode-e000-ffff
382 (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)))
383 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
390 Using this list as default value to `ps-mule-font-info-database', all
393 See also `ps-mule-font-info-database-ps-bdf'.")
395 (defconst ps-mule-font-info-database-ps-bdf
396 (cons (car ps-mule-font-info-database-latin)
397 (cdr (cdr ps-mule-font-info-database-bdf)))
398 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
403 Using this list as default value to `ps-mule-font-info-database', all
406 by `ps-font-family' and `ps-header-font-family'.
408 See also `ps-mule-font-info-database-bdf'.")
412 (defun ps-mule-encode-7bit (string)
413 (ps-mule-encode-bit string 0))
415 (defun ps-mule-encode-8bit (string)
416 (ps-mule-encode-bit string 128))
418 (defun ps-mule-encode-bit (string delta)
419 (let* ((dim (charset-dimension (char-charset (string-to-char string))))
420 (len (* (length string) dim))
421 (str (make-string len 0))
427 (+ (nth 1 (split-char (aref string i))) delta))
431 (let ((split (split-char (aref string i))))
439 (if (boundp 'mule-version) ; only if mule package is loaded
440 (define-ccl-program ccl-encode-ethio-unicode
449 (call ccl-encode-ethio-font)
456 (defvar ccl-encode-ethio-unicode nil))
458 (if (boundp 'mule-version)
459 ;; bound mule-version
460 (defun ps-mule-encode-ethiopic (string)
461 (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
463 string))
464 ;; unbound mule-version
465 (defun ps-mule-encode-ethiopic (string)
466 string))
468 ;; Special encoding for mule-unicode-* characters.
469 (defun ps-mule-encode-ucs2 (string)
470 (let* ((len (length string))
471 (str (make-string (* 2 len) 0))
476 (setq ch (encode-char (aref string i) 'ucs)
486 (defvar ps-mule-current-charset nil)
488 (defun ps-mule-get-font-spec (charset font-type)
494 FONT-SPEC is extracted from `ps-mule-font-info-database'.
496 See the documentation of `ps-mule-font-info-database' for the meaning of each
498 (let ((slot (cdr (assq charset ps-mule-font-info-database))))
506 (defsubst ps-mule-font-spec-src (font-spec) (car font-spec))
507 (defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec))
508 (defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec))
509 (defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec))
511 (defsubst ps-mule-printable-p (charset)
516 (ps-mule-get-font-spec charset 'normal)))
518 (defconst ps-mule-external-libraries
521 (bdf ps-bdf nil
536 FONT-SRC. Currently, we only have the feature `ps-bdf'.
551 (defun ps-mule-init-external-library (font-spec)
553 See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
554 (let* ((font-src (ps-mule-font-spec-src font-spec))
555 (slot (assq font-src ps-mule-external-libraries)))
562 (ps-output-prologue (funcall func))))
568 (defvar ps-mule-font-cache nil)
570 (defun ps-mule-generate-font (font-spec charset &optional header-p)
573 If optional 3rd arg HEADER-P is non-nil, generate codes to define a header
575 (let* ((font-name (ps-mule-font-spec-name font-spec))
577 (font-cache (assoc font-name ps-mule-font-cache))
578 (font-src (ps-mule-font-spec-src font-spec))
579 (func (nth 4 (assq font-src ps-mule-external-libraries)))
580 (font-size (if header-p (if (eq ps-current-font 0)
581 ps-header-title-font-size-internal
582 ps-header-font-size-internal)
583 ps-font-size-internal))
584 (current-font (+ ps-current-font (if header-p 10 0)))
586 (cond (header-p
587 (format "h%d" ps-current-font))
589 (format "f%d" ps-current-font))
591 (format "f%02x-%d" (charset-id charset) ps-current-font)))))
593 (ps-output-prologue (funcall func charset font-spec)))
594 (ps-output-prologue
597 (if (or header-p
598 (eq ps-mule-current-charset 'ascii))
607 ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
610 (defun ps-mule-generate-glyphs (font-spec code-list)
612 (let* ((font-src (ps-mule-font-spec-src font-spec))
613 (func (nth 5 (assq font-src ps-mule-external-libraries))))
615 (ps-output-prologue
617 (ps-mule-font-spec-bytes font-spec))))))
619 (defun ps-mule-prepare-font (font-spec string charset
620 &optional no-setfont header-p)
629 If optional 5th arg HEADER-P is non-nil, generate a code for setting a header
631 (let* ((font-name (ps-mule-font-spec-name font-spec))
633 (current-font (+ ps-current-font (if header-p 10 0)))
634 (font-cache (assoc font-name ps-mule-font-cache)))
636 (setq font-cache (ps-mule-generate-font font-spec charset header-p)))
639 (or (equal new-font ps-last-font)
641 (ps-output (format "/%s FM\n" new-font))
642 (setq ps-last-font new-font)))))
643 (if (nth 5 (assq (ps-mule-font-spec-src font-spec)
644 ps-mule-external-libraries))
647 (bytes (ps-mule-font-spec-bytes font-spec))
648 (len (length string))
653 (aref string i)
654 (+ (* (aref string i) 256) (aref string (1+ i)))))
661 (ps-mule-generate-glyphs font-spec newcodes))))))
664 (defun ps-mule-prepare-ascii-font (string)
668 (ps-mule-get-font-spec
670 (car (nth ps-current-font (ps-font-alist 'ps-font-for-text))))))
672 (ps-mule-prepare-font font-spec string 'ascii))))
675 (defun ps-mule-set-ascii-font ()
676 (unless (eq ps-mule-current-charset 'ascii)
677 (ps-set-font ps-current-font)
678 (setq ps-mule-current-charset 'ascii)))
683 (defvar ps-mule-charset-list nil)
685 ;; This is a PostScript code inserted in the header of generated PostScript.
686 (defconst ps-mule-prologue
764 (defvar ps-mule-prologue-generated nil)
766 (defun ps-mule-prologue-generated ()
767 (unless ps-mule-prologue-generated
768 (ps-output-prologue ps-mule-prologue)
769 (setq ps-mule-prologue-generated t)))
771 (defun ps-mule-find-wrappoint (from to char-width &optional composition)
780 and TO belong to a charset in `ps-mule-current-charset'. Otherwise,
792 (if (or composition (eq ps-mule-current-charset 'composition))
797 (if (> run-width ps-width-remaining)
798 (cons from ps-width-remaining)
804 (setq char-width (* char-width (charset-width ps-mule-current-charset)))
806 (if (> run-width ps-width-remaining)
811 (truncate (/ ps-width-remaining char-width)))))
812 ps-width-remaining)
816 (defun ps-mule-plot-string (from to &optional bg-color)
830 (setq ps-mule-current-charset
831 (char-charset (or (aref ps-print-translation-table ch) ch))))
832 (let* ((wrappoint (ps-mule-find-wrappoint
833 from to (ps-avg-char-width 'ps-font-for-text)))
835 (font-type (car (nth ps-current-font
836 (ps-font-alist 'ps-font-for-text))))
837 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
838 (string (buffer-substring-no-properties from to)))
839 (dotimes (i (length string))
840 (let ((ch (aref ps-print-translation-table (aref string i))))
842 (aset string i ch))))
850 (ps-output-string (ps-mule-string-encoding font-spec string))
851 (ps-output " S\n"))
853 ((eq ps-mule-current-charset 'latin-iso8859-1)
855 (ps-output-string (ps-mule-string-ascii string))
856 (ps-output " S\n"))
859 ((eq ps-mule-current-charset 'composition)
860 (ps-mule-plot-composition from (1+ from) bg-color))
865 (ps-output (format "%d %d SB\n"
866 (length string)
867 (if (eq ps-mule-current-charset 'composition)
869 (charset-width ps-mule-current-charset))))))
873 (defun ps-mule-plot-composition (from to &optional bg-color)
888 (wrappoint (ps-mule-find-wrappoint
889 from to (ps-avg-char-width 'ps-font-for-text)
892 (font-type (car (nth ps-current-font
893 (ps-font-alist 'ps-font-for-text)))))
897 (ps-mule-plot-components
898 (ps-mule-prepare-font-for-components components font-type)
908 (defun ps-mule-prepare-font-for-components (components font-type)
916 (setq elt (encode-composition-rule elt))
919 (font (or (eq charset ps-mule-current-charset)
921 (format "/f%d" ps-current-font)
923 (charset-id charset) ps-current-font))))
925 (setq ps-mule-current-charset charset
926 str (ps-mule-string-encoding
927 (ps-mule-get-font-spec charset font-type)
928 (char-to-string elt)
931 (setq elt (cons font str) ps-last-font font)
937 (defun ps-mule-plot-components (components tail)
941 (ps-output "[ ")
943 (ps-output-string elt)
944 (ps-output (car elt) " ")
945 (ps-output-string (cdr elt)))
948 (ps-output " ")
950 (ps-output-string elt))
952 (ps-output (car elt) " ")
953 (ps-output-string (cdr elt)))
955 (ps-output (format "%d" elt)))))
956 (ps-output " ] " tail "\n")))
960 (defvar ps-mule-composition-prologue-generated nil)
962 (defconst ps-mule-composition-prologue
1031 } { first { % first string
1096 } { first { % first string
1138 (defun ps-mule-string-ascii (str)
1139 (ps-set-font ps-current-font)
1140 (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
1146 (defun ps-mule-string-encoding (font-spec str &optional no-setfont header-p)
1147 (let ((encoding (ps-mule-font-spec-encoding font-spec)))
1149 (string-as-unibyte
1151 (encode-coding-string str encoding))
1158 (if (ps-mule-font-spec-src font-spec)
1159 (ps-mule-prepare-font font-spec str ps-mule-current-charset
1160 (or no-setfont header-p)
1161 header-p)
1163 (ps-set-font ps-current-font)))
1168 (defvar ps-mule-bitmap-prologue-generated nil)
1170 (defconst ps-mule-bitmap-prologue
1173 /str7 7 string def % working area
1324 (defun ps-mule-generate-bitmap-prologue ()
1325 (unless ps-mule-bitmap-prologue-generated
1326 (setq ps-mule-bitmap-prologue-generated t)
1327 (list ps-mule-bitmap-prologue)))
1329 (defun ps-mule-generate-bitmap-font (&rest args)
1332 (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap)
1341 (defun ps-mule-initialize ()
1343 (setq ps-mule-font-cache nil
1344 ps-mule-prologue-generated nil
1345 ps-mule-composition-prologue-generated nil
1346 ps-mule-bitmap-prologue-generated nil)
1348 ps-mule-external-libraries))
1350 (defvar ps-mule-header-charsets nil)
1353 (defun ps-mule-encode-header-string (string fonttag)
1355 FONTTAG should be a string \"/h0\" or \"/h1\"."
1356 (setq string (cond ((not (stringp string))
1358 ((multibyte-string-p string)
1359 (copy-sequence string))
1361 (string-make-multibyte string))))
1362 (when ps-mule-header-charsets
1363 (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1)
1366 (let ((len (length string))
1369 (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1))
1370 (aset string i ??))
1372 (setq string (encode-coding-string string 'iso-latin-1)))
1375 (let* ((ps-current-font (if (string= fonttag "/h0") 0 1))
1376 (ps-mule-current-charset (car ps-mule-header-charsets))
1377 (font-type (car (nth ps-current-font
1378 (ps-font-alist 'ps-font-for-header))))
1379 (font-spec (ps-mule-get-font-spec ps-mule-current-charset
1382 (/= (charset-dimension ps-mule-current-charset) 1))
1384 ;; header because this kind of charset is not ASCII
1386 (let ((len (length string))
1389 (or (memq (char-charset (aref string i))
1391 (aset string i ??))
1393 (setq string (encode-coding-string string 'iso-latin-1)))
1394 (let ((charsets (list 'ascii (car ps-mule-header-charsets)))
1395 (len (length string))
1398 (or (memq (char-charset (aref string i)) charsets)
1399 (aset string i ??))
1401 (setq string (ps-mule-string-encoding font-spec string nil t))))))
1402 string)
1404 (defun ps-mule-show-warning (charsets from to header-footer-list)
1417 (or (aref ps-print-translation-table (preceding-char))
1433 (insert-text-button (string (car elt))
1449 (let (string-list idx)
1450 (dolist (elt header-footer-list)
1452 (when (string-match "\\cu+" elt)
1456 (while (string-match "\\cu+" elt (match-end 0))
1459 (push elt string-list))))
1460 (when string-list
1462 "These highlighted characters in header/footer can't be printed:\n")
1463 (dolist (elt string-list)
1467 (defun ps-mule-begin-job (from to)
1470 (setq ps-mule-charset-list nil
1471 ps-mule-header-charsets nil
1472 ps-mule-font-info-database
1473 (cond ((eq ps-multibyte-buffer 'non-latin-printer)
1474 ps-mule-font-info-database-ps)
1475 ((eq ps-multibyte-buffer 'bdf-font)
1476 ps-mule-font-info-database-bdf)
1477 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
1478 ps-mule-font-info-database-ps-bdf)
1480 ps-mule-font-info-database-default)))
1483 ;; Initialize `ps-mule-charset-list'. If some characters aren't
1485 (let ((header-footer-list (ps-header-footer-string))
1487 (setq ps-mule-charset-list
1491 from to ps-print-translation-table))))
1492 ps-mule-header-charsets
1495 (find-charset-string
1497 'identity header-footer-list "")
1498 ps-print-translation-table)))))
1499 (dolist (cs ps-mule-charset-list)
1500 (or (ps-mule-printable-p cs)
1502 (dolist (cs ps-mule-header-charsets)
1503 (or (ps-mule-printable-p cs)
1507 (ps-mule-show-warning unprintable-charsets from to
1508 header-footer-list)
1513 (or ps-mule-composition-prologue-generated
1517 (while header-footer-list
1518 (setq str (car header-footer-list))
1522 header-footer-list nil)
1523 (setq header-footer-list (cdr header-footer-list))))))
1526 (ps-mule-prologue-generated)
1527 (ps-output-prologue ps-mule-composition-prologue)
1528 (setq ps-mule-composition-prologue-generated t)))))))
1530 (setq ps-mule-current-charset 'ascii)
1532 (if (or ps-mule-charset-list ps-mule-header-charsets)
1533 (dolist (elt (append ps-mule-header-charsets ps-mule-charset-list))
1534 (ps-mule-prologue-generated)
1535 (ps-mule-init-external-library (ps-mule-get-font-spec elt 'normal))))
1537 ;; If ASCII font is also specified in ps-mule-font-info-database,
1538 ;; use it instead of what specified in ps-font-info-database.
1539 (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
1542 (ps-mule-prologue-generated)
1543 (ps-mule-init-external-library font-spec)
1544 (let ((font (ps-font-alist 'ps-font-for-text))
1545 (ps-current-font 0))
1548 (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii (car font))
1551 ps-current-font (1+ ps-current-font)))))))
1553 ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font
1555 (if (and ps-mule-header-charsets
1556 (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1))
1557 (= (charset-dimension (car ps-mule-header-charsets)) 1))
1558 (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets)
1563 (let ((ps-current-font 0))
1564 (ps-mule-prepare-font font-spec "0123456789/" 'ascii t t)))))
1566 (if ps-mule-charset-list
1568 (setq ps-control-or-escape-regexp
1569 (cond ((eq ps-print-control-characters '8-bit)
1571 ((eq ps-print-control-characters 'control-8-bit)
1572 (string-as-multibyte "[^\040-\176\240-\377]"))
1573 ((eq ps-print-control-characters 'control)
1574 (string-as-multibyte "[^\040-\176\200-\377]"))
1575 (t (string-as-multibyte "[^\000-\011\013\015-\377]"))))))
1578 (defun ps-mule-begin-page ()
1579 (setq ps-mule-current-charset 'ascii))
1582 (provide 'ps-mule)
1585 ;;; ps-mule.el ends here