4666 |
(goto-char (point-max)) |
(goto-char (point-max)) |
4667 |
(insert-file fname))) |
(insert-file fname))) |
4668 |
|
|
|
;; These functions are used in `ps-mule' to get charset of header and footer. |
|
|
;; To avoid unnecessary calls to functions in `ps-left-header', |
|
|
;; `ps-right-header', `ps-left-footer' and `ps-right-footer'. |
|
|
|
|
|
(defun ps-generate-string-list (content) |
|
|
(let (str) |
|
|
(while content |
|
|
(setq str (cons (cond |
|
|
((stringp (car content)) |
|
|
(car content)) |
|
|
((and (symbolp (car content)) (fboundp (car content))) |
|
|
(concat "(" (funcall (car content)) ")")) |
|
|
((and (symbolp (car content)) (boundp (car content))) |
|
|
(concat "(" (symbol-value (car content)) ")")) |
|
|
(t |
|
|
"")) |
|
|
str) |
|
|
content (cdr content))) |
|
|
(nreverse str))) |
|
|
|
|
|
(defvar ps-lh-cache nil) |
|
|
(defvar ps-rh-cache nil) |
|
|
(defvar ps-lf-cache nil) |
|
|
(defvar ps-rf-cache nil) |
|
|
|
|
|
(defun ps-header-footer-string () |
|
|
(and ps-print-header |
|
|
(setq ps-lh-cache (ps-generate-string-list ps-left-header) |
|
|
ps-rh-cache (ps-generate-string-list ps-right-header))) |
|
|
(and ps-print-footer |
|
|
(setq ps-lf-cache (ps-generate-string-list ps-left-footer) |
|
|
ps-rf-cache (ps-generate-string-list ps-right-footer))) |
|
|
(mapconcat 'identity |
|
|
(append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache) |
|
|
"")) |
|
|
|
|
4669 |
;; These functions insert the arrays that define the contents of the headers. |
;; These functions insert the arrays that define the contents of the headers. |
4670 |
|
|
4671 |
|
(defvar ps-encode-header-string-function nil) |
4672 |
|
|
4673 |
(defun ps-generate-header-line (fonttag &optional content) |
(defun ps-generate-header-line (fonttag &optional content) |
4674 |
(ps-output " [" fonttag " ") |
(ps-output " [" fonttag " ") |
4675 |
(cond |
(cond |
4676 |
;; Literal strings should be output as is -- the string must contain its own |
;; Literal strings should be output as is -- the string must contain its own |
4677 |
;; PS string delimiters, '(' and ')', if necessary. |
;; PS string delimiters, '(' and ')', if necessary. |
4678 |
((stringp content) |
((stringp content) |
4679 |
(ps-output (ps-mule-encode-header-string content fonttag))) |
(ps-output content)) |
4680 |
|
|
4681 |
;; Functions are called -- they should return strings; they will be inserted |
;; Functions are called -- they should return strings; they will be inserted |
4682 |
;; as strings and the PS string delimiters added. |
;; as strings and the PS string delimiters added. |
4683 |
((and (symbolp content) (fboundp content)) |
((and (symbolp content) (fboundp content)) |
4684 |
(ps-output-string (ps-mule-encode-header-string (funcall content) |
(if (fboundp ps-encode-header-string-function) |
4685 |
fonttag))) |
(dolist (l (funcall ps-encode-header-string-function |
4686 |
|
(funcall content) fonttag)) |
4687 |
|
(ps-output-string l)) |
4688 |
|
(ps-output-string (funcall content)))) |
4689 |
|
|
4690 |
;; Variables will have their contents inserted. They should contain |
;; Variables will have their contents inserted. They should contain |
4691 |
;; strings, and will be inserted as strings. |
;; strings, and will be inserted as strings. |
4692 |
((and (symbolp content) (boundp content)) |
((and (symbolp content) (boundp content)) |
4693 |
(ps-output-string (ps-mule-encode-header-string (symbol-value content) |
(if (fboundp ps-encode-header-string-function) |
4694 |
fonttag))) |
(dolist (l (funcall ps-encode-header-string-function |
4695 |
|
(symbol-value content) fonttag)) |
4696 |
|
(ps-output-string l)) |
4697 |
|
(ps-output-string (symbol-value content)))) |
4698 |
|
|
4699 |
;; Anything else will get turned into an empty string. |
;; Anything else will get turned into an empty string. |
4700 |
(t |
(t |
5648 |
(t (list default default default)) |
(t (list default default default)) |
5649 |
)) |
)) |
5650 |
|
|
5651 |
|
(defvar ps-basic-plot-string-function 'ps-basic-plot-string) |
5652 |
|
|
5653 |
(defun ps-begin-job () |
(defun ps-begin-job () |
5654 |
;; prologue files |
;; prologue files |
5737 |
ps-color-p (and ps-print-color-p (ps-color-device)) |
ps-color-p (and ps-print-color-p (ps-color-device)) |
5738 |
ps-print-color-scale (if ps-color-p |
ps-print-color-scale (if ps-color-p |
5739 |
(float (car (ps-color-values "white"))) |
(float (car (ps-color-values "white"))) |
5740 |
1.0)) |
1.0) |
5741 |
|
;; Set up default functions. They may be overridden by |
5742 |
|
;; ps-mule-begin-job. |
5743 |
|
ps-basic-plot-string-function 'ps-basic-plot-string |
5744 |
|
ps-encode-header-string-function nil) |
5745 |
;; initialize page dimensions |
;; initialize page dimensions |
5746 |
(ps-get-page-dimensions) |
(ps-get-page-dimensions) |
5747 |
;; final check |
;; final check |
5822 |
(format "/PageNumber %d def\n" (ps-page-number))) |
(format "/PageNumber %d def\n" (ps-page-number))) |
5823 |
|
|
5824 |
(when ps-print-header |
(when ps-print-header |
5825 |
(ps-generate-header "HeaderLinesLeft" "/h0" "/h1" |
(ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header) |
5826 |
(or ps-lh-cache ps-left-header)) |
(ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header) |
5827 |
(ps-generate-header "HeaderLinesRight" "/h0" "/h1" |
(ps-output (format "%d SetHeaderLines\n" ps-header-lines))) |
|
(or ps-rh-cache ps-right-header)) |
|
|
(ps-output (format "%d SetHeaderLines\n" ps-header-lines)) |
|
|
(setq ps-lh-cache nil |
|
|
ps-rh-cache nil)) |
|
5828 |
|
|
5829 |
(when ps-print-footer |
(when ps-print-footer |
5830 |
(ps-generate-header "FooterLinesLeft" "/H0" "/H0" |
(ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer) |
5831 |
(or ps-lf-cache ps-left-footer)) |
(ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer) |
5832 |
(ps-generate-header "FooterLinesRight" "/H0" "/H0" |
(ps-output (format "%d SetFooterLines\n" ps-footer-lines))) |
|
(or ps-rf-cache ps-right-footer)) |
|
|
(ps-output (format "%d SetFooterLines\n" ps-footer-lines)) |
|
|
(setq ps-lf-cache nil |
|
|
ps-rf-cache nil)) |
|
5833 |
|
|
5834 |
(ps-output (number-to-string ps-lines-printed) " BeginPage\n") |
(ps-output (number-to-string ps-lines-printed) " BeginPage\n") |
5835 |
(ps-set-font ps-current-font) |
(ps-set-font ps-current-font) |
5836 |
(ps-set-bg ps-current-bg) |
(ps-set-bg ps-current-bg) |
5837 |
(ps-set-color ps-current-color) |
(ps-set-color ps-current-color)) |
|
(ps-mule-begin-page)) |
|
5838 |
|
|
5839 |
(defsubst ps-skip-newline (limit) |
(defsubst ps-skip-newline (limit) |
5840 |
(setq ps-showline-count (1+ ps-showline-count) |
(setq ps-showline-count (1+ ps-showline-count) |
5878 |
(ps-avg-char-width 'ps-font-for-text))) |
(ps-avg-char-width 'ps-font-for-text))) |
5879 |
(to (car wrappoint)) |
(to (car wrappoint)) |
5880 |
(str (substring string from to))) |
(str (substring string from to))) |
|
(ps-mule-prepare-ascii-font str) |
|
5881 |
(ps-output-string str) |
(ps-output-string str) |
5882 |
(ps-output " S\n") |
(ps-output " S\n") |
5883 |
wrappoint)) |
wrappoint)) |
5887 |
(ps-avg-char-width 'ps-font-for-text))) |
(ps-avg-char-width 'ps-font-for-text))) |
5888 |
(to (car wrappoint)) |
(to (car wrappoint)) |
5889 |
(string (buffer-substring-no-properties from to))) |
(string (buffer-substring-no-properties from to))) |
|
(ps-mule-prepare-ascii-font string) |
|
5890 |
(ps-output-string string) |
(ps-output-string string) |
5891 |
(ps-output " S\n") |
(ps-output " S\n") |
5892 |
wrappoint)) |
wrappoint)) |
5990 |
(if (re-search-forward ps-control-or-escape-regexp to t) |
(if (re-search-forward ps-control-or-escape-regexp to t) |
5991 |
;; region with some control characters or some multi-byte characters |
;; region with some control characters or some multi-byte characters |
5992 |
(let* ((match-point (match-beginning 0)) |
(let* ((match-point (match-beginning 0)) |
5993 |
(match (char-after match-point)) |
(match (char-after match-point))) |
|
(composition (ps-e-find-composition from (1+ match-point)))) |
|
|
(if composition |
|
|
(if (and (nth 2 composition) |
|
|
(<= (car composition) match-point)) |
|
|
(progn |
|
|
(setq match-point (car composition) |
|
|
match 0) |
|
|
(goto-char (nth 1 composition))) |
|
|
(setq composition nil))) |
|
5994 |
(when (< from match-point) |
(when (< from match-point) |
5995 |
(ps-mule-set-ascii-font) |
(ps-plot ps-basic-plot-string-function |
5996 |
(ps-plot 'ps-basic-plot-string from match-point bg-color)) |
from match-point bg-color)) |
5997 |
(cond |
(cond |
5998 |
((= match ?\t) ; tab |
((= match ?\t) ; tab |
5999 |
(let ((linestart (line-beginning-position))) |
(let ((linestart (line-beginning-position))) |
6000 |
(forward-char -1) |
(forward-char -1) |
6001 |
(setq from (+ linestart (current-column))) |
(setq from (+ linestart (current-column))) |
6002 |
(when (re-search-forward "[ \t]+" to t) |
(when (re-search-forward "[ \t]+" to t) |
|
(ps-mule-set-ascii-font) |
|
6003 |
(ps-plot 'ps-basic-plot-whitespace |
(ps-plot 'ps-basic-plot-whitespace |
6004 |
from (+ linestart (current-column)) |
from (+ linestart (current-column)) |
6005 |
bg-color)))) |
bg-color)))) |
6024 |
(ps-skip-newline to)) |
(ps-skip-newline to)) |
6025 |
(ps-next-page))) |
(ps-next-page))) |
6026 |
|
|
|
(composition ; a composite sequence |
|
|
(ps-plot 'ps-mule-plot-composition match-point (point) bg-color)) |
|
|
|
|
|
((> match 255) ; a multi-byte character |
|
|
(let* ((charset (char-charset match)) |
|
|
(composition (ps-e-find-composition match-point to)) |
|
|
(stop (if (nth 2 composition) (car composition) to))) |
|
|
(or (eq charset 'composition) |
|
|
(while (and (< (point) stop) (eq (charset-after) charset)) |
|
|
(forward-char 1))) |
|
|
(ps-plot 'ps-mule-plot-string match-point (point) bg-color))) |
|
|
; characters from ^@ to ^_ and |
|
6027 |
(t ; characters from 127 to 255 |
(t ; characters from 127 to 255 |
6028 |
(ps-control-character match))) |
(ps-control-character match))) |
6029 |
(setq from (point))) |
(setq from (point))) |
6030 |
;; region without control characters nor multi-byte characters |
;; region without control characters |
6031 |
(ps-mule-set-ascii-font) |
(ps-plot ps-basic-plot-string-function from to bg-color) |
|
(ps-plot 'ps-basic-plot-string from to bg-color) |
|
6032 |
(setq from to))))) |
(setq from to))))) |
6033 |
|
|
6034 |
(defvar ps-string-control-codes |
(defvar ps-string-control-codes |
6060 |
(if (< (car wrappoint) to) |
(if (< (car wrappoint) to) |
6061 |
(ps-continue-line)) |
(ps-continue-line)) |
6062 |
(setq ps-width-remaining (- ps-width-remaining (* len char-width))) |
(setq ps-width-remaining (- ps-width-remaining (* len char-width))) |
|
(ps-mule-prepare-ascii-font str) |
|
6063 |
(ps-output-string str) |
(ps-output-string str) |
6064 |
(ps-output " S\n"))) |
(ps-output " S\n"))) |
6065 |
|
|
6422 |
(ps-begin-page) |
(ps-begin-page) |
6423 |
(funcall genfunc from to) |
(funcall genfunc from to) |
6424 |
(ps-end-page) |
(ps-end-page) |
6425 |
|
(ps-mule-end-job) |
6426 |
(ps-end-job needs-begin-file) |
(ps-end-job needs-begin-file) |
6427 |
|
|
6428 |
;; Setting this variable tells the unwind form that the |
;; Setting this variable tells the unwind form that the |
6774 |
;; To make this file smaller, some commands go in a separate file. |
;; To make this file smaller, some commands go in a separate file. |
6775 |
;; But autoload them here to make the separation invisible. |
;; But autoload them here to make the separation invisible. |
6776 |
|
|
|
(autoload 'ps-mule-prepare-ascii-font "ps-mule" |
|
|
"Setup special ASCII font for STRING. |
|
|
STRING should contain only ASCII characters.") |
|
|
|
|
|
(autoload 'ps-mule-set-ascii-font "ps-mule" |
|
|
"Adjust current font if current charset is not ASCII.") |
|
|
|
|
|
(autoload 'ps-mule-plot-string "ps-mule" |
|
|
"Generate PostScript code for plotting characters in the region FROM and TO. |
|
|
|
|
|
It is assumed that all characters in this region belong to the same charset. |
|
|
|
|
|
Optional argument BG-COLOR specifies background color. |
|
|
|
|
|
Returns the value: |
|
|
|
|
|
(ENDPOS . RUN-WIDTH) |
|
|
|
|
|
Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of |
|
|
the sequence.") |
|
|
|
|
6777 |
(autoload 'ps-mule-initialize "ps-mule" |
(autoload 'ps-mule-initialize "ps-mule" |
6778 |
"Initialize global data for printing multi-byte characters.") |
"Initialize global data for printing multi-byte characters.") |
6779 |
|
|
6784 |
(autoload 'ps-mule-begin-page "ps-mule" |
(autoload 'ps-mule-begin-page "ps-mule" |
6785 |
"Initialize multi-byte charset for printing current page.") |
"Initialize multi-byte charset for printing current page.") |
6786 |
|
|
6787 |
(autoload 'ps-mule-encode-header-string "ps-mule" |
(autoload 'ps-mule-end-job "ps-mule" |
6788 |
"Generate PostScript code for plotting characters in header STRING. |
"Finish printing job for multi-byte chars.") |
|
|
|
|
It is assumed that the length of STRING is not zero.") |
|
6789 |
|
|
6790 |
|
|
6791 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |