Mercurial > emacs

comparison lisp/ps-print.el @ 23892:f05e983b8486

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(ps-mule-font-info-database): Doc-string modified. (ps-mule-external-libraries): New element FEATURE. (ps-mule-init-external-library): Ajusted for the above change. (ps-mule-generate-font): Likewise. (ps-mule-generate-glyphs): Likewise. (ps-mule-prepare-font): Likewise. (ps-mule-initialize): Likewise. (ps-begin-file): Superfluous tailing parenthesis deleted. Mule related code moved to ps-mule.el. (ps-begin-job): While setting ps-control-or-escape-regexp, don't check ps-mule-charset-list. (ps-begin-page): Don't set ps-mule-current-charset, instead call ps-mule-begin-page. (ps-basic-plot-string): Call ps-mule-prepare-ascii-font. (ps-plot-region): Don't set ps-mule-current-charset, instead call ps-mule-set-ascii-font. Don't call ps-mule-skip-same-charset, instead skip same charsets by itself. (ps-generate): Call ps-mule-initialize of needs-begin-file is non-nil. Call ps-mule-begin-job. (ps-print-version): New version number (4.1.2), doc fix and mule related code extraction. Autoload ps-mule funs. Define several functions for Emacs 20.2 and the earlier version. (ps-printer-name): Check if printer-name is bound.
author Kenichi Handa <handa@m17n.org>
date Tue, 15 Dec 1998 06:31:48 +0000
parents 422bd4826b2c
children b339f3a7c728
comparison
equal deleted inserted replaced
23891:db21a8833d0f 23892:f05e983b8486
7 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> 7 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
8 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) 8 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
9 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) 9 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> 10 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
11 ;; Keywords: print, PostScript 11 ;; Keywords: print, PostScript
12 ;; Time-stamp: <98/10/13 15:42:23 vinicius> 12 ;; Time-stamp: <98/11/13 9:32:27 vinicius>
13 ;; Version: 4.1.1 13 ;; Version: 4.1.2
14 14
15 (defconst ps-print-version "4.1.1" 15 (defconst ps-print-version "4.1.2"
16 "ps-print.el, v 4.1.1 <98/10/13 vinicius> 16 "ps-print.el, v 4.1.2 <98/11/13 vinicius>
17 17
18 Vinicius's last change version -- this file may have been edited as part of 18 Vinicius's last change version -- this file may have been edited as part of
19 Emacs without changes to the version number. When reporting bugs, 19 Emacs without changes to the version number. When reporting bugs,
20 please also report the version of Emacs, if any, that ps-print was 20 please also report the version of Emacs, if any, that ps-print was
21 distributed with. 21 distributed with.
438 ;; 438 ;;
439 ;; 439 ;;
440 ;; Printing Multi-byte Buffer 440 ;; Printing Multi-byte Buffer
441 ;; -------------------------- 441 ;; --------------------------
442 ;; 442 ;;
443 ;; The variable `ps-multibyte-buffer' specifies the ps-print multi-byte buffer 443 ;; See ps-mule.el for documentation.
444 ;; handling.
445 ;;
446 ;; Valid values for `ps-multibyte-buffer' are:
447 ;;
448 ;; nil This is the value to use when you are printing
449 ;; buffer with only ASCII and Latin characters.
450 ;;
451 ;; `non-latin-printer' This is the value to use when you have a japanese
452 ;; or korean PostScript printer and want to print
453 ;; buffer with ASCII, Latin-1, Japanese (JISX0208 and
454 ;; JISX0201-Kana) and Korean characters. At present,
455 ;; it was not tested the Korean characters printing.
456 ;; If you have a korean PostScript printer, please,
457 ;; test it.
458 ;;
459 ;; `bdf-font' This is the value to use when you want to print
460 ;; buffer with BDF fonts. BDF fonts include both latin
461 ;; and non-latin fonts. BDF (Bitmap Distribution
462 ;; Format) is a format used for distributing X's font
463 ;; source file. BDF fonts are included in
464 ;; `intlfonts-1.1' which is a collection of X11 fonts
465 ;; for all characters supported by Emacs. In order to
466 ;; use this value, be sure to have installed
467 ;; `intlfonts-1.1' and set the variable
468 ;; `bdf-directory-list' appropriately (see bdf.el for
469 ;; documentation of this variable).
470 ;;
471 ;; `bdf-font-except-latin' This is like `bdf-font' except that it is used
472 ;; PostScript default fonts to print ASCII and Latin-1
473 ;; characters. This is convenient when you want or
474 ;; need to use both latin and non-latin characters on
475 ;; the same buffer. See `ps-font-family',
476 ;; `ps-header-font-family' and `ps-font-info-database'.
477 ;;
478 ;; Any other value is treated as nil.
479 ;;
480 ;; The default is nil.
481 ;; 444 ;;
482 ;; 445 ;;
483 ;; Line Number 446 ;; Line Number
484 ;; ----------- 447 ;; -----------
485 ;; 448 ;;
973 ;;; Code: 936 ;;; Code:
974 937
975 (unless (featurep 'lisp-float-type) 938 (unless (featurep 'lisp-float-type)
976 (error "`ps-print' requires floating point support")) 939 (error "`ps-print' requires floating point support"))
977 940
941 ;; For Emacs 20.2 and the earlier version.
942 (eval-and-compile
943 (and (string< mule-version "4.0")
944 (progn
945 (defun set-buffer-multibyte (arg)
946 (setq enable-multibyte-characters arg))
947 (defun string-as-unibyte (arg) arg)
948 (defun string-as-multibyte (arg) arg)
949 (defun charset-after (&optional arg)
950 (char-charset (char-after arg))))))
951
978 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 952 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
979 ;; User Variables: 953 ;; User Variables:
980 954
981 ;;; Interface to the command system 955 ;;; Interface to the command system
982 956
1021 :tag "PS Faces" 995 :tag "PS Faces"
1022 :group 'ps-print 996 :group 'ps-print
1023 :group 'faces) 997 :group 'faces)
1024 998
1025 999
1026 (defcustom ps-multibyte-buffer nil
1027 "*Specifies the multi-byte buffer handling.
1028
1029 Valid values are:
1030
1031 nil This is the value to use when you are printing
1032 buffer with only ASCII and Latin characters.
1033
1034 `non-latin-printer' This is the value to use when you have a japanese
1035 or korean PostScript printer and want to print
1036 buffer with ASCII, Latin-1, Japanese (JISX0208 and
1037 JISX0201-Kana) and Korean characters. At present,
1038 it was not tested the Korean characters printing.
1039 If you have a korean PostScript printer, please,
1040 test it.
1041
1042 `bdf-font' This is the value to use when you want to print
1043 buffer with BDF fonts. BDF fonts include both latin
1044 and non-latin fonts. BDF (Bitmap Distribution
1045 Format) is a format used for distributing X's font
1046 source file. BDF fonts are included in
1047 `intlfonts-1.1' which is a collection of X11 fonts
1048 for all characters supported by Emacs. In order to
1049 use this value, be sure to have installed
1050 `intlfonts-1.1' and set the variable
1051 `bdf-directory-list' appropriately (see bdf.el for
1052 documentation of this variable).
1053
1054 `bdf-font-except-latin' This is like `bdf-font' except that it is used
1055 PostScript default fonts to print ASCII and Latin-1
1056 characters. This is convenient when you want or
1057 need to use both latin and non-latin characters on
1058 the same buffer. See `ps-font-family',
1059 `ps-header-font-family' and `ps-font-info-database'.
1060
1061 Any other value is treated as nil."
1062 :type '(choice (const non-latin-printer) (const bdf-font)
1063 (const bdf-font-except-latin) (other :tag "nil" nil))
1064 :group 'ps-print-font)
1065
1066 (defcustom ps-print-prologue-header nil 1000 (defcustom ps-print-prologue-header nil
1067 "*PostScript prologue header comments besides that ps-print generates. 1001 "*PostScript prologue header comments besides that ps-print generates.
1068 1002
1069 `ps-print-prologue-header' may be a string or a symbol function which 1003 `ps-print-prologue-header' may be a string or a symbol function which
1070 returns a string. Note that this string is inserted on PostScript prologue 1004 returns a string. Note that this string is inserted on PostScript prologue
1088 Adobe Systems Incorporated 1022 Adobe Systems Incorporated
1089 Appendix G: Document Structuring Conventions -- Version 3.0" 1023 Appendix G: Document Structuring Conventions -- Version 3.0"
1090 :type '(choice string symbol (other :tag "nil" nil)) 1024 :type '(choice string symbol (other :tag "nil" nil))
1091 :group 'ps-print) 1025 :group 'ps-print)
1092 1026
1093 (defcustom ps-printer-name printer-name 1027 (defcustom ps-printer-name (and (boundp 'printer-name)
1028 printer-name)
1094 "*The name of a local printer for printing PostScript files. 1029 "*The name of a local printer for printing PostScript files.
1095 1030
1096 On Unix-like systems, a string value should be a name understood by 1031 On Unix-like systems, a string value should be a name understood by
1097 lpr's -P option; otherwise the value should be nil. 1032 lpr's -P option; otherwise the value should be nil.
1098 1033
1826 1761
1827 Interactively, when you use a prefix argument (C-u), the command 1762 Interactively, when you use a prefix argument (C-u), the command
1828 prompts the user for a file name, and saves the spooled PostScript 1763 prompts the user for a file name, and saves the spooled PostScript
1829 image in that file instead of sending it to the printer. 1764 image in that file instead of sending it to the printer.
1830 1765
1831 More specifically, the FILENAME argument is treated as follows: if it 1766 Noninteractively, the argument FILENAME is treated as follows: if it
1832 is nil, send the image to the printer. If FILENAME is a string, save 1767 is nil, send the image to the printer. If FILENAME is a string, save
1833 the PostScript image in a file with that name." 1768 the PostScript image in a file with that name."
1834 (interactive (list (ps-print-preprint current-prefix-arg))) 1769 (interactive (list (ps-print-preprint current-prefix-arg)))
1835 (ps-do-despool filename)) 1770 (ps-do-despool filename))
1836 1771
1928 ps-print-only-one-header 1863 ps-print-only-one-header
1929 ps-print-header-frame 1864 ps-print-header-frame
1930 ps-header-lines 1865 ps-header-lines
1931 ps-show-n-of-n 1866 ps-show-n-of-n
1932 ps-spool-duplex 1867 ps-spool-duplex
1933 (ps-print-quote ps-multibyte-buffer) 1868 (ps-print-quote ps-multibyte-buffer) ; see `ps-mule.el'
1934 (ps-print-quote ps-font-family) 1869 (ps-print-quote ps-font-family)
1935 ps-font-size 1870 ps-font-size
1936 (ps-print-quote ps-header-font-family) 1871 (ps-print-quote ps-header-font-family)
1937 ps-header-font-size 1872 ps-header-font-size
1938 ps-header-title-font-size)) 1873 ps-header-title-font-size))
2365 /BeginDoc { 2300 /BeginDoc {
2366 % ---- Remember space width of the normal text font `f0'. 2301 % ---- Remember space width of the normal text font `f0'.
2367 /SpaceWidth /f0 findfont setfont ( ) stringwidth pop def 2302 /SpaceWidth /f0 findfont setfont ( ) stringwidth pop def
2368 % ---- save the state of the document (useful for ghostscript!) 2303 % ---- save the state of the document (useful for ghostscript!)
2369 /docState save def 2304 /docState save def
2305 % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
2370 /JackGhostscript where {pop 1 27.7 29.7 div scale}if 2306 /JackGhostscript where {pop 1 27.7 29.7 div scale}if
2371 % ---- [andrewi] set PageSize based on chosen dimensions 2307 % ---- [andrewi] set PageSize based on chosen dimensions
2372 /setpagedevice where { 2308 /setpagedevice where {
2373 pop 2309 pop
2374 1 dict dup 2310 1 dict dup
2939 "The average width, in points, of a character, for generating PostScript. 2875 "The average width, in points, of a character, for generating PostScript.
2940 This is the value that ps-print uses to determine the length, 2876 This is the value that ps-print uses to determine the length,
2941 x-dimension, of the text it has printed, and thus affects the point at 2877 x-dimension, of the text it has printed, and thus affects the point at
2942 which long lines wrap around." 2878 which long lines wrap around."
2943 (get font-sym 'avg-char-width)) 2879 (get font-sym 'avg-char-width))
2944
2945
2946 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2947 ;; For handling multi-byte characters -- Begin.
2948 ;;
2949 ;; The following comments apply only to this part (through the next ^L).
2950 ;; Author: Kenichi Handa <handa@etl.go.jp>
2951 ;; Maintainer: Kenichi Handa <handa@etl.go.jp>
2952
2953 (eval-and-compile
2954 (if (not (string< mule-version "4.0"))
2955 (progn
2956 (defalias 'ps-mule-next-point '1+)
2957 (defalias 'ps-mule-chars-in-string 'length)
2958 (defalias 'ps-mule-string-char 'aref)
2959 (defsubst ps-mule-next-index (str i) (1+ i)))
2960 (defun set-buffer-multibyte (arg)
2961 (setq enable-multibyte-characters arg))
2962 (defun string-as-unibyte (arg) arg)
2963 (defun string-as-multibyte (arg) arg)
2964 (defun charset-after (&optional arg)
2965 (char-charset (char-after arg)))
2966 (defun ps-mule-next-point (arg)
2967 (save-excursion (goto-char arg) (forward-char 1) (point)))
2968 (defun ps-mule-chars-in-string (string)
2969 (length string))
2970 (defalias 'ps-mule-string-char 'aref)
2971 (defun ps-mule-next-index (str i)
2972 (1+ i)))
2973 )
2974
2975 (defvar ps-mule-font-info-database
2976 nil
2977 "Alist of charsets with the corresponding font information.
2978 Each element has the form:
2979
2980 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...)
2981
2982 Where
2983
2984 CHARSET is a charset (symbol) for this font family,
2985
2986 FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
2987
2988 FONT-SRC is a font source: builtin, bdf, vflib, or nil.
2989
2990 If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name.
2991
2992 If FONT-SRC is bdf, FONT-NAME is a BDF font file name. To use this font,
2993 the external library `bdf' is required.
2994
2995 If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows.
2996 To use this font, the external library `vflib' is required.
2997
2998 If FONT-SRC is nil, a proper ASCII font in the variable
2999 `ps-font-info-database' is used. This is useful for Latin-1 characters.
3000
3001 ENCODING is a coding system to encode a string of characters of CHARSET into a
3002 proper string matching an encoding of the specified font. ENCODING may be a
3003 function that does this encoding. In this case, the function is called with
3004 one argument, the string to encode, and it should return an encoded string.
3005
3006 BYTES specifies how many bytes each character has in the encoded byte
3007 sequence; it should be 1 or 2.
3008
3009 All multi-byte characters are printed by fonts specified in this database
3010 regardless of a font family of ASCII characters. The exception is Latin-1
3011 characters which are printed by the same font as ASCII characters, thus obey
3012 font family.
3013
3014 See also the variable `ps-font-info-database'.")
3015
3016 (defconst ps-mule-font-info-database-latin
3017 '((latin-iso8859-1
3018 (normal nil nil iso-latin-1)))
3019 "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
3020
3021 (defconst ps-mule-font-info-database-ps
3022 '((katakana-jisx0201
3023 (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1)
3024 (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
3025 (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
3026 (latin-jisx0201
3027 (normat builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
3028 (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
3029 (japanese-jisx0208
3030 (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
3031 (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
3032 (korean-ksc5601
3033 (normal builtin "Batang-Medium-KSC-H" ps-mule-encode-7bit 2)
3034 (bold builtin " Gulim-Medium-KSC-H" ps-mule-encode-7bit 2))
3035 )
3036 "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
3037
3038 Currently, data for Japanese and Korean PostScript printers are listed.")
3039
3040 (defconst ps-mule-font-info-database-bdf
3041 '((ascii
3042 (normal bdf "etl24-latin1.bdf" nil 1)
3043 (bold bdf "etl16b-latin1.bdf" iso-latin-1 1)
3044 (italic bdf "etl16i-latin1.bdf" iso-latin-1 1)
3045 (bold-italic bdf "etl16bi-latin1.bdf" iso-latin-1 1))
3046 (latin-iso8859-1
3047 (normal bdf "etl24-latin1.bdf" iso-latin-1 1)
3048 (bold bdf "etl16b-latin1.bdf" iso-latin-1 1)
3049 (italic bdf "etl16i-latin1.bdf" iso-latin-1 1)
3050 (bold-italic bdf "etl16bi-latin1.bdf" iso-latin-1 1))
3051 (latin-iso8859-2
3052 (normal bdf "etl24-latin2.bdf" iso-latin-2 1))
3053 (latin-iso8859-3
3054 (normal bdf "etl24-latin3.bdf" iso-latin-3 1))
3055 (latin-iso8859-4
3056 (normal bdf "etl24-latin4.bdf" iso-latin-4 1))
3057 (thai-tis620
3058 (normal bdf "thai-24.bdf" thai-tis620 1))
3059 (greek-iso8859-7
3060 (normal bdf "etl24-greek.bdf" greek-iso-8bit 1))
3061 ;; (arabic-iso8859-6 nil) ; not yet available
3062 (hebrew-iso8859-8
3063 (normal bdf "etl24-hebrew.bdf" hebrew-iso-8bit 1))
3064 (katakana-jisx0201
3065 (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1))
3066 (latin-jisx0201
3067 (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1))
3068 (cyrillic-iso8859-5
3069 (normal bdf "etl24-cyrillic.bdf" cyrillic-iso-8bit 1))
3070 (latin-iso8859-9
3071 (normal bdf "etl24-latin5.bdf" iso-latin-5 1))
3072 (japanese-jisx0208-1978
3073 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
3074 (chinese-gb2312
3075 (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2))
3076 (japanese-jisx0208
3077 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
3078 (korean-ksc5601
3079 (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2))
3080 (japanese-jisx0212
3081 (normal bdf "jisksp40.bdf" ps-mule-encode-7bit 2))
3082 (chinese-cns11643-1
3083 (normal bdf "cns-1-40.bdf" ps-mule-encode-7bit 2))
3084 (chinese-cns11643-2
3085 (normal bdf "cns-2-40.bdf" ps-mule-encode-7bit 2))
3086 (chinese-big5-1
3087 (normal bdf "taipei24.bdf" chinese-big5 2))
3088 (chinese-big5-2
3089 (normal bdf "taipei24.bdf" chinese-big5 2))
3090 (chinese-sisheng
3091 (normal bdf "etl24-sisheng.bdf" ps-mule-encode-8bit 1))
3092 (ipa
3093 (normal bdf "etl24-ipa.bdf" ps-mule-encode-8bit 1))
3094 (vietnamese-viscii-lower
3095 (normal bdf "etl24-viscii.bdf" vietnamese-viscii 1))
3096 (vietnamese-viscii-upper
3097 (normal bdf "etl24-viscii.bdf" vietnamese-viscii 1))
3098 (arabic-digit
3099 (normal bdf "etl24-arabic0.bdf" ps-mule-encode-7bit 1))
3100 (arabic-1-column
3101 (normal bdf "etl24-arabic1.bdf" ps-mule-encode-7bit 1))
3102 ;; (ascii-right-to-left nil) ; not yet available
3103 (lao
3104 (normal bdf "mule-lao-24.bdf" lao 1))
3105 (arabic-2-column
3106 (normal bdf "etl24-arabic2.bdf" ps-mule-encode-7bit 1))
3107 (indian-is13194
3108 (normal bdf "mule-iscii-24.bdf" ps-mule-encode-7bit 1))
3109 (indian-1-column
3110 (normal bdf "mule-indian-1col-24.bdf" ps-mule-encode-7bit 2))
3111 (tibetan-1-column
3112 (normal bdf "mule-tibmdx-1col-24.bdf" ps-mule-encode-7bit 2))
3113 (ethiopic
3114 (normal bdf "ethiomx24f-uni.bdf" ps-mule-encode-ethiopic 2))
3115 (chinese-cns11643-3
3116 (normal bdf "cns-3-40.bdf" ps-mule-encode-7bit 2))
3117 (chinese-cns11643-4
3118 (normal bdf "cns-4-40.bdf" ps-mule-encode-7bit 2))
3119 (chinese-cns11643-5
3120 (normal bdf "cns-5-40.bdf" ps-mule-encode-7bit 2))
3121 (chinese-cns11643-6
3122 (normal bdf "cns-6-40.bdf" ps-mule-encode-7bit 2))
3123 (chinese-cns11643-7
3124 (normal bdf "cns-7-40.bdf" ps-mule-encode-7bit 2))
3125 (indian-2-column
3126 (normal bdf "mule-indian-24.bdf" ps-mule-encode-7bit 2))
3127 (tibetan
3128 (normal bdf "mule-tibmdx-24.bdf" ps-mule-encode-7bit 2)))
3129 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
3130 BDF (Bitmap Distribution Format) is a format used for distributing X's font
3131 source file.
3132
3133 Current default value list for BDF fonts is included in `intlfonts-1.1' which is
3134 a collection of X11 fonts for all characters supported by Emacs.
3135
3136 Using this list as default value to `ps-mule-font-info-database', all characters
3137 including ASCII and Latin-1 are printed by BDF fonts.
3138
3139 See also `ps-mule-font-info-database-ps-bdf'.")
3140
3141 (defconst ps-mule-font-info-database-ps-bdf
3142 (cons (car ps-mule-font-info-database-latin)
3143 (cdr (cdr ps-mule-font-info-database-bdf)))
3144 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
3145
3146 Current default value list for BDF fonts is included in `intlfonts-1.1' which is
3147 a collection of X11 fonts for all characters supported by Emacs.
3148
3149 Using this list as default value to `ps-mule-font-info-database', all characters
3150 except ASCII and Latin-1 characters are printed by BDF fonts. ASCII and Latin-1
3151 characters are printed by PostScript font specified by `ps-font-family' and
3152 `ps-header-font-family'.
3153
3154 See also `ps-mule-font-info-database-bdf'.")
3155
3156 ;; Two typical encoding functions for PostScript fonts.
3157
3158 (defun ps-mule-encode-7bit (string)
3159 (ps-mule-encode-bit string 0))
3160
3161 (defun ps-mule-encode-8bit (string)
3162 (ps-mule-encode-bit string 128))
3163
3164 (defun ps-mule-encode-bit (string delta)
3165 (let* ((dim (charset-dimension (char-charset (ps-mule-string-char string 0))))
3166 (len (* (ps-mule-chars-in-string string) dim))
3167 (str (make-string len 0))
3168 (i 0)
3169 (j 0))
3170 (if (= dim 1)
3171 (while (< j len)
3172 (aset str j
3173 (+ (nth 1 (split-char (ps-mule-string-char string i))) delta))
3174 (setq i (ps-mule-next-index string i)
3175 j (1+ j)))
3176 (while (< j len)
3177 (let ((split (split-char (ps-mule-string-char string i))))
3178 (aset str j (+ (nth 1 split) delta))
3179 (aset str (1+ j) (+ (nth 2 split) delta))
3180 (setq i (ps-mule-next-index string i)
3181 j (+ j 2)))))
3182 str))
3183
3184 ;; Special encoding function for Ethiopic.
3185 (define-ccl-program ccl-encode-ethio-unicode
3186 `(1
3187 ((read r2)
3188 (loop
3189 (if (r2 == ,leading-code-private-22)
3190 ((read r0)
3191 (if (r0 == ,(charset-id 'ethiopic))
3192 ((read r1 r2)
3193 (r1 &= 127) (r2 &= 127)
3194 (call ccl-encode-ethio-font)
3195 (write r1)
3196 (write-read-repeat r2))
3197 ((write r2 r0)
3198 (repeat))))
3199 (write-read-repeat r2))))))
3200
3201 (defun ps-mule-encode-ethiopic (string)
3202 (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
3203 (make-vector 9 nil)
3204 string))
3205
3206 ;; A charset which we are now processing.
3207 (defvar ps-mule-current-charset nil)
3208
3209 (defun ps-mule-get-font-spec (charset font-type)
3210 "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE.
3211 FONT-SPEC is a list that has the form:
3212
3213 (FONT-SRC FONT-NAME ENCODING BYTES)
3214
3215 FONT-SPEC is extracted from `ps-mule-font-info-database'.
3216
3217 See the documentation of `ps-mule-font-info-database' for the meaning of each
3218 element of the list."
3219 (let ((slot (cdr (assq charset ps-mule-font-info-database))))
3220 (and slot
3221 (cdr (or (assq font-type slot)
3222 (and (eq font-type 'bold-italic)
3223 (or (assq 'bold slot) (assq 'italic slot)))
3224 (assq 'normal slot))))))
3225
3226 ;; Functions to access each element of FONT-SPEC.
3227 (defsubst ps-mule-font-spec-src (font-spec) (car font-spec))
3228 (defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec))
3229 (defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec))
3230 (defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec))
3231
3232 (defsubst ps-mule-printable-p (charset)
3233 "Non-nil if characters in CHARSET is printable."
3234 (ps-mule-get-font-spec charset 'normal))
3235
3236 (defconst ps-mule-external-libraries
3237 '((builtin nil
3238 nil nil nil)
3239 (bdf nil
3240 bdf-generate-prologue bdf-generate-font bdf-generate-glyphs)
3241 (pcf nil
3242 pcf-generate-prologue pcf-generate-font pcf-generate-glyphs)
3243 (vflib nil
3244 vflib-generate-prologue vflib-generate-font vflib-generate-glyphs))
3245 "Alist of information of external libraries to support PostScript printing.
3246 Each element has the form:
3247
3248 (FONT-SRC INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC)
3249
3250 FONT-SRC is the font source: builtin, bdf, pcf, or vflib. Except for `builtin',
3251 libraries must have the same name as indicated by FONT-SRC. Currently, we only
3252 have the `bdf' library.
3253
3254 INITIALIZED-P indicates if this library is initialized or not.
3255
3256 PROLOGUE-FUNC is a function to generate PostScript code which define several
3257 PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is
3258 called with no argument, and should return a list of strings.
3259
3260 FONT-FUNC is a function to generate PostScript code which define a new font. It
3261 is called with one argument FONT-SPEC, and should return a list of strings.
3262
3263 GLYPHS-FUNC is a function to generate PostScript code which define glyphs of
3264 characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES,
3265 and should return a list of strings.")
3266
3267 (defun ps-mule-init-external-library (font-spec)
3268 "Initialize external library specified by FONT-SPEC for PostScript printing.
3269 See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
3270 (let* ((font-src (ps-mule-font-spec-src font-spec))
3271 (slot (assq font-src ps-mule-external-libraries)))
3272 (or (not font-src)
3273 (nth 1 slot)
3274 (let ((func (nth 2 slot)))
3275 (if func
3276 (progn
3277 (or (featurep font-src) (require font-src))
3278 (ps-output-prologue (funcall func))))
3279 (setcar (cdr slot) t)))))
3280
3281 ;; Cached glyph information of fonts, alist of:
3282 ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...)
3283 ;; cache CODE0 CODE1 ...)
3284 (defvar ps-mule-font-cache nil)
3285
3286 (defun ps-mule-generate-font (font-spec charset)
3287 "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET."
3288 (let* ((font-cache (assoc (ps-mule-font-spec-name font-spec)
3289 ps-mule-font-cache))
3290 (font-src (ps-mule-font-spec-src font-spec))
3291 (font-name (ps-mule-font-spec-name font-spec))
3292 (func (nth 3 (assq font-src ps-mule-external-libraries)))
3293 (scaled-font-name
3294 (if (eq charset 'ascii)
3295 (format "f%d" ps-current-font)
3296 (format "f%02x-%d"
3297 (charset-id charset) ps-current-font))))
3298 (and func (not font-cache)
3299 (ps-output-prologue (funcall func charset font-spec)))
3300 (ps-output-prologue
3301 (list (format "/%s %f /%s Def%sFontMule\n"
3302 scaled-font-name ps-font-size font-name
3303 (if (eq ps-mule-current-charset 'ascii) "Ascii" ""))))
3304 (if font-cache
3305 (setcar (cdr font-cache)
3306 (cons (cons ps-current-font scaled-font-name)
3307 (nth 1 font-cache)))
3308 (setq font-cache (list font-name
3309 (list (cons ps-current-font scaled-font-name))
3310 'cache)
3311 ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
3312 font-cache))
3313
3314 (defun ps-mule-generate-glyphs (font-spec code-list)
3315 "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC."
3316 (let* ((font-src (ps-mule-font-spec-src font-spec))
3317 (func (nth 4 (assq font-src ps-mule-external-libraries))))
3318 (and func
3319 (ps-output-prologue
3320 (funcall func font-spec code-list
3321 (ps-mule-font-spec-bytes font-spec))))))
3322
3323 (defvar ps-last-font nil)
3324
3325 (defun ps-mule-prepare-font (font-spec string charset &optional no-setfont)
3326 "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
3327
3328 The generated code is inserted on prologue part except the code that sets the
3329 current font (using PostScript procedure `FM').
3330
3331 If optional arg NO-SETFONT is non-nil, don't generate the code for setting the
3332 current font."
3333 (let ((font-cache (assoc (ps-mule-font-spec-name font-spec)
3334 ps-mule-font-cache)))
3335 (or (and font-cache (assq ps-current-font (nth 1 font-cache)))
3336 (setq font-cache (ps-mule-generate-font font-spec charset)))
3337 (or no-setfont
3338 (let ((new-font (cdr (assq ps-current-font (nth 1 font-cache)))))
3339 (or (equal new-font ps-last-font)
3340 (progn
3341 (ps-output (format "/%s FM\n" new-font))
3342 (setq ps-last-font new-font)))))
3343 (if (nth 4 (assq (ps-mule-font-spec-src font-spec)
3344 ps-mule-external-libraries))
3345 ;; We have to generate PostScript codes which define glyphs.
3346 (let* ((cached-codes (nthcdr 2 font-cache))
3347 (newcodes nil)
3348 (bytes (ps-mule-font-spec-bytes font-spec))
3349 (len (length string))
3350 (i 0)
3351 code)
3352 (while (< i len)
3353 (setq code (if (= bytes 1)
3354 (aref string i)
3355 (+ (* (aref string i) 256) (aref string (1+ i)))))
3356 (or (memq code cached-codes)
3357 (progn
3358 (setq newcodes (cons code newcodes))
3359 (setcdr cached-codes (cons code (cdr cached-codes)))))
3360 (setq i (+ i bytes)))
3361 (and newcodes
3362 (ps-mule-generate-glyphs font-spec newcodes))))))
3363
3364 ;; List of charsets of multi-byte characters in a text being printed.
3365 ;; If the text doesn't contain any multi-byte characters (i.e. only
3366 ;; ASCII), the value is nil.
3367 (defvar ps-mule-charset-list nil)
3368
3369 (defvar ps-mule-prologue-generated nil)
3370
3371 ;; This is a PostScript code inserted in the header of generated PostScript.
3372 (defconst ps-mule-prologue
3373 "%%%% Start of Mule Section
3374
3375 %% Working dictionary for general use.
3376 /MuleDict 10 dict def
3377
3378 %% Define already scaled font for non-ASCII character sets.
3379 /DefFontMule { % fontname size basefont |- --
3380 findfont exch scalefont definefont pop
3381 } bind def
3382
3383 %% Define already scaled font for ASCII character sets.
3384 /DefAsciiFontMule { % fontname size basefont |-
3385 MuleDict begin
3386 findfont dup /Encoding get /ISOLatin1Encoding exch def
3387 exch scalefont reencodeFontISO
3388 end
3389 } def
3390
3391 %% Set the specified non-ASCII font to use. It doesn't install
3392 %% Ascent, etc.
3393 /FM { % fontname |- --
3394 findfont setfont
3395 } bind def
3396
3397 %% Show vacant box for characters which don't have appropriate font.
3398 /SB { % count column |- --
3399 SpaceWidth mul /w exch def
3400 1 exch 1 exch { %for
3401 pop
3402 gsave
3403 0 setlinewidth
3404 0 Descent rmoveto w 0 rlineto
3405 0 LineHeight rlineto w neg 0 rlineto closepath stroke
3406 grestore
3407 w 0 rmoveto
3408 } for
3409 } bind def
3410
3411 %% Flag to tell if we are now handling a composite character. This is
3412 %% defined here because both composite character handler and bitmap font
3413 %% handler require it.
3414 /Cmpchar false def
3415
3416 %%%% End of Mule Section
3417
3418 "
3419 "PostScript code for printing multi-byte characters.")
3420
3421 (defun ps-mule-skip-same-charset (charset)
3422 "Skip characters of CHARSET following the current point."
3423 (while (eq (charset-after) charset)
3424 (forward-char 1)))
3425
3426 (defun ps-mule-find-wrappoint (from to char-width)
3427 "Find the longest sequence which is printable in the current line.
3428
3429 The search starts at FROM and goes until TO. It is assumed that all characters
3430 between FROM and TO belong to a charset in `ps-mule-current-charset'.
3431
3432 CHAR-WIDTH is the average width of ASCII characters in the current font.
3433
3434 Returns the value:
3435
3436 (ENDPOS . RUN-WIDTH)
3437
3438 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
3439 the sequence."
3440 (let (run-width)
3441 (if (eq ps-mule-current-charset 'composition)
3442 ;; We must draw one char by one.
3443 (let ((ch (char-after from)))
3444 (setq run-width (* (char-width ch) char-width))
3445 (if (> run-width ps-width-remaining)
3446 (setq run-width ps-width-remaining)
3447 (setq from (ps-mule-next-point from))))
3448 ;; We assume that all characters in this range have the same width.
3449 (let ((width (charset-width ps-mule-current-charset)))
3450 (setq run-width (* (- to from) char-width width))
3451 (if (> run-width ps-width-remaining)
3452 (setq from (min
3453 (+ from (truncate (/ ps-width-remaining char-width)))
3454 to)
3455 run-width ps-width-remaining)
3456 (setq from to))))
3457 (cons from run-width)))
3458
3459 (defun ps-mule-plot-string (from to &optional bg-color)
3460 "Generate PostScript code for ploting characters in the region FROM and TO.
3461
3462 It is assumed that all characters in this region belong to a charset in
3463 `ps-mule-current-charset'.
3464
3465 Optional argument BG-COLOR specifies background color.
3466
3467 Returns the value:
3468
3469 (ENDPOS . RUN-WIDTH)
3470
3471 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
3472 the sequence."
3473 (let* ((wrappoint (ps-mule-find-wrappoint
3474 from to (ps-avg-char-width 'ps-font-for-text)))
3475 (to (car wrappoint))
3476 (font-type (car (nth ps-current-font
3477 (ps-font-alist 'ps-font-for-text))))
3478 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
3479 (string (buffer-substring-no-properties from to)))
3480 (cond
3481 ((= from to)
3482 ;; We can't print any more characters in the current line.
3483 nil)
3484
3485 (font-spec
3486 ;; We surely have a font for printing this character set.
3487 (ps-output-string (ps-mule-string-encoding font-spec string))
3488 (ps-output " S\n"))
3489
3490 ((eq ps-mule-current-charset 'latin-iso8859-1)
3491 ;; Latin-1 can be printed by a normal ASCII font.
3492 (ps-output-string (ps-mule-string-ascii string))
3493 (ps-output " S\n"))
3494
3495 ((eq ps-mule-current-charset 'composition)
3496 (let* ((ch (char-after from))
3497 (width (char-width ch))
3498 (ch-list (decompose-composite-char ch 'list t)))
3499 (if (consp (nth 1 ch-list))
3500 (ps-mule-plot-rule-cmpchar ch-list width font-type)
3501 (ps-mule-plot-cmpchar ch-list width t font-type))))
3502
3503 (t
3504 ;; No way to print this charset. Just show a vacant box of an
3505 ;; appropriate width.
3506 (ps-output (format "%d %d SB\n"
3507 (length string)
3508 (if (eq ps-mule-current-charset 'composition)
3509 (char-width (char-after from))
3510 (charset-width ps-mule-current-charset))))))
3511 wrappoint))
3512
3513 ;; Composite font support
3514
3515 (defvar ps-mule-cmpchar-prologue-generated nil)
3516
3517 (defconst ps-mule-cmpchar-prologue
3518 "%%%% Composite character handler
3519 /CmpcharWidth 0 def
3520 /CmpcharRelativeCompose 0 def
3521 /CmpcharRelativeSkip 0.4 def
3522
3523 %% Get a bounding box (relative to currentpoint) of STR.
3524 /GetPathBox { % str |- --
3525 gsave
3526 currentfont /FontType get 3 eq { %ifelse
3527 stringwidth pop pop
3528 } {
3529 currentpoint /y exch def pop
3530 false charpath flattenpath pathbbox
3531 y sub /URY exch def pop
3532 y sub /LLY exch def pop
3533 } ifelse
3534 grestore
3535 } bind def
3536
3537 %% Beginning of composite char.
3538 /BC { % str xoff width |- --
3539 /Cmpchar true def
3540 /CmpcharWidth exch def
3541 currentfont /RelativeCompose known {
3542 /CmpcharRelativeCompose currentfont /RelativeCompose get def
3543 } {
3544 /CmpcharRelativeCompose false def
3545 } ifelse
3546 /bgsave bg def /bgcolorsave bgcolor def
3547 /Effectsave Effect def
3548 gsave % Reflect effect only at first
3549 /Effect Effect 1 2 add 4 add 16 add and def
3550 /f0 findfont setfont ( ) 0 CmpcharWidth getinterval S
3551 grestore
3552 /Effect Effectsave 8 32 add and def % enable only shadow and outline
3553 false BG
3554 gsave SpaceWidth mul 0 rmoveto dup GetPathBox S grestore
3555 /y currentpoint exch pop def
3556 /HIGH URY y add def /LOW LLY y add def
3557 } bind def
3558
3559 %% End of composite char.
3560 /EC { % -- |- --
3561 /bg bgsave def /bgcolor bgcolorsave def
3562 /Effect Effectsave def
3563 /Cmpchar false def
3564 CmpcharWidth SpaceWidth mul 0 rmoveto
3565 } bind def
3566
3567 %% Rule base composition
3568 /RBC { % str xoff gref nref |- --
3569 /nref exch def /gref exch def
3570 gsave
3571 SpaceWidth mul 0 rmoveto
3572 dup
3573 GetPathBox
3574 [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get
3575 [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get
3576 sub /btm exch def
3577 /top btm URY LLY sub add def
3578 top HIGH gt { /HIGH top def } if
3579 btm LOW lt { /LOW btm def } if
3580 currentpoint pop btm LLY sub moveto
3581 S
3582 grestore
3583 } bind def
3584
3585 %% Relative composition
3586 /RLC { % str |- --
3587 gsave
3588 dup GetPathBox
3589 CmpcharRelativeCompose type /integertype eq {
3590 LLY CmpcharRelativeCompose gt { % compose on top
3591 currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto
3592 /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def
3593 } { URY 0 le { % compose under bottom
3594 currentpoint pop LOW LLY add CmpcharRelativeSkip sub moveto
3595 /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def
3596 } if } ifelse } if
3597 S
3598 grestore
3599 } bind def
3600 %%%% End of composite character handler
3601
3602 "
3603 "PostScript code for printing composite characters.")
3604
3605 (defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type)
3606 (let* ((leftmost 0.0)
3607 (rightmost (float (char-width (car ch-rule-list))))
3608 (the-list (cons '(3 . 3) ch-rule-list))
3609 (cmpchar-elements nil))
3610 (while the-list
3611 (let* ((this (car the-list))
3612 (gref (car this))
3613 (nref (cdr this))
3614 ;; X-axis info (0:left, 1:center, 2:right)
3615 (gref-x (% gref 3))
3616 (nref-x (% nref 3))
3617 ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center)
3618 (gref-y (if (= gref 4) 3 (/ gref 3)))
3619 (nref-y (if (= nref 4) 3 (/ nref 3)))
3620 (width (float (char-width (car (cdr the-list)))))
3621 left)
3622 (setq left (+ leftmost
3623 (/ (* (- rightmost leftmost) gref-x) 2.0)
3624 (- (/ (* nref-x width) 2.0)))
3625 cmpchar-elements (cons (list (car (cdr the-list))
3626 left gref-y nref-y)
3627 cmpchar-elements)
3628 leftmost (min left leftmost)
3629 rightmost (max (+ left width) rightmost)
3630 the-list (nthcdr 2 the-list))))
3631 (if (< leftmost 0)
3632 (let ((the-list cmpchar-elements))
3633 (while the-list
3634 (setcar (cdr (car the-list))
3635 (- (nth 1 (car the-list)) leftmost))
3636 (setq the-list (cdr the-list)))))
3637 (ps-mule-plot-cmpchar (nreverse cmpchar-elements)
3638 total-width nil font-type)))
3639
3640 (defun ps-mule-plot-cmpchar (elements total-width relativep font-type)
3641 (let* ((elt (car elements))
3642 (ch (if relativep elt (car elt))))
3643 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
3644 (ps-output (format " %d %d BC "
3645 (if relativep 0 (nth 1 elt))
3646 total-width))
3647 (while (setq elements (cdr elements))
3648 (setq elt (car elements)
3649 ch (if relativep elt (car elt)))
3650 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
3651 (ps-output (if relativep
3652 " RLC "
3653 (format " %d %d %d RBC "
3654 (nth 1 elt) (nth 2 elt) (nth 3 elt))))))
3655 (ps-output "EC\n"))
3656
3657 (defun ps-mule-prepare-cmpchar-font (char font-type)
3658 (let* ((ps-mule-current-charset (char-charset char))
3659 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)))
3660 (cond (font-spec
3661 (ps-mule-string-encoding font-spec (char-to-string char)))
3662
3663 ((eq ps-mule-current-charset 'latin-iso8859-1)
3664 (ps-mule-string-ascii (char-to-string char)))
3665
3666 (t
3667 ;; No font for CHAR.
3668 (ps-set-font ps-current-font)
3669 " "))))
3670
3671 (defun ps-mule-string-ascii (str)
3672 (ps-set-font ps-current-font)
3673 (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
3674
3675 (defun ps-mule-string-encoding (font-spec str)
3676 (let ((encoding (ps-mule-font-spec-encoding font-spec)))
3677 (cond ((coding-system-p encoding)
3678 (setq str (encode-coding-string str encoding)))
3679 ((functionp encoding)
3680 (setq str (funcall encoding str)))
3681 (encoding
3682 (error "Invalid coding system or function: %s" encoding)))
3683 (setq str (string-as-unibyte str))
3684 (if (ps-mule-font-spec-src font-spec)
3685 (ps-mule-prepare-font font-spec str ps-mule-current-charset)
3686 (ps-set-font ps-current-font))
3687 str))
3688
3689 ;; Bitmap font support
3690
3691 (defvar ps-mule-bitmap-prologue-generated nil)
3692
3693 (defconst ps-mule-bitmap-prologue
3694 "%%%% Bitmap font handler
3695
3696 /str7 7 string def % working area
3697
3698 %% We grow the dictionary one bunch (1024 entries) by one.
3699 /BitmapDictArray 256 array def
3700 /BitmapDictLength 1024 def
3701 /BitmapDictIndex -1 def
3702
3703 /NewBitmapDict { % -- |- --
3704 /BitmapDictIndex BitmapDictIndex 1 add def
3705 BitmapDictArray BitmapDictIndex BitmapDictLength dict put
3706 } bind def
3707
3708 %% Make at least one dictionary.
3709 NewBitmapDict
3710
3711 /AddBitmap { % gloval-charname bitmap-data |- --
3712 BitmapDictArray BitmapDictIndex get
3713 dup length BitmapDictLength ge {
3714 pop
3715 NewBitmapDict
3716 BitmapDictArray BitmapDictIndex get
3717 } if
3718 3 1 roll put
3719 } bind def
3720
3721 /GetBitmap { % gloval-charname |- bitmap-data
3722 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for
3723 load
3724 0 1 BitmapDictIndex { pop end } for
3725 } bind def
3726
3727 %% Return a global character name which can be used as a key in the
3728 %% bitmap dictionary.
3729 /GlobalCharName { % fontidx code1 code2 |- gloval-charname
3730 exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put
3731 str7 cvn
3732 } bind def
3733
3734 %% Character code holder for a 2-byte character.
3735 /FirstCode -1 def
3736
3737 %% Glyph rendering procedure
3738 /BuildGlyphCommon { % fontdict charname |- --
3739 1 index /FontDimension get 1 eq { /FirstCode 0 store } if
3740 NameIndexDict exch get % STACK: fontdict charcode
3741 FirstCode 0 lt { %ifelse
3742 %% This is the first byte of a 2-byte character. Just
3743 %% remember it for the moment.
3744 /FirstCode exch store
3745 pop
3746 0 0 setcharwidth
3747 } {
3748 1 index /FontSize get /size exch def
3749 1 index /FontSpaceWidthRatio get /ratio exch def
3750 1 index /FontIndex get exch FirstCode exch
3751 GlobalCharName GetBitmap /bmp exch def
3752 %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]
3753 Cmpchar { %ifelse
3754 /FontMatrix get [ exch { size div } forall ] /mtrx exch def
3755 bmp 3 get bmp 4 get mtrx transform
3756 /LLY exch def pop
3757 bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform
3758 /URY exch def pop
3759 } {
3760 pop
3761 } ifelse
3762 /FirstCode -1 store
3763
3764 bmp 0 get SpaceWidthRatio ratio div mul size div 0 % wx wy
3765 setcharwidth % We can't use setcachedevice here.
3766
3767 bmp 1 get 0 gt bmp 2 get 0 gt and {
3768 bmp 1 get bmp 2 get % width height
3769 true % polarity
3770 [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix
3771 bmp 5 1 getinterval cvx % datasrc
3772 imagemask
3773 } if
3774 } ifelse
3775 } bind def
3776
3777 /BuildCharCommon {
3778 1 index /Encoding get exch get
3779 1 index /BuildGlyph get exec
3780 } bind def
3781
3782 %% Bitmap font creater
3783
3784 %% Common Encoding shared by all bitmap fonts.
3785 /EncodingCommon 256 array def
3786 %% Mapping table from character name to character code.
3787 /NameIndexDict 256 dict def
3788 0 1 255 { %for
3789 /idx exch def
3790 /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67
3791 EncodingCommon idx idxname put
3792 NameIndexDict idxname idx put
3793 } for
3794
3795 /GlobalFontIndex 0 def
3796
3797 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
3798 /BitmapFont {
3799 15 dict begin
3800 /FontBBox exch def
3801 /BaselineOffset exch def
3802 /RelativeCompose exch def
3803 /FontSize exch def
3804 /FontBBox [ FontBBox { FontSize div } forall ] def
3805 FontBBox 2 get FontBBox 0 get sub exch div
3806 /FontSpaceWidthRatio exch def
3807 /FontDimension exch def
3808 /FontIndex GlobalFontIndex def
3809 /FontType 3 def
3810 /FontMatrix matrix def
3811 /Encoding EncodingCommon def
3812 /BuildGlyph { BuildGlyphCommon } def
3813 /BuildChar { BuildCharCommon } def
3814 currentdict end
3815 definefont pop
3816 /GlobalFontIndex GlobalFontIndex 1 add def
3817 } bind def
3818
3819 %% Define a new bitmap font.
3820 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
3821 /NF {
3822 /fbbx exch def
3823 %% Convert BDF's FontBoundingBox to PostScript's FontBBox
3824 [ fbbx 2 get fbbx 3 get
3825 fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ]
3826 BitmapFont
3827 } bind def
3828
3829 %% Define a glyph for the specified font and character.
3830 /NG { % fontname charcode bitmap-data |- --
3831 /bmp exch def
3832 exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put
3833 /FontIndex get exch
3834 dup 256 idiv exch 256 mod GlobalCharName
3835 bmp AddBitmap
3836 } bind def
3837 %%%% End of bitmap font handler
3838
3839 ")
3840
3841 ;; External library support.
3842
3843 ;; The following three functions are to be called from external
3844 ;; libraries which support bitmap fonts (e.g. `bdf') to get
3845 ;; appropriate PostScript code.
3846
3847 (defun ps-mule-generate-bitmap-prologue ()
3848 (unless ps-mule-bitmap-prologue-generated
3849 (setq ps-mule-bitmap-prologue-generated t)
3850 (list ps-mule-bitmap-prologue)))
3851
3852 (defun ps-mule-generate-bitmap-font (&rest args)
3853 (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args)))
3854
3855 (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap)
3856 (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n"
3857 font-name code
3858 dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3)
3859 bitmap))
3860
3861 ;; Mule specific initializers.
3862
3863 (defun ps-mule-initialize ()
3864 "Produce Poscript code in the prologue part for multi-byte characters."
3865 (setq ps-mule-font-info-database
3866 (cond ((eq ps-multibyte-buffer 'non-latin-printer)
3867 ps-mule-font-info-database-ps)
3868 ((eq ps-multibyte-buffer 'bdf-font)
3869 ps-mule-font-info-database-bdf)
3870 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
3871 ps-mule-font-info-database-ps-bdf)
3872 (t
3873 ps-mule-font-info-database-latin))
3874 ps-mule-current-charset 'ascii
3875 ps-mule-font-cache nil
3876 ps-mule-prologue-generated nil
3877 ps-mule-cmpchar-prologue-generated nil
3878 ps-mule-bitmap-prologue-generated nil)
3879 (mapcar `(lambda (x) (setcar (cdr x) nil))
3880 ps-mule-external-libraries))
3881
3882 (defun ps-mule-begin (from to)
3883 (and (boundp 'enable-multibyte-characters)
3884 enable-multibyte-characters
3885 ;; Initialize `ps-mule-charset-list'. If some characters aren't
3886 ;; printable, warn it.
3887 (let ((charsets (delete 'ascii (find-charset-region from to))))
3888 (setq ps-mule-charset-list charsets)
3889 (save-excursion
3890 (goto-char from)
3891 (and (search-forward "\200" to t)
3892 (setq ps-mule-charset-list
3893 (cons 'composition ps-mule-charset-list))))
3894 (while charsets
3895 (cond
3896 ((or (eq (car charsets) 'composition)
3897 (ps-mule-printable-p (car charsets)))
3898 (setq charsets (cdr charsets)))
3899 ((y-or-n-p "Font for some characters not found, continue anyway? ")
3900 (setq charsets nil))
3901 (t
3902 (error "Printing cancelled"))))))
3903
3904 (if ps-mule-charset-list
3905 (let ((the-list ps-mule-charset-list)
3906 font-spec)
3907 (unless ps-mule-prologue-generated
3908 (ps-output-prologue ps-mule-prologue)
3909 (setq ps-mule-prologue-generated t))
3910 ;; If external functions are necessary, generate prologues for them.
3911 (while the-list
3912 (cond ((and (eq (car the-list) 'composition)
3913 (not ps-mule-cmpchar-prologue-generated))
3914 (ps-output-prologue ps-mule-cmpchar-prologue)
3915 (setq ps-mule-cmpchar-prologue-generated t))
3916 ((setq font-spec (ps-mule-get-font-spec (car the-list) 'normal))
3917 (ps-mule-init-external-library font-spec)))
3918 (setq the-list (cdr the-list)))))
3919
3920 ;; If ASCII font is also specified in ps-mule-font-info-database,
3921 ;; use it istead of what specified in ps-font-info-database.
3922 (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
3923 (if font-spec
3924 (progn
3925 (unless ps-mule-prologue-generated
3926 (ps-output-prologue ps-mule-prologue)
3927 (setq ps-mule-prologue-generated t))
3928 (ps-mule-init-external-library font-spec)
3929 (let ((font (ps-font-alist 'ps-font-for-text))
3930 (i 0))
3931 (while font
3932 (let ((ps-current-font i))
3933 ;; Be sure to download a glyph for SPACE in advance.
3934 (ps-mule-prepare-font
3935 (ps-mule-get-font-spec 'ascii (car font))
3936 " " 'ascii 'no-setfont))
3937 (setq font (cdr font)
3938 i (1+ i))))))))
3939
3940 ;; For handling multi-byte characters -- End.
3941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3942
3943 2880
3944 (defun ps-line-lengths-internal () 2881 (defun ps-line-lengths-internal ()
3945 "Display the correspondence between a line length and a font size, 2882 "Display the correspondence between a line length and a font size,
3946 using the current ps-print setup. 2883 using the current ps-print setup.
3947 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" 2884 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
4556 3493
4557 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database)))) 3494 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
4558 (ps-output (format "/SpaceWidthRatio %f def\n" 3495 (ps-output (format "/SpaceWidthRatio %f def\n"
4559 (/ (ps-lookup 'space-width) (ps-lookup 'size))))) 3496 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
4560 3497
4561 (ps-mule-initialize) 3498 (ps-output "\n%%EndPrologue\n\n%%BeginSetup\nBeginDoc\n%%EndSetup\n"))
4562
4563 (ps-output "%%EndPrologue\n%%BeginSetup\nBeginDoc\n%%EndSetup\n\n"))
4564 3499
4565 (defun ps-header-dirpart () 3500 (defun ps-header-dirpart ()
4566 (let ((fname (buffer-file-name))) 3501 (let ((fname (buffer-file-name)))
4567 (if fname 3502 (if fname
4568 (if (string-equal (buffer-name) (file-name-nondirectory fname)) 3503 (if (string-equal (buffer-name) (file-name-nondirectory fname))
4590 (and (re-search-backward "^%%Trailer$" nil t) 3525 (and (re-search-backward "^%%Trailer$" nil t)
4591 (delete-region (match-beginning 0) (point-max)))) 3526 (delete-region (match-beginning 0) (point-max))))
4592 (setq ps-showline-count (if ps-printing-region (car ps-printing-region) 1) 3527 (setq ps-showline-count (if ps-printing-region (car ps-printing-region) 1)
4593 ps-page-count 0 3528 ps-page-count 0
4594 ps-control-or-escape-regexp 3529 ps-control-or-escape-regexp
4595 (if ps-mule-charset-list 3530 (cond ((eq ps-print-control-characters '8-bit)
4596 (cond ((eq ps-print-control-characters '8-bit) 3531 (string-as-unibyte "[\000-\037\177-\377]"))
4597 "[^\040-\176]") 3532 ((eq ps-print-control-characters 'control-8-bit)
4598 ((eq ps-print-control-characters 'control-8-bit) 3533 (string-as-unibyte "[\000-\037\177-\237]"))
4599 (string-as-multibyte "[^\040-\176\240-\377]")) 3534 ((eq ps-print-control-characters 'control)
4600 ((eq ps-print-control-characters 'control) 3535 "[\000-\037\177]")
4601 (string-as-multibyte "[^\040-\176\200-\377]")) 3536 (t "[\t\n\f]"))))
4602 (t (string-as-multibyte "[^\000-\011\013\015-\377")))
4603 (cond ((eq ps-print-control-characters '8-bit)
4604 (string-as-unibyte "[\000-\037\177-\377]"))
4605 ((eq ps-print-control-characters 'control-8-bit)
4606 (string-as-unibyte "[\000-\037\177-\237]"))
4607 ((eq ps-print-control-characters 'control)
4608 "[\000-\037\177]")
4609 (t "[\t\n\f]")))))
4610 3537
4611 (defmacro ps-page-number () 3538 (defmacro ps-page-number ()
4612 `(1+ (/ (1- ps-page-count) ps-number-of-columns))) 3539 `(1+ (/ (1- ps-page-count) ps-number-of-columns)))
4613 3540
4614 (defun ps-end-file () 3541 (defun ps-end-file ()
4641 (run-hooks 'ps-print-begin-column-hook))) 3568 (run-hooks 'ps-print-begin-column-hook)))
4642 3569
4643 (defun ps-begin-page () 3570 (defun ps-begin-page ()
4644 (ps-get-page-dimensions) 3571 (ps-get-page-dimensions)
4645 (setq ps-width-remaining ps-print-width 3572 (setq ps-width-remaining ps-print-width
4646 ps-height-remaining ps-print-height 3573 ps-height-remaining ps-print-height)
4647 ps-mule-current-charset 'ascii)
4648 3574
4649 (ps-header-page) 3575 (ps-header-page)
4650 3576
4651 (ps-output (format "/LineNumber %d def\n" ps-showline-count) 3577 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
4652 (format "/PageNumber %d def\n" (if ps-print-only-one-header 3578 (format "/PageNumber %d def\n" (if ps-print-only-one-header
4659 (ps-output (format "%d SetHeaderLines\n" ps-header-lines))) 3585 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
4660 3586
4661 (ps-output "BeginPage\n") 3587 (ps-output "BeginPage\n")
4662 (ps-set-font ps-current-font) 3588 (ps-set-font ps-current-font)
4663 (ps-set-bg ps-current-bg) 3589 (ps-set-bg ps-current-bg)
4664 (ps-set-color ps-current-color)) 3590 (ps-set-color ps-current-color)
3591 (ps-mule-begin-page))
4665 3592
4666 (defun ps-end-page () 3593 (defun ps-end-page ()
4667 (ps-output "EndPage\nEndDSCPage\n")) 3594 (ps-output "EndPage\nEndDSCPage\n"))
4668 3595
4669 (defun ps-dummy-page () 3596 (defun ps-dummy-page ()
4699 3626
4700 (defun ps-basic-plot-string (from to &optional bg-color) 3627 (defun ps-basic-plot-string (from to &optional bg-color)
4701 (let* ((wrappoint (ps-find-wrappoint from to 3628 (let* ((wrappoint (ps-find-wrappoint from to
4702 (ps-avg-char-width 'ps-font-for-text))) 3629 (ps-avg-char-width 'ps-font-for-text)))
4703 (to (car wrappoint)) 3630 (to (car wrappoint))
4704 (string (buffer-substring-no-properties from to)) 3631 (string (buffer-substring-no-properties from to)))
4705 (font-spec 3632 (ps-mule-prepare-ascii-font string)
4706 (ps-mule-get-font-spec
4707 'ascii
4708 (car (nth ps-current-font (ps-font-alist 'ps-font-for-text))))))
4709 (and font-spec
4710 (ps-mule-prepare-font font-spec string 'ascii))
4711 (ps-output-string string) 3633 (ps-output-string string)
4712 (ps-output " S\n") 3634 (ps-output " S\n")
4713 wrappoint)) 3635 wrappoint))
4714 3636
4715 (defun ps-basic-plot-whitespace (from to &optional bg-color) 3637 (defun ps-basic-plot-whitespace (from to &optional bg-color)
4740 (if (< q-todo 100) 3662 (if (< q-todo 100)
4741 (/ (* 100 q-done) q-todo) 3663 (/ (* 100 q-done) q-todo)
4742 (/ q-done (/ q-todo 100))) 3664 (/ q-done (/ q-todo 100)))
4743 )))))) 3665 ))))))
4744 3666
3667 (defvar ps-last-font nil)
3668
4745 (defun ps-set-font (font) 3669 (defun ps-set-font (font)
4746 (setq ps-last-font (format "f%d" (setq ps-current-font font))) 3670 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
4747 (ps-output (format "/%s F\n" ps-last-font))) 3671 (ps-output (format "/%s F\n" ps-last-font)))
4748 3672
4749 (defun ps-set-bg (color) 3673 (defun ps-set-bg (color)
4783 (setq ps-current-effect 0)) 3707 (setq ps-current-effect 0))
4784 ((/= effects ps-current-effect) 3708 ((/= effects ps-current-effect)
4785 (ps-output (number-to-string effects) " EF\n") 3709 (ps-output (number-to-string effects) " EF\n")
4786 (setq ps-current-effect effects))) 3710 (setq ps-current-effect effects)))
4787 3711
4788 (setq ps-mule-current-charset 'ascii)
4789
4790 ;; Starting at the beginning of the specified region... 3712 ;; Starting at the beginning of the specified region...
4791 (save-excursion 3713 (save-excursion
4792 (goto-char from) 3714 (goto-char from)
4793 3715
4794 ;; ...break the region up into chunks separated by tabs, linefeeds, 3716 ;; ...break the region up into chunks separated by tabs, linefeeds,
4797 (if (re-search-forward ps-control-or-escape-regexp to t) 3719 (if (re-search-forward ps-control-or-escape-regexp to t)
4798 ;; region with some control characters or some multi-byte characters 3720 ;; region with some control characters or some multi-byte characters
4799 (let* ((match-point (match-beginning 0)) 3721 (let* ((match-point (match-beginning 0))
4800 (match (char-after match-point))) 3722 (match (char-after match-point)))
4801 (when (< from match-point) 3723 (when (< from match-point)
4802 (unless (eq ps-mule-current-charset 'ascii) 3724 (ps-mule-set-ascii-font)
4803 (ps-set-font ps-current-font)
4804 (setq ps-mule-current-charset 'ascii))
4805 (ps-plot 'ps-basic-plot-string from match-point bg-color)) 3725 (ps-plot 'ps-basic-plot-string from match-point bg-color))
4806 (cond 3726 (cond
4807 ((= match ?\t) ; tab 3727 ((= match ?\t) ; tab
4808 (let ((linestart (line-beginning-position))) 3728 (let ((linestart (line-beginning-position)))
4809 (forward-char -1) 3729 (forward-char -1)
4810 (setq from (+ linestart (current-column))) 3730 (setq from (+ linestart (current-column)))
4811 (when (re-search-forward "[ \t]+" to t) 3731 (when (re-search-forward "[ \t]+" to t)
4812 (unless (eq ps-mule-current-charset 'ascii) 3732 (ps-mule-set-ascii-font)
4813 (ps-set-font ps-current-font)
4814 (setq ps-mule-current-charset 'ascii))
4815 (ps-plot 'ps-basic-plot-whitespace 3733 (ps-plot 'ps-basic-plot-whitespace
4816 from (+ linestart (current-column)) 3734 from (+ linestart (current-column))
4817 bg-color)))) 3735 bg-color))))
4818 3736
4819 ((= match ?\n) ; newline 3737 ((= match ?\n) ; newline
4827 (ps-next-page))) 3745 (ps-next-page)))
4828 3746
4829 ((> match 255) ; a multi-byte character 3747 ((> match 255) ; a multi-byte character
4830 (let ((charset (char-charset match))) 3748 (let ((charset (char-charset match)))
4831 (or (eq charset 'composition) 3749 (or (eq charset 'composition)
4832 (ps-mule-skip-same-charset charset)) 3750 (while (eq (charset-after) charset)
4833 (setq ps-mule-current-charset charset) 3751 (forward-char 1)))
4834 (ps-plot 'ps-mule-plot-string match-point (point) bg-color))) 3752 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
4835 ; characters from ^@ to ^_ and 3753 ; characters from ^@ to ^_ and
4836 (t ; characters from 127 to 255 3754 (t ; characters from 127 to 255
4837 (ps-control-character match))) 3755 (ps-control-character match)))
4838 (setq from (point))) 3756 (setq from (point)))
4839 ;; region without control characters nor multi-byte characters 3757 ;; region without control characters nor multi-byte characters
4840 (when (not (eq ps-mule-current-charset 'ascii)) 3758 (ps-mule-set-ascii-font)
4841 (ps-set-font ps-current-font)
4842 (setq ps-mule-current-charset 'ascii))
4843 (ps-plot 'ps-basic-plot-string from to bg-color) 3759 (ps-plot 'ps-basic-plot-string from to bg-color)
4844 (setq from to))))) 3760 (setq from to)))))
4845 3761
4846 (defvar ps-string-control-codes 3762 (defvar ps-string-control-codes
4847 (let ((table (make-vector 256 nil)) 3763 (let ((table (make-vector 256 nil))
4967 face)) 3883 face))
4968 fg-color bg-color (lsh effect -2))))) 3884 fg-color bg-color (lsh effect -2)))))
4969 (goto-char to)) 3885 (goto-char to))
4970 3886
4971 3887
3888 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
3889 (let* ((frame-font (or (face-font-instance face)
3890 (face-font-instance 'default)))
3891 (kind-cons (and frame-font
3892 (assq kind
3893 (font-instance-properties frame-font))))
3894 (kind-spec (cdr-safe kind-cons))
3895 (case-fold-search t))
3896 (or (and kind-spec (string-match kind-regex kind-spec))
3897 ;; Kludge-compatible:
3898 (memq face kind-list))))
3899
3900
4972 (cond ((eq ps-print-emacs-type 'emacs) ; emacs 3901 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
4973 3902
4974 (defun ps-face-bold-p (face) 3903 (defun ps-face-bold-p (face)
4975 (or (face-bold-p face) 3904 (or (face-bold-p face)
4976 (memq face ps-bold-faces))) 3905 (memq face ps-bold-faces)))
4980 (memq face ps-italic-faces))) 3909 (memq face ps-italic-faces)))
4981 ) 3910 )
4982 ; xemacs 3911 ; xemacs
4983 ; lucid 3912 ; lucid
4984 (t ; epoch 3913 (t ; epoch
4985 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
4986 (let* ((frame-font (or (face-font-instance face)
4987 (face-font-instance 'default)))
4988 (kind-cons (and frame-font
4989 (assq kind
4990 (font-instance-properties frame-font))))
4991 (kind-spec (cdr-safe kind-cons))
4992 (case-fold-search t))
4993 (or (and kind-spec (string-match kind-regex kind-spec))
4994 ;; Kludge-compatible:
4995 (memq face kind-list))))
4996
4997 (defun ps-face-bold-p (face) 3914 (defun ps-face-bold-p (face)
4998 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold" 3915 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold"
4999 ps-bold-faces)) 3916 ps-bold-faces))
5000 3917
5001 (defun ps-face-italic-p (face) 3918 (defun ps-face-italic-p (face)
5241 (goto-char (point-min)) 4158 (goto-char (point-min))
5242 (or (looking-at (regexp-quote ps-adobe-tag)) 4159 (or (looking-at (regexp-quote ps-adobe-tag))
5243 (setq needs-begin-file t)) 4160 (setq needs-begin-file t))
5244 (save-excursion 4161 (save-excursion
5245 (set-buffer ps-source-buffer) 4162 (set-buffer ps-source-buffer)
5246 (and needs-begin-file (ps-begin-file)) 4163 (when needs-begin-file
5247 (ps-mule-begin from to) 4164 (ps-begin-file)
4165 (ps-mule-initialize))
5248 (ps-begin-job) 4166 (ps-begin-job)
4167 (ps-mule-begin-job from to)
5249 (ps-begin-page)) 4168 (ps-begin-page))
5250 (set-buffer ps-source-buffer) 4169 (set-buffer ps-source-buffer)
5251 (funcall genfunc from to) 4170 (funcall genfunc from to)
5252 (ps-end-page) 4171 (ps-end-page)
5253 4172
5302 ;; Else, spool to the printer 4221 ;; Else, spool to the printer
5303 (and ps-razzle-dazzle (message "Printing...")) 4222 (and ps-razzle-dazzle (message "Printing..."))
5304 (save-excursion 4223 (save-excursion
5305 (set-buffer ps-spool-buffer) 4224 (set-buffer ps-spool-buffer)
5306 (let* ((coding-system-for-write 'raw-text-unix) 4225 (let* ((coding-system-for-write 'raw-text-unix)
5307 (ps-printer-name (or ps-printer-name printer-name)) 4226 (ps-printer-name (or ps-printer-name
4227 (and (boundp 'printer-name)
4228 printer-name)))
5308 (ps-lpr-switches 4229 (ps-lpr-switches
5309 (append 4230 (append
5310 (and (stringp ps-printer-name) 4231 (and (stringp ps-printer-name)
5311 (list (concat "-P" ps-printer-name))) 4232 (list (concat "-P" ps-printer-name)))
5312 ps-lpr-switches))) 4233 ps-lpr-switches)))
5375 (kill-emacs-hook 4296 (kill-emacs-hook
5376 (message "Won't override existing `kill-emacs-hook'")) 4297 (message "Won't override existing `kill-emacs-hook'"))
5377 (t 4298 (t
5378 (setq kill-emacs-hook 'ps-kill-emacs-check))) 4299 (setq kill-emacs-hook 'ps-kill-emacs-check)))
5379 4300
4301
4302 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5380 ;;; Sample Setup Code: 4303 ;;; Sample Setup Code:
5381 4304
5382 ;; This stuff is for anybody that's brave enough to look this far, 4305 ;; This stuff is for anybody that's brave enough to look this far,
5383 ;; and able to figure out how to use it. It isn't really part of 4306 ;; and able to figure out how to use it. It isn't really part of
5384 ;; ps-print, but I'll leave it here in hopes it might be useful: 4307 ;; ps-print, but I'll leave it here in hopes it might be useful:
5385 4308
5386 ;; WARNING!!! The following code is *sample* code only. Don't use it 4309 ;; WARNING!!! The following code is *sample* code only.
5387 ;; unless you understand what it does! 4310 ;; Don't use it unless you understand what it does!
5388 4311
5389 (defmacro ps-prsc () 4312 (defmacro ps-prsc ()
5390 `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22)) 4313 `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
5391 (defmacro ps-c-prsc () 4314 (defmacro ps-c-prsc ()
5392 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22))) 4315 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
5575 ps-header-font-family 'Helvetica 4498 ps-header-font-family 'Helvetica
5576 ps-header-font-size 6 4499 ps-header-font-size 6
5577 ps-header-title-font-size 8) 4500 ps-header-title-font-size 8)
5578 'ps-jack-setup) 4501 'ps-jack-setup)
5579 4502
4503
4504 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4505 ;; To make this file smaller, some commands go in a separate file.
4506 ;; But autoload them here to make the separation invisible.
4507
4508 (autoload 'ps-mule-prepare-ascii-font "ps-mule"
4509 "Setup special ASCII font for STRING.
4510 STRING should contain only ASCII characters.")
4511
4512 (autoload 'ps-mule-set-ascii-font "ps-mule"
4513 "Adjust current font if current charset is not ASCII.")
4514
4515 (autoload 'ps-mule-plot-string "ps-mule"
4516 "Generate PostScript code for ploting characters in the region FROM and TO.
4517
4518 It is assumed that all characters in this region belong to the same charset.
4519
4520 Optional argument BG-COLOR specifies background color.
4521
4522 Returns the value:
4523
4524 (ENDPOS . RUN-WIDTH)
4525
4526 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
4527 the sequence.")
4528
4529 (autoload 'ps-mule-initialize "ps-mule"
4530 "Initialize global data for printing multi-byte characters.")
4531
4532 (autoload 'ps-mule-begin-job "ps-mule"
4533 "Start printing job for multi-byte chars between FROM and TO.
4534 This checks if all multi-byte characters in the region are printable or not.")
4535
4536 (autoload 'ps-mule-begin-page "ps-mule"
4537 "Initialize multi-byte charset for printing current page.")
4538
4539
4540 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4541
5580 (provide 'ps-print) 4542 (provide 'ps-print)
5581 4543
5582 ;;; ps-print.el ends here 4544 ;;; ps-print.el ends here