Mercurial > emacs
comparison lisp/ps-print.el @ 37135:18c2d3c6096d
Line and paragraph spacing feature. Region to cut
out when printing. Doc fix.
(ps-print-version): New version number (6.5).
(ps-line-spacing, ps-paragraph-spacing, ps-paragraph-regexp): New
vars. Line and paragraph spacing feature.
(ps-begin-cut-regexp, ps-end-cut-regexp): New vars. Region to cut
out when printing.
(ps-setup, ps-nb-pages, ps-get-page-dimensions, ps-begin-file)
(ps-get-font-size, ps-begin-job, ps-continue-line)
(ps-plot-region): Code fix.
(ps-print-prologue-2): Var eliminated.
(ps-line-spacing-internal, ps-paragraph-spacing-internal): New
internal vars.
(ps-get-size): New fun.
(ps-output-string-prim, ps-init-output-queue, ps-print-page-p)
(ps-next-line): Replace defun by defsubst.
(ps-mule-plot-string): Autoload doc 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:35:07 +0000 |
parents | f2ca7236963b |
children | 7e15b73c8c20 |
comparison
equal
deleted
inserted
replaced
37134:87685591e368 | 37135:18c2d3c6096d |
---|---|
8 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> | 8 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> |
9 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | 9 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
10 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | 10 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
11 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> | 11 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> |
12 ;; Keywords: wp, print, PostScript | 12 ;; Keywords: wp, print, PostScript |
13 ;; Time-stamp: <2001/02/19 14:54:52 Vinicius> | 13 ;; Time-stamp: <2001/03/23 21:27:46 Vinicius> |
14 ;; Version: 6.4 | 14 ;; Version: 6.5 |
15 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ | 15 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ |
16 | 16 |
17 (defconst ps-print-version "6.4" | 17 (defconst ps-print-version "6.5" |
18 "ps-print.el, v 6.4 <2001/02/19 vinicius> | 18 "ps-print.el, v 6.5 <2001/03/23 vinicius> |
19 | 19 |
20 Vinicius's last change version -- this file may have been edited as part of | 20 Vinicius's last change version -- this file may have been edited as part of |
21 Emacs without changes to the version number. When reporting bugs, please also | 21 Emacs without changes to the version number. When reporting bugs, please also |
22 report the version of Emacs, if any, that ps-print was distributed with. | 22 report the version of Emacs, if any, that ps-print was distributed with. |
23 | 23 |
847 ;; text in the header (similar to `ps-font-size'). | 847 ;; text in the header (similar to `ps-font-size'). |
848 ;; | 848 ;; |
849 ;; The variable `ps-header-title-font-size' determines the font size, in points, | 849 ;; The variable `ps-header-title-font-size' determines the font size, in points, |
850 ;; for the top line of text in the header (similar to `ps-font-size'). | 850 ;; for the top line of text in the header (similar to `ps-font-size'). |
851 ;; | 851 ;; |
852 ;; The variable `ps-line-spacing' determines the line spacing, in points, for | |
853 ;; ordinary text, when generating PostScript (similar to `ps-font-size'). The | |
854 ;; default value is 0 (zero = no line spacing). | |
855 ;; | |
856 ;; The variable `ps-paragraph-spacing' determines the paragraph spacing, in | |
857 ;; points, for ordinary text, when generating PostScript (similar to | |
858 ;; `ps-font-size'). The default value is 0 (zero = no paragraph spacing). | |
859 ;; | |
860 ;; To get all lines with some spacing set both `ps-line-spacing' and | |
861 ;; `ps-paragraph-spacing' variables. | |
862 ;; | |
863 ;; The variable `ps-paragraph-regexp' specifies the paragraph delimiter. It | |
864 ;; should be a regexp or nil. The default value is "[ \t]*$", that is, an | |
865 ;; empty line or a line containing only spaces and tabs. | |
866 ;; | |
867 ;; The variable `ps-begin-cut-regexp' and `ps-end-cut-regexp' specify the start | |
868 ;; and end of a region to cut out when printing. | |
869 ;; | |
870 ;; As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may | |
871 ;; be set to "^Local Variables:" and "^End:", respectively, in order to leave | |
872 ;; out some special printing instructions from the actual print. Special | |
873 ;; printing instructions may be appended to the end of the file just like any | |
874 ;; other buffer-local variables. See section "Local Variables in Files" on | |
875 ;; Emacs manual for more information. | |
876 ;; | |
877 ;; Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what | |
878 ;; actually gets printed. Both variables may be set to nil in which case no | |
879 ;; cutting occurs. By default, both variables are set to nil. | |
880 ;; | |
852 ;; | 881 ;; |
853 ;; Adding a New Font Family | 882 ;; Adding a New Font Family |
854 ;; ------------------------ | 883 ;; ------------------------ |
855 ;; | 884 ;; |
856 ;; To use a new font family, you MUST first teach ps-print | 885 ;; To use a new font family, you MUST first teach ps-print |
1247 ;; Improve the memory management for big files (hard?). | 1276 ;; Improve the memory management for big files (hard?). |
1248 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care | 1277 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care |
1249 ;; of folding lines. | 1278 ;; of folding lines. |
1250 ;; | 1279 ;; |
1251 ;; | 1280 ;; |
1252 ;; Acknowledgements | 1281 ;; Acknowledgments |
1253 ;; ---------------- | 1282 ;; --------------- |
1283 ;; | |
1284 ;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction. | |
1254 ;; | 1285 ;; |
1255 ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size | 1286 ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size |
1256 ;; suggestion. | 1287 ;; suggestion. |
1257 ;; | 1288 ;; |
1258 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for | 1289 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for |
1638 This variable is used only when `ps-printer-name' is a non-empty string." | 1669 This variable is used only when `ps-printer-name' is a non-empty string." |
1639 :type '(choice :menu-tag "Printer Name Option" | 1670 :type '(choice :menu-tag "Printer Name Option" |
1640 :tag "Printer Name Option" | 1671 :tag "Printer Name Option" |
1641 (const :tag "None" nil) | 1672 (const :tag "None" nil) |
1642 (string :tag "Option")) | 1673 (string :tag "Option")) |
1674 :version "21.1" | |
1643 :group 'ps-print-printer) | 1675 :group 'ps-print-printer) |
1644 | 1676 |
1645 (defcustom ps-lpr-command lpr-command | 1677 (defcustom ps-lpr-command lpr-command |
1646 "*Name of program for printing a PostScript file. | 1678 "*Name of program for printing a PostScript file. |
1647 | 1679 |
1676 :type 'boolean | 1708 :type 'boolean |
1677 :group 'ps-print-printer) | 1709 :group 'ps-print-printer) |
1678 | 1710 |
1679 (defcustom ps-end-with-control-d (and ps-windows-system t) | 1711 (defcustom ps-end-with-control-d (and ps-windows-system t) |
1680 "*Non-nil means insert C-d at end of PostScript file generated." | 1712 "*Non-nil means insert C-d at end of PostScript file generated." |
1713 :version "21.1" | |
1681 :type 'boolean | 1714 :type 'boolean |
1682 :group 'ps-print-printer) | 1715 :group 'ps-print-printer) |
1683 | 1716 |
1684 ;;; Page layout | 1717 ;;; Page layout |
1685 | 1718 |
2716 "*Directory where it's located the PostScript prologue file used by ps-print. | 2749 "*Directory where it's located the PostScript prologue file used by ps-print. |
2717 By default, this directory is the same as in the variable `data-directory'." | 2750 By default, this directory is the same as in the variable `data-directory'." |
2718 :type 'directory | 2751 :type 'directory |
2719 :group 'ps-print-miscellany) | 2752 :group 'ps-print-miscellany) |
2720 | 2753 |
2754 (defcustom ps-line-spacing 0 | |
2755 "*Specify line spacing, in points, for ordinary text. | |
2756 | |
2757 See also `ps-paragraph-spacing' and `ps-paragraph-regexp'. | |
2758 | |
2759 To get all lines with some spacing set both `ps-line-spacing' and | |
2760 `ps-paragraph-spacing' variables." | |
2761 :type '(choice :menu-tag "Line Spacing For Ordinary Text" | |
2762 :tag "Line Spacing For Ordinary Text" | |
2763 (number :tag "Line Spacing") | |
2764 (cons :tag "Landscape/Portrait" | |
2765 (number :tag "Landscape Line Spacing") | |
2766 (number :tag "Portrait Line Spacing"))) | |
2767 :version "21.1" | |
2768 :group 'ps-print-miscellany) | |
2769 | |
2770 (defcustom ps-paragraph-spacing 0 | |
2771 "*Specify paragraph spacing, in points, for ordinary text. | |
2772 | |
2773 See also `ps-line-spacing' and `ps-paragraph-regexp'. | |
2774 | |
2775 To get all lines with some spacing set both `ps-line-spacing' and | |
2776 `ps-paragraph-spacing' variables." | |
2777 :type '(choice :menu-tag "Paragraph Spacing For Ordinary Text" | |
2778 :tag "Paragraph Spacing For Ordinary Text" | |
2779 (number :tag "Paragraph Spacing") | |
2780 (cons :tag "Landscape/Portrait" | |
2781 (number :tag "Landscape Paragraph Spacing") | |
2782 (number :tag "Portrait Paragraph Spacing"))) | |
2783 :version "21.1" | |
2784 :group 'ps-print-miscellany) | |
2785 | |
2786 (defcustom ps-paragraph-regexp "[ \t]*$" | |
2787 "*Specify paragraph delimiter. | |
2788 | |
2789 It should be a regexp or nil. | |
2790 | |
2791 See also `ps-paragraph-spacing'." | |
2792 :type '(choice :menu-tag "Paragraph Delimiter" | |
2793 (const :tag "No Delimiter" nil) | |
2794 (regexp :tag "Delimiter Regexp")) | |
2795 :version "21.1" | |
2796 :group 'ps-print-miscellany) | |
2797 | |
2798 (defcustom ps-begin-cut-regexp nil | |
2799 "*Specify regexp which is start of a region to cut out when printing. | |
2800 | |
2801 As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be | |
2802 set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out | |
2803 some special printing instructions from the actual print. Special printing | |
2804 instructions may be appended to the end of the file just like any other | |
2805 buffer-local variables. See section \"Local Variables in Files\" on Emacs | |
2806 manual for more information. | |
2807 | |
2808 Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what | |
2809 actually gets printed. Both variables may be set to nil in which case no | |
2810 cutting occurs." | |
2811 :type 'regexp | |
2812 :version "21.1" | |
2813 :group 'ps-print-miscellany) | |
2814 | |
2815 (defcustom ps-end-cut-regexp nil | |
2816 "*Specify regexp which is end of the region to cut out when printing. | |
2817 | |
2818 See `ps-begin-cut-regexp' for more information." | |
2819 :type 'regexp | |
2820 :version "21.1" | |
2821 :group 'ps-print-miscellany) | |
2822 | |
2721 | 2823 |
2722 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 2824 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
2723 ;; Selected Pages | 2825 ;; Selected Pages |
2724 | 2826 |
2725 | 2827 |
2950 ps-header-font-family %s | 3052 ps-header-font-family %s |
2951 ps-header-font-size %s | 3053 ps-header-font-size %s |
2952 ps-header-title-font-size %s | 3054 ps-header-title-font-size %s |
2953 ps-line-number-font %s | 3055 ps-line-number-font %s |
2954 ps-line-number-font-size %s | 3056 ps-line-number-font-size %s |
3057 ps-line-spacing %s | |
3058 ps-paragraph-spacing %s | |
3059 ps-paragraph-regexp %s | |
3060 ps-begin-cut-regexp %s | |
3061 ps-end-cut-regexp %s | |
2955 | 3062 |
2956 ps-even-or-odd-pages %s | 3063 ps-even-or-odd-pages %s |
2957 ps-selected-pages %s | 3064 ps-selected-pages %s |
2958 ps-last-selected-pages %s | 3065 ps-last-selected-pages %s |
2959 | 3066 |
3033 (ps-print-quote ps-header-font-family) | 3140 (ps-print-quote ps-header-font-family) |
3034 (ps-print-quote ps-header-font-size) | 3141 (ps-print-quote ps-header-font-size) |
3035 (ps-print-quote ps-header-title-font-size) | 3142 (ps-print-quote ps-header-title-font-size) |
3036 ps-line-number-font | 3143 ps-line-number-font |
3037 (ps-print-quote ps-line-number-font-size) | 3144 (ps-print-quote ps-line-number-font-size) |
3145 (ps-print-quote ps-line-spacing) | |
3146 (ps-print-quote ps-paragraph-spacing) | |
3147 (ps-print-quote ps-paragraph-regexp) | |
3148 (ps-print-quote ps-begin-cut-regexp) | |
3149 (ps-print-quote ps-end-cut-regexp) | |
3038 (ps-print-quote ps-even-or-odd-pages) | 3150 (ps-print-quote ps-even-or-odd-pages) |
3039 (ps-print-quote ps-selected-pages) | 3151 (ps-print-quote ps-selected-pages) |
3040 (ps-print-quote ps-last-selected-pages) | 3152 (ps-print-quote ps-last-selected-pages) |
3041 ps-build-face-reference | 3153 ps-build-face-reference |
3042 ps-always-build-face-reference | 3154 ps-always-build-face-reference |
3222 | 3334 |
3223 (defvar ps-print-prologue-0 "" | 3335 (defvar ps-print-prologue-0 "" |
3224 "ps-print PostScript error handler.") | 3336 "ps-print PostScript error handler.") |
3225 | 3337 |
3226 (defvar ps-print-prologue-1 "" | 3338 (defvar ps-print-prologue-1 "" |
3227 "ps-print PostScript prologue begin.") | 3339 "ps-print PostScript prologue.") |
3228 | |
3229 (defvar ps-print-prologue-2 "" | |
3230 "ps-print PostScript prologue end.") | |
3231 | 3340 |
3232 ;; Start Editing Here: | 3341 ;; Start Editing Here: |
3233 | 3342 |
3234 (defvar ps-source-buffer nil) | 3343 (defvar ps-source-buffer nil) |
3235 (defvar ps-spool-buffer-name "*PostScript*") | 3344 (defvar ps-spool-buffer-name "*PostScript*") |
3302 (defvar ps-width-remaining nil) | 3411 (defvar ps-width-remaining nil) |
3303 | 3412 |
3304 (defvar ps-font-size-internal nil) | 3413 (defvar ps-font-size-internal nil) |
3305 (defvar ps-header-font-size-internal nil) | 3414 (defvar ps-header-font-size-internal nil) |
3306 (defvar ps-header-title-font-size-internal nil) | 3415 (defvar ps-header-title-font-size-internal nil) |
3416 (defvar ps-line-spacing-internal nil) | |
3417 (defvar ps-paragraph-spacing-internal nil) | |
3307 | 3418 |
3308 | 3419 |
3309 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 3420 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
3310 ;; Internal Variables | 3421 ;; Internal Variables |
3311 | 3422 |
3639 (or ps-header-font-size-internal | 3750 (or ps-header-font-size-internal |
3640 (ps-get-font-size 'ps-header-font-size))) | 3751 (ps-get-font-size 'ps-header-font-size))) |
3641 (ps-header-title-font-size-internal | 3752 (ps-header-title-font-size-internal |
3642 (or ps-header-title-font-size-internal | 3753 (or ps-header-title-font-size-internal |
3643 (ps-get-font-size 'ps-header-title-font-size))) | 3754 (ps-get-font-size 'ps-header-title-font-size))) |
3755 (ps-line-spacing-internal | |
3756 (or ps-line-spacing-internal | |
3757 (ps-get-size ps-line-spacing "line spacing"))) | |
3644 (buf (get-buffer-create "*Nb-Pages*")) | 3758 (buf (get-buffer-create "*Nb-Pages*")) |
3759 (ils ps-line-spacing-internal) ; initial line spacing | |
3645 (ifs ps-font-size-internal) ; initial font size | 3760 (ifs ps-font-size-internal) ; initial font size |
3646 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height | 3761 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height |
3647 (page-height (progn (ps-get-page-dimensions) | 3762 (page-height (progn (ps-get-page-dimensions) |
3648 ps-print-height)) | 3763 ps-print-height)) |
3649 (ps-setup (ps-setup)) ; setup for the current buffer | 3764 (ps-setup (ps-setup)) ; setup for the current buffer |
3658 fs ; current font size | 3773 fs ; current font size |
3659 lh ; current line height | 3774 lh ; current line height |
3660 nb-lpp ; current nb of lines per page | 3775 nb-lpp ; current nb of lines per page |
3661 nb-page ; current nb of pages | 3776 nb-page ; current nb of pages |
3662 ) | 3777 ) |
3663 (setq lh-min (/ (* ilh fs-min) ifs) | 3778 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs) |
3664 nb-lpp-max (floor (/ page-height lh-min)) | 3779 nb-lpp-max (floor (/ page-height lh-min)) |
3665 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max)) | 3780 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max)) |
3666 lh-max (/ (* ilh fs-max) ifs) | 3781 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs) |
3667 nb-lpp-min (floor (/ page-height lh-max)) | 3782 nb-lpp-min (floor (/ page-height lh-max)) |
3668 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)) | 3783 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)) |
3669 nb-page nb-page-min) | 3784 nb-page nb-page-min) |
3670 (set-buffer buf) | 3785 (set-buffer buf) |
3671 (goto-char (point-max)) | 3786 (goto-char (point-max)) |
3795 ps-header-pad) | 3910 ps-header-pad) |
3796 ps-print-height)) | 3911 ps-print-height)) |
3797 ;; ps-zebra-stripe-follow is `full' or `full-follow' | 3912 ;; ps-zebra-stripe-follow is `full' or `full-follow' |
3798 (if ps-zebra-stripe-full-p | 3913 (if ps-zebra-stripe-full-p |
3799 (let* ((line-height (ps-line-height 'ps-font-for-text)) | 3914 (let* ((line-height (ps-line-height 'ps-font-for-text)) |
3800 (zebra (* line-height ps-zebra-stripe-height))) | 3915 (zebra (* (+ line-height ps-line-spacing-internal) |
3916 ps-zebra-stripe-height))) | |
3801 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra) | 3917 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra) |
3802 line-height)) | 3918 line-height)) |
3803 (if (<= ps-print-height 0) | 3919 (if (<= ps-print-height 0) |
3804 (error "Bad vertical layout: | 3920 (error "Bad vertical layout: |
3805 ps-zebra-stripe-follow == %s | 3921 ps-zebra-stripe-follow == %s |
3806 ps-zebra-stripe-height == %s | 3922 ps-zebra-stripe-height == %s |
3807 font-text-height == %s | 3923 font-text-height == %s |
3808 page-height == ((floor print-height (th * zh)) * (th * zh)) - th | 3924 line-spacing == %s |
3925 page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th | |
3809 => print-height == %d !" | 3926 => print-height == %d !" |
3810 ps-zebra-stripe-follow | 3927 ps-zebra-stripe-follow |
3811 ps-zebra-stripe-height | 3928 ps-zebra-stripe-height |
3812 (ps-line-height 'ps-font-for-text) | 3929 (ps-line-height 'ps-font-for-text) |
3930 ps-line-spacing-internal | |
3813 ps-print-height)))))) | 3931 ps-print-height)))))) |
3814 | 3932 |
3815 (defun ps-print-preprint (prefix-arg) | 3933 (defun ps-print-preprint (prefix-arg) |
3816 (and prefix-arg | 3934 (and prefix-arg |
3817 (or (numberp prefix-arg) | 3935 (or (numberp prefix-arg) |
3872 (aset table ?\( "\\(") | 3990 (aset table ?\( "\\(") |
3873 (aset table ?\) "\\)") | 3991 (aset table ?\) "\\)") |
3874 table) | 3992 table) |
3875 "Vector used to map characters to PostScript string escape codes.") | 3993 "Vector used to map characters to PostScript string escape codes.") |
3876 | 3994 |
3877 (defun ps-output-string-prim (string) | 3995 (defsubst ps-output-string-prim (string) |
3878 (insert "(") ;insert start-string delimiter | 3996 (insert "(") ;insert start-string delimiter |
3879 (save-excursion ;insert string | 3997 (save-excursion ;insert string |
3880 (insert (string-as-unibyte string))) | 3998 (insert (string-as-unibyte string))) |
3881 ;; Find and quote special characters as necessary for PS | 3999 ;; Find and quote special characters as necessary for PS |
3882 ;; This skips everything except control chars, non-ASCII chars, (, ) and \. | 4000 ;; This skips everything except control chars, non-ASCII chars, (, ) and \. |
3885 (delete-char 1) | 4003 (delete-char 1) |
3886 (insert (aref ps-string-escape-codes special)))) | 4004 (insert (aref ps-string-escape-codes special)))) |
3887 (goto-char (point-max)) | 4005 (goto-char (point-max)) |
3888 (insert ")")) ;insert end-string delimiter | 4006 (insert ")")) ;insert end-string delimiter |
3889 | 4007 |
3890 (defun ps-init-output-queue () | 4008 (defsubst ps-init-output-queue () |
3891 (setq ps-output-head (list "") | 4009 (setq ps-output-head (list "") |
3892 ps-output-tail ps-output-head)) | 4010 ps-output-tail ps-output-head)) |
3893 | 4011 |
3894 | 4012 |
3895 (defun ps-selected-pages () | 4013 (defun ps-selected-pages () |
3899 ps-selected-pages (cdr ps-selected-pages)) | 4017 ps-selected-pages (cdr ps-selected-pages)) |
3900 (and ps-selected-pages | 4018 (and ps-selected-pages |
3901 (< ps-last-page ps-page-postscript))))) | 4019 (< ps-last-page ps-page-postscript))))) |
3902 | 4020 |
3903 | 4021 |
3904 (defun ps-print-page-p () | 4022 (defsubst ps-print-page-p () |
3905 (setq ps-print-page-p | 4023 (setq ps-print-page-p |
3906 (and (cond ((null ps-first-page)) | 4024 (and (cond ((null ps-first-page)) |
3907 ((<= ps-page-postscript ps-last-page) | 4025 ((<= ps-page-postscript ps-last-page) |
3908 (<= ps-first-page ps-page-postscript)) | 4026 (<= ps-first-page ps-page-postscript)) |
3909 (ps-selected-pages | 4027 (ps-selected-pages |
3918 (= (logand ps-page-postscript 1) 1)) | 4036 (= (logand ps-page-postscript 1) 1)) |
3919 (t) | 4037 (t) |
3920 )))) | 4038 )))) |
3921 | 4039 |
3922 | 4040 |
3923 (defun ps-print-sheet-p () | 4041 (defsubst ps-print-sheet-p () |
3924 (setq ps-print-page-p | 4042 (setq ps-print-page-p |
3925 (cond ((eq ps-even-or-odd-pages 'even-sheet) | 4043 (cond ((eq ps-even-or-odd-pages 'even-sheet) |
3926 (= (logand ps-page-sheet 1) 0)) | 4044 (= (logand ps-page-sheet 1) 0)) |
3927 ((eq ps-even-or-odd-pages 'odd-sheet) | 4045 ((eq ps-even-or-odd-pages 'odd-sheet) |
3928 (= (logand ps-page-sheet 1) 1)) | 4046 (= (logand ps-page-sheet 1) 1)) |
3978 (ps-output " [ " fonttag " ") | 4096 (ps-output " [ " fonttag " ") |
3979 (cond | 4097 (cond |
3980 ;; Literal strings should be output as is -- the string must | 4098 ;; Literal strings should be output as is -- the string must |
3981 ;; contain its own PS string delimiters, '(' and ')', if necessary. | 4099 ;; contain its own PS string delimiters, '(' and ')', if necessary. |
3982 ((stringp content) | 4100 ((stringp content) |
3983 (ps-output content)) | 4101 (ps-output (ps-mule-encode-header-string content fonttag))) |
3984 | 4102 |
3985 ;; Functions are called -- they should return strings; they will be | 4103 ;; Functions are called -- they should return strings; they will be |
3986 ;; inserted as strings and the PS string delimiters added. | 4104 ;; inserted as strings and the PS string delimiters added. |
3987 ((and (symbolp content) (fboundp content)) | 4105 ((and (symbolp content) (fboundp content)) |
3988 (ps-output-string (funcall content))) | 4106 (ps-output-string (ps-mule-encode-header-string (funcall content) |
4107 fonttag))) | |
3989 | 4108 |
3990 ;; Variables will have their contents inserted. They should | 4109 ;; Variables will have their contents inserted. They should |
3991 ;; contain strings, and will be inserted as strings. | 4110 ;; contain strings, and will be inserted as strings. |
3992 ((and (symbolp content) (boundp content)) | 4111 ((and (symbolp content) (boundp content)) |
3993 (ps-output-string (symbol-value content))) | 4112 (ps-output-string (ps-mule-encode-header-string (symbol-value content) |
4113 fonttag))) | |
3994 | 4114 |
3995 ;; Anything else will get turned into an empty string. | 4115 ;; Anything else will get turned into an empty string. |
3996 (t | 4116 (t |
3997 (ps-output-string ""))) | 4117 (ps-output-string ""))) |
3998 (ps-output " ]\n")) | 4118 (ps-output " ]\n")) |
4649 | 4769 |
4650 (ps-insert-string ps-print-prologue-header) | 4770 (ps-insert-string ps-print-prologue-header) |
4651 | 4771 |
4652 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: " | 4772 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: " |
4653 (ps-page-dimensions-get-media dimensions) | 4773 (ps-page-dimensions-get-media dimensions) |
4654 "\n%%EndDefaults\n\n%%BeginPrologue\n\n" | 4774 "\n%%EndDefaults\n\n%%BeginProlog\n\n" |
4655 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n" | 4775 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n" |
4656 (format "/ErrorMessage %s def\n\n" | 4776 (format "/ErrorMessage %s def\n\n" |
4657 (or (cdr (assoc ps-error-handler-message | 4777 (or (cdr (assoc ps-error-handler-message |
4658 ps-error-handler-alist)) | 4778 ps-error-handler-alist)) |
4659 1)) ; send to paper | 4779 1)) ; send to paper |
4694 ps-spool-duplex | 4814 ps-spool-duplex |
4695 ps-switch-header)) | 4815 ps-switch-header)) |
4696 (ps-output-boolean "ShowNofN " ps-show-n-of-n) | 4816 (ps-output-boolean "ShowNofN " ps-show-n-of-n) |
4697 | 4817 |
4698 (let ((line-height (ps-line-height 'ps-font-for-text))) | 4818 (let ((line-height (ps-line-height 'ps-font-for-text))) |
4699 (ps-output (format "/LineHeight %s def\n" line-height) | 4819 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal) |
4820 (format "/ParagraphSpacing %s def\n" | |
4821 ps-paragraph-spacing-internal) | |
4822 (format "/LineHeight %s def\n" line-height) | |
4700 (format "/LinesPerColumn %d def\n" | 4823 (format "/LinesPerColumn %d def\n" |
4701 (round (/ (+ ps-print-height | 4824 (let ((height (+ line-height |
4702 (* line-height 0.45)) | 4825 ps-line-spacing-internal))) |
4703 line-height))))) | 4826 (round (/ (+ ps-print-height |
4827 (* height 0.45)) | |
4828 height)))))) | |
4704 | 4829 |
4705 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type) | 4830 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type) |
4706 (ps-output-boolean "Zebra " ps-zebra-stripes) | 4831 (ps-output-boolean "Zebra " ps-zebra-stripes) |
4707 (ps-output-boolean "PrintLineNumber " ps-line-number) | 4832 (ps-output-boolean "PrintLineNumber " ps-line-number) |
4708 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step))) | 4833 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step))) |
4768 (ps-font 'ps-font-for-header 'normal)) | 4893 (ps-font 'ps-font-for-header 'normal)) |
4769 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont | 4894 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont |
4770 (ps-get-font-size 'ps-line-number-font-size) | 4895 (ps-get-font-size 'ps-line-number-font-size) |
4771 ps-line-number-font)) | 4896 ps-line-number-font)) |
4772 | 4897 |
4773 (ps-output "\n" ps-print-prologue-2 "\n") | 4898 (ps-output "\n\n% ---- These lines must be kept together because... |
4899 | |
4900 /h0 F | |
4901 /HeaderTitleLineHeight FontHeight def | |
4902 | |
4903 /h1 F | |
4904 /HeaderLineHeight FontHeight def | |
4905 /HeaderDescent Descent def | |
4906 | |
4907 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n") | |
4774 | 4908 |
4775 ;; Text fonts | 4909 ;; Text fonts |
4776 (let ((font (ps-font-alist 'ps-font-for-text)) | 4910 (let ((font (ps-font-alist 'ps-font-for-text)) |
4777 (i 0)) | 4911 (i 0)) |
4778 (while font | 4912 (while font |
4785 | 4919 |
4786 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database)))) | 4920 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database)))) |
4787 (ps-output (format "/SpaceWidthRatio %f def\n" | 4921 (ps-output (format "/SpaceWidthRatio %f def\n" |
4788 (/ (ps-lookup 'space-width) (ps-lookup 'size))))) | 4922 (/ (ps-lookup 'space-width) (ps-lookup 'size))))) |
4789 | 4923 |
4790 (ps-output "\n%%EndPrologue\n\n%%BeginSetup\n") | 4924 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n") |
4791 (unless (eq ps-spool-config 'lpr-switches) | 4925 (unless (eq ps-spool-config 'lpr-switches) |
4792 (ps-output "\n%%BeginFeature: *Duplex " | 4926 (ps-output "\n%%BeginFeature: *Duplex " |
4793 (ps-boolean-capitalized ps-spool-duplex) | 4927 (ps-boolean-capitalized ps-spool-duplex) |
4794 " *Tumble " | 4928 " *Tumble " |
4795 (ps-boolean-capitalized tumble) | 4929 (ps-boolean-capitalized tumble) |
4862 (and ps-printing-region-p "Subset of: ") | 4996 (and ps-printing-region-p "Subset of: ") |
4863 (buffer-name) | 4997 (buffer-name) |
4864 (and (buffer-modified-p) " (unsaved)"))))) | 4998 (and (buffer-modified-p) " (unsaved)"))))) |
4865 | 4999 |
4866 | 5000 |
5001 (defun ps-get-size (size mess &optional arg) | |
5002 (let ((siz (cond ((numberp size) | |
5003 size) | |
5004 ((and (consp size) | |
5005 (numberp (car size)) | |
5006 (numberp (cdr size))) | |
5007 (if ps-landscape-mode | |
5008 (car size) | |
5009 (cdr size))) | |
5010 (t | |
5011 -1)))) | |
5012 (and (< siz 0) | |
5013 (error "Invalid %s `%S'%s" | |
5014 mess size | |
5015 (if arg | |
5016 (format " for `%S'" arg) | |
5017 ""))) | |
5018 siz)) | |
5019 | |
5020 | |
4867 (defun ps-get-font-size (font-sym) | 5021 (defun ps-get-font-size (font-sym) |
4868 (let ((font-size (symbol-value font-sym))) | 5022 (ps-get-size (symbol-value font-sym) "font size" font-sym)) |
4869 (cond ((numberp font-size) | |
4870 font-size) | |
4871 ((and (consp font-size) | |
4872 (numberp (car font-size)) | |
4873 (numberp (cdr font-size))) | |
4874 (if ps-landscape-mode | |
4875 (car font-size) | |
4876 (cdr font-size))) | |
4877 (t | |
4878 (error "Invalid font size `%S' for `%S'" font-size font-sym))))) | |
4879 | 5023 |
4880 | 5024 |
4881 (defun ps-begin-job () | 5025 (defun ps-begin-job () |
4882 ;; prologue files | 5026 ;; prologue files |
4883 (or (equal ps-mark-code-directory ps-postscript-code-directory) | 5027 (or (equal ps-mark-code-directory ps-postscript-code-directory) |
4884 (setq ps-print-prologue-0 (ps-prologue-file 0) | 5028 (setq ps-print-prologue-0 (ps-prologue-file 0) |
4885 ps-print-prologue-1 (ps-prologue-file 1) | 5029 ps-print-prologue-1 (ps-prologue-file 1) |
4886 ps-print-prologue-2 (ps-prologue-file 2) | |
4887 ps-mark-code-directory ps-postscript-code-directory)) | 5030 ps-mark-code-directory ps-postscript-code-directory)) |
4888 ;; selected pages | 5031 ;; selected pages |
4889 (let (new page) | 5032 (let (new page) |
4890 (while ps-selected-pages | 5033 (while ps-selected-pages |
4891 (setq page (car ps-selected-pages) | 5034 (setq page (car ps-selected-pages) |
4929 ps-page-n-up 0 | 5072 ps-page-n-up 0 |
4930 ps-page-column 0 | 5073 ps-page-column 0 |
4931 ps-lines-printed 0 | 5074 ps-lines-printed 0 |
4932 ps-print-page-p t | 5075 ps-print-page-p t |
4933 ps-showline-count (car ps-printing-region) | 5076 ps-showline-count (car ps-printing-region) |
5077 ps-line-spacing-internal (ps-get-size ps-line-spacing | |
5078 "line spacing") | |
5079 ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing | |
5080 "paragraph spacing") | |
4934 ps-font-size-internal (ps-get-font-size 'ps-font-size) | 5081 ps-font-size-internal (ps-get-font-size 'ps-font-size) |
4935 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size) | 5082 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size) |
4936 ps-header-title-font-size-internal | 5083 ps-header-title-font-size-internal |
4937 (ps-get-font-size 'ps-header-title-font-size) | 5084 (ps-get-font-size 'ps-header-title-font-size) |
4938 ps-control-or-escape-regexp | 5085 ps-control-or-escape-regexp |
5046 (setq ps-showline-count (1+ ps-showline-count) | 5193 (setq ps-showline-count (1+ ps-showline-count) |
5047 ps-lines-printed (1+ ps-lines-printed)) | 5194 ps-lines-printed (1+ ps-lines-printed)) |
5048 (and (< (point) limit) | 5195 (and (< (point) limit) |
5049 (forward-char 1))) | 5196 (forward-char 1))) |
5050 | 5197 |
5051 (defun ps-next-line () | 5198 (defsubst ps-next-line () |
5052 (setq ps-showline-count (1+ ps-showline-count) | 5199 (setq ps-showline-count (1+ ps-showline-count) |
5053 ps-lines-printed (1+ ps-lines-printed)) | 5200 ps-lines-printed (1+ ps-lines-printed)) |
5054 (let ((lh (ps-line-height 'ps-font-for-text))) | 5201 (let* ((paragraph-p (and ps-paragraph-regexp |
5202 (looking-at ps-paragraph-regexp))) | |
5203 (lh (+ (ps-line-height 'ps-font-for-text) | |
5204 (if paragraph-p | |
5205 ps-paragraph-spacing-internal | |
5206 ps-line-spacing-internal)))) | |
5055 (if (< ps-height-remaining lh) | 5207 (if (< ps-height-remaining lh) |
5056 (ps-next-page) | 5208 (ps-next-page) |
5057 (setq ps-width-remaining ps-print-width | 5209 (setq ps-width-remaining ps-print-width |
5058 ps-height-remaining (- ps-height-remaining lh)) | 5210 ps-height-remaining (- ps-height-remaining lh)) |
5059 (ps-output "HL\n")))) | 5211 (ps-output (if paragraph-p "PHL\n" "LHL\n"))))) |
5060 | 5212 |
5061 (defun ps-continue-line () | 5213 (defun ps-continue-line () |
5062 (setq ps-lines-printed (1+ ps-lines-printed)) | 5214 (setq ps-lines-printed (1+ ps-lines-printed)) |
5063 (let ((lh (ps-line-height 'ps-font-for-text))) | 5215 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal))) |
5064 (if (< ps-height-remaining lh) | 5216 (if (< ps-height-remaining lh) |
5065 (ps-next-page) | 5217 (ps-next-page) |
5066 (setq ps-width-remaining ps-print-width | 5218 (setq ps-width-remaining ps-print-width |
5067 ps-height-remaining (- ps-height-remaining lh)) | 5219 ps-height-remaining (- ps-height-remaining lh)) |
5068 (ps-output "SL\n")))) | 5220 (ps-output "SL\n")))) |
5164 (goto-char from) | 5316 (goto-char from) |
5165 | 5317 |
5166 ;; ...break the region up into chunks separated by tabs, linefeeds, | 5318 ;; ...break the region up into chunks separated by tabs, linefeeds, |
5167 ;; pagefeeds, control characters, and plot each chunk. | 5319 ;; pagefeeds, control characters, and plot each chunk. |
5168 (while (< from to) | 5320 (while (< from to) |
5321 ;; skip lines between cut markers | |
5322 (and ps-begin-cut-regexp ps-end-cut-regexp | |
5323 (looking-at ps-begin-cut-regexp) | |
5324 (progn | |
5325 (goto-char (match-end 0)) | |
5326 (and (re-search-forward ps-end-cut-regexp to 'noerror) | |
5327 (= (following-char) ?\n) | |
5328 (forward-char 1)) | |
5329 (setq from (point)))) | |
5169 (if (re-search-forward ps-control-or-escape-regexp to t) | 5330 (if (re-search-forward ps-control-or-escape-regexp to t) |
5170 ;; region with some control characters or some multi-byte characters | 5331 ;; region with some control characters or some multi-byte characters |
5171 (let* ((match-point (match-beginning 0)) | 5332 (let* ((match-point (match-beginning 0)) |
5172 (match (char-after match-point)) | 5333 (match (char-after match-point)) |
5173 (composition (ps-e-find-composition from (1+ match-point)))) | 5334 (composition (ps-e-find-composition from (1+ match-point)))) |
5954 | 6115 |
5955 (autoload 'ps-mule-set-ascii-font "ps-mule" | 6116 (autoload 'ps-mule-set-ascii-font "ps-mule" |
5956 "Adjust current font if current charset is not ASCII.") | 6117 "Adjust current font if current charset is not ASCII.") |
5957 | 6118 |
5958 (autoload 'ps-mule-plot-string "ps-mule" | 6119 (autoload 'ps-mule-plot-string "ps-mule" |
5959 "Generate PostScript code for ploting characters in the region FROM and TO. | 6120 "Generate PostScript code for plotting characters in the region FROM and TO. |
5960 | 6121 |
5961 It is assumed that all characters in this region belong to the same charset. | 6122 It is assumed that all characters in this region belong to the same charset. |
5962 | 6123 |
5963 Optional argument BG-COLOR specifies background color. | 6124 Optional argument BG-COLOR specifies background color. |
5964 | 6125 |
5977 This checks if all multi-byte characters in the region are printable or not.") | 6138 This checks if all multi-byte characters in the region are printable or not.") |
5978 | 6139 |
5979 (autoload 'ps-mule-begin-page "ps-mule" | 6140 (autoload 'ps-mule-begin-page "ps-mule" |
5980 "Initialize multi-byte charset for printing current page.") | 6141 "Initialize multi-byte charset for printing current page.") |
5981 | 6142 |
6143 (autoload 'ps-mule-encode-header-string "ps-mule" | |
6144 "Generate PostScript code for plotting characters in header STRING. | |
6145 | |
6146 It is assumed that the length of STRING is not zero.") | |
6147 | |
5982 | 6148 |
5983 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 6149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
5984 | 6150 |
5985 (provide 'ps-print) | 6151 (provide 'ps-print) |
5986 | 6152 |