/[emacs]/emacs/lisp/ps-print.el
ViewVC logotype

Diff of /emacs/lisp/ps-print.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.137 by viniciusjl, Thu Jul 10 22:29:13 2003 UTC revision 1.137.2.1 by handa, Fri Sep 26 11:59:31 2003 UTC
# Line 4666  page-height == ((floor print-height ((th Line 4666  page-height == ((floor print-height ((th
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
# Line 5676  XSTART YSTART are the relative position Line 5648  XSTART YSTART are the relative position
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
# Line 5764  XSTART YSTART are the relative position Line 5737  XSTART YSTART are the relative position
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
# Line 5845  XSTART YSTART are the relative position Line 5822  XSTART YSTART are the relative position
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)
# Line 5910  XSTART YSTART are the relative position Line 5878  XSTART YSTART are the relative position
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))
# Line 5920  XSTART YSTART are the relative position Line 5887  XSTART YSTART are the relative position
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))
# Line 6024  XSTART YSTART are the relative position Line 5990  XSTART YSTART are the relative position
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))))
# Line 6068  XSTART YSTART are the relative position Line 6024  XSTART YSTART are the relative position
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
# Line 6117  XSTART YSTART are the relative position Line 6060  XSTART YSTART are the relative position
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    
# Line 6480  If FACE is not a valid face name, it is Line 6422  If FACE is not a valid face name, it is
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
# Line 6831  If FACE is not a valid face name, it is Line 6774  If FACE is not a valid face name, it is
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    
# Line 6862  This checks if all multi-byte characters Line 6784  This checks if all multi-byte characters
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  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Legend:
Removed from v.1.137  
changed lines
  Added in v.1.137.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26