/[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.126 by abraham, Mon Feb 25 16:29:54 2002 UTC revision 1.126.4.1 by miles, Fri Apr 4 06:20:10 2003 UTC
# Line 1  Line 1 
1  ;;; ps-print.el --- print text from the buffer as PostScript  ;;; ps-print.el --- print text from the buffer as PostScript
2    
3  ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001  ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
4  ;; Free Software Foundation, Inc.  ;; 2003 Free Software Foundation, Inc.
5    
6  ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)  ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
7  ;;      Jacques Duthen (was <duthen@cegelec-red.fr>)  ;;      Jacques Duthen (was <duthen@cegelec-red.fr>)
8  ;;      Vinicius Jose Latorre <vinicius@cpqd.com.br>  ;;      Vinicius Jose Latorre <viniciusjl@ig.com.br>
9  ;;      Kenichi Handa <handa@etl.go.jp> (multi-byte characters)  ;;      Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10  ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)  ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
11  ;;      Vinicius Jose Latorre <vinicius@cpqd.com.br>  ;;      Vinicius Jose Latorre <viniciusjl@ig.com.br>
12  ;; Keywords: wp, print, PostScript  ;; Keywords: wp, print, PostScript
13  ;; Time-stamp: <2001/09/17 14:50:19 vinicius>  ;; Time-stamp: <2003/03/05 21:54:55 vinicius>
14  ;; Version: 6.5.5  ;; Version: 6.6
15  ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/  ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
16    
17  (defconst ps-print-version "6.5.5"  (defconst ps-print-version "6.6"
18    "ps-print.el, v 6.5.5 <2001/09/17 vinicius>    "ps-print.el, v 6.6 <2003/03/05 vinicius>
19    
20  Vinicius's last change version -- this file may have been edited as part of  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  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.  report the version of Emacs, if any, that ps-print was distributed with.
23    
24  Please send all bug fixes and enhancements to  Please send all bug fixes and enhancements to
25          Vinicius Jose Latorre <vinicius@cpqd.com.br>.          Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
 ")  
26    
27  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
28    
# Line 50  Please send all bug fixes and enhancemen Line 49  Please send all bug fixes and enhancemen
49  ;;  ;;
50  ;; This package provides printing of Emacs buffers on PostScript printers; the  ;; This package provides printing of Emacs buffers on PostScript printers; the
51  ;; buffer's bold and italic text attributes are preserved in the printer  ;; buffer's bold and italic text attributes are preserved in the printer
52  ;; output.  ps-print is intended for use with Emacs or Lucid Emacs, together  ;; output.  ps-print is intended for use with Emacs or XEmacs, together with a
53  ;; with a fontifying package such as font-lock or hilit.  ;; fontifying package such as font-lock or hilit.
54  ;;  ;;
55  ;; ps-print uses the same face attributes defined through font-lock or hilit to  ;; ps-print uses the same face attributes defined through font-lock or hilit to
56  ;; print a PostScript file, but some faces are better seeing on the screen than  ;; print a PostScript file, but some faces are better seeing on the screen than
# Line 1076  Please send all bug fixes and enhancemen Line 1075  Please send all bug fixes and enhancemen
1075  ;;    (face...) list of faces whose background color will be used.  ;;    (face...) list of faces whose background color will be used.
1076  ;;  ;;
1077  ;; Any other value will be treated as t.  ;; Any other value will be treated as t.
1078  ;; The default value is t.  ;; The default value is nil.
1079  ;;  ;;
1080  ;;  ;;
1081  ;; How Ps-Print Deals With Color  ;; How Ps-Print Deals With Color
# Line 1212  Please send all bug fixes and enhancemen Line 1211  Please send all bug fixes and enhancemen
1211  ;; New since version 2.8  ;; New since version 2.8
1212  ;; ---------------------  ;; ---------------------
1213  ;;  ;;
1214  ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>  ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1215  ;;  ;;
1216  ;;    20010619  ;;    20010619
1217  ;;       `ps-time-stamp-locale-default'  ;;       `ps-time-stamp-locale-default'
# Line 1264  Please send all bug fixes and enhancemen Line 1263  Please send all bug fixes and enhancemen
1263  ;;  ;;
1264  ;; `ps-print-region-function'  ;; `ps-print-region-function'
1265  ;;  ;;
1266  ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>  ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1267  ;;  ;;
1268  ;;    19990301  ;;    19990301
1269  ;;       PostScript tumble and setpagedevice.  ;;       PostScript tumble and setpagedevice.
# Line 1277  Please send all bug fixes and enhancemen Line 1276  Please send all bug fixes and enhancemen
1276  ;;  ;;
1277  ;; Multi-byte buffer handling.  ;; Multi-byte buffer handling.
1278  ;;  ;;
1279  ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>  ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1280  ;;  ;;
1281  ;;    19980306  ;;    19980306
1282  ;;       Skip invisible text.  ;;       Skip invisible text.
# Line 1330  Please send all bug fixes and enhancemen Line 1329  Please send all bug fixes and enhancemen
1329  ;;  ;;
1330  ;; Faces are always treated as opaque.  ;; Faces are always treated as opaque.
1331  ;;  ;;
1332  ;; Epoch and Emacs 19 not supported.  At all.  ;; Epoch, Lucid and Emacs 19 not supported.  At all.
1333  ;;  ;;
1334  ;; Fixed-pitch fonts work better for line folding, but are not required.  ;; Fixed-pitch fonts work better for line folding, but are not required.
1335  ;;  ;;
# Line 1443  Please send all bug fixes and enhancemen Line 1442  Please send all bug fixes and enhancemen
1442        (error "`ps-print' requires floating point support"))        (error "`ps-print' requires floating point support"))
1443    
1444    
1445      (defvar ps-print-emacs-type
1446        (let ((case-fold-search t))
1447          (cond ((string-match "XEmacs" emacs-version) 'xemacs)
1448                ((string-match "Lucid" emacs-version)
1449                 (error "`ps-print' doesn't support Lucid"))
1450                ((string-match "Epoch" emacs-version)
1451                 (error "`ps-print' doesn't support Epoch"))
1452                (t
1453                 (unless (and (boundp 'emacs-major-version)
1454                              (> emacs-major-version 19))
1455                   (error "`ps-print' only supports Emacs 20 and higher"))
1456                 'emacs))))
1457    
1458    
1459    ;; For Emacs 20.2 and the earlier version.    ;; For Emacs 20.2 and the earlier version.
1460    
1461    (or (fboundp 'set-buffer-multibyte)    (or (fboundp 'set-buffer-multibyte)
# Line 1508  Please send all bug fixes and enhancemen Line 1521  Please send all bug fixes and enhancemen
1521    (defconst ps-windows-system    (defconst ps-windows-system
1522      (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))      (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
1523    (defconst ps-lp-system    (defconst ps-lp-system
1524      (memq system-type '(usq-unix-v dgux hpux irix))))      (memq system-type '(usg-unix-v dgux hpux irix)))
1525    
1526    
1527      (defun ps-xemacs-color-name (color)
1528        (if (ps-x-color-specifier-p color)
1529            (ps-x-color-name color)
1530          color))
1531    
1532    
1533      (cond ((eq ps-print-emacs-type 'emacs) ; emacs
1534             (defvar mark-active nil)
1535             (defun ps-mark-active-p ()
1536               mark-active)
1537             (defalias 'ps-face-foreground-name 'face-foreground)
1538             (defalias 'ps-face-background-name 'face-background)
1539             )
1540            (t                              ; xemacs
1541             (defalias 'ps-mark-active-p 'region-active-p)
1542             (defun ps-face-foreground-name (face)
1543               (ps-xemacs-color-name (face-foreground face)))
1544             (defun ps-face-background-name (face)
1545               (ps-xemacs-color-name (face-background face)))
1546             )))
1547    
1548    
1549  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 1653  As an example for `ps-user-defined-prolo Line 1688  As an example for `ps-user-defined-prolo
1688     ;; Setting for HP PostScript printer     ;; Setting for HP PostScript printer
1689     (setq ps-user-defined-prologue     (setq ps-user-defined-prologue
1690           (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"           (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1691                   \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))                   \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
 "  
1692    :type '(choice :menu-tag "User Defined Prologue"    :type '(choice :menu-tag "User Defined Prologue"
1693                   :tag "User Defined Prologue"                   :tag "User Defined Prologue"
1694                   (const :tag "none" nil) string symbol)                   (const :tag "none" nil) string symbol)
# Line 1673  more requirements put them first in `ps- Line 1707  more requirements put them first in `ps-
1707  \"%%+\" comment.  For example, if you need to set numcopies to 3 and jog on  \"%%+\" comment.  For example, if you need to set numcopies to 3 and jog on
1708  requirements and set %%LanguageLevel: to 2, do:  requirements and set %%LanguageLevel: to 2, do:
1709    
1710  (setq ps-print-prologue-header   (setq ps-print-prologue-header
1711        \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")         \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1712    
1713  The duplex requirement is inserted by ps-print (see `ps-spool-duplex').  The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1714    
# Line 1729  See also `ps-printer-name-option' for do Line 1763  See also `ps-printer-name-option' for do
1763           "-P" ))           "-P" ))
1764    "*Option for `ps-printer-name' variable (see it).    "*Option for `ps-printer-name' variable (see it).
1765    
1766  On Unix-like systems, if it's been used lpr utility, it should be the string  On Unix-like systems, if `lpr' is in use, this should be the string
1767  \"-P\"; if it's been used lp utility, it should be the string \"-d\".  \"-P\"; if `lp' is in use, this should be the string \"-d\".
1768    
1769  On MS-DOS and MS-Windows systems, if it's been used print utility, it should be  On MS-DOS and MS-Windows systems, if `print' is in use, this should be
1770  the string \"/D:\".  the string \"/D:\".
1771    
1772  For any other printing utility, see the proper manual or documentation.  For any other printing utility, see its documentation.
1773    
1774  Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty  Set this to \"\" or nil, if the utility given by `ps-lpr-command'
1775  option printer name option.  needs an empty printer name option--that is, pass the printer name
1776    with no special option preceding it.
1777    
1778  Any other value is treated as nil, that is, an empty printer name option.  Any value that is not a string is treated as nil.
1779    
1780  This variable is used only when `ps-printer-name' is a non-empty string."  This variable is used only when `ps-printer-name' is a non-empty string."
1781    :type '(choice :menu-tag "Printer Name Option"    :type '(choice :menu-tag "Printer Name Option"
# Line 1810  If it's nil, automatic feeding takes pla Line 1845  If it's nil, automatic feeding takes pla
1845  ;; B4         10.125 inch x 14.33  inch  ;; B4         10.125 inch x 14.33  inch
1846  ;; B5          7.16  inch x 10.125 inch  ;; B5          7.16  inch x 10.125 inch
1847    
1848    ;;;###autoload
1849  (defcustom ps-page-dimensions-database  (defcustom ps-page-dimensions-database
1850    (list (list 'a4    (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")    (list (list 'a4    (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1851          (list 'a3    (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")          (list 'a3    (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
# Line 1858  It's used when `ps-spool-config' is set Line 1894  It's used when `ps-spool-config' is set
1894    :group 'ps-print-page)    :group 'ps-print-page)
1895    
1896  (defcustom ps-print-upside-down nil  (defcustom ps-print-upside-down nil
1897    "*Non-nil means print upside-down (that is, it's rotated by 180 grades)."    "*Non-nil means print upside-down (that is, rotated by 180 degrees)."
1898    :type 'boolean    :type 'boolean
1899    :version "21.1"    :version "21.1"
1900    :group 'ps-print-page)    :group 'ps-print-page)
# Line 1866  It's used when `ps-spool-config' is set Line 1902  It's used when `ps-spool-config' is set
1902  (defcustom ps-selected-pages nil  (defcustom ps-selected-pages nil
1903    "*Specify which pages to print.    "*Specify which pages to print.
1904    
1905  If it's nil, all pages are printed.  If nil, print all pages.
1906    
1907  If it's a list, the list element may be an integer or a cons cell (FROM . TO)  If a list, the lists element may be an integer or a cons cell (FROM . TO)
1908  designating FROM page to TO page; any invalid element is ignored, that is, an  designating FROM page to TO page; any invalid element is ignored, that is, an
1909  integer lesser than one or if FROM is greater than TO.  integer lesser than one or if FROM is greater than TO.
1910    
1911  Otherwise, it's treated as nil.  Otherwise, it's treated as nil.
1912    
1913  After ps-print processing `ps-selected-pages' is set to nil.  But the latest  After ps-print processing `ps-selected-pages' is set to nil.  But the
1914  `ps-selected-pages' is saved in `ps-last-selected-pages' (see it for  latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which
1915  documentation).  So you can restore the latest selected pages by using  see).  So you can restore the latest selected pages by using
1916  `ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see  `ps-last-selected-pages' or with the `ps-restore-selected-pages'
1917  it for documentation).  command (which see).
1918    
1919  See also `ps-even-or-odd-pages'."  See also `ps-even-or-odd-pages'."
1920    :type '(repeat :tag "Selected Pages"    :type '(repeat :tag "Selected Pages"
# Line 2035  Any other value is treated as `left-top' Line 2071  Any other value is treated as `left-top'
2071    :group 'ps-print-n-up)    :group 'ps-print-n-up)
2072    
2073  (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)  (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
2074    "*Specify the number of columns"    "*Specify the number of columns."
2075    :type 'number    :type 'number
2076    :group 'ps-print-miscellany)    :group 'ps-print-miscellany)
2077    
# Line 2195  page. Line 2231  page.
2231  If PAGES is nil, print background image on all pages.  If PAGES is nil, print background image on all pages.
2232    
2233  X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer  X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
2234  number or a string. If it is a string, the string should contain PostScript  number or a string.  If it is a string, the string should contain PostScript
2235  programming that returns a float or integer value.  programming that returns a float or integer value.
2236    
2237  For example, if you wish to print an EPS image on all pages do:  For example, if you wish to print an EPS image on all pages do:
# Line 2245  page. Line 2281  page.
2281  If PAGES is nil, print background text on all pages.  If PAGES is nil, print background text on all pages.
2282    
2283  X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer  X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
2284  number or a string. If it is a string, the string should contain PostScript  number or a string.  If it is a string, the string should contain PostScript
2285  programming that returns a float or integer value.  programming that returns a float or integer value.
2286    
2287  For example, if you wish to print text \"Preliminary\" on all pages do:  For example, if you wish to print text \"Preliminary\" on all pages do:
# Line 2320  For example, if you wish to print text \ Line 2356  For example, if you wish to print text \
2356    :group 'ps-print-vertical)    :group 'ps-print-vertical)
2357    
2358  (defcustom ps-header-line-pad 0.15  (defcustom ps-header-line-pad 0.15
2359    "*Portion of a header title line height to insert between the header frame    "*Portion of a header title line height to insert.
2360  and the text it contains, both in the vertical and horizontal directions."  The insertion is done between the header frame and the text it contains,
2361    both in the vertical and horizontal directions."
2362    :type 'number    :type 'number
2363    :group 'ps-print-vertical)    :group 'ps-print-vertical)
2364    
# Line 2331  and the text it contains, both in the ve Line 2368  and the text it contains, both in the ve
2368    :group 'ps-print-vertical)    :group 'ps-print-vertical)
2369    
2370  (defcustom ps-footer-line-pad 0.15  (defcustom ps-footer-line-pad 0.15
2371    "*Portion of a footer title line height to insert between the footer frame    "*Portion of a footer title line height to insert.
2372  and the text it contains, both in the vertical and horizontal directions."  The insertion is done between the footer frame and the text it contains,
2373    both in the vertical and horizontal directions."
2374    :type 'number    :type 'number
2375    :group 'ps-print-vertical)    :group 'ps-print-vertical)
2376    
# Line 2582  WARNING: The setpagedevice PostScript op Line 2620  WARNING: The setpagedevice PostScript op
2620           specified by setpagedevice, your printing will be aborted.           specified by setpagedevice, your printing will be aborted.
2621           So, if you need to use setpagedevice, set `ps-spool-config' to           So, if you need to use setpagedevice, set `ps-spool-config' to
2622           `setpagedevice', generate a test file and send it to your printer; if           `setpagedevice', generate a test file and send it to your printer; if
2623           the printed file isn't ok, set `ps-spool-config' to nil."           the printed file isn't OK, set `ps-spool-config' to nil."
2624    :type '(choice :menu-tag "Spool Config"    :type '(choice :menu-tag "Spool Config"
2625                   :tag "Spool Config"                   :tag "Spool Config"
2626                   (const lpr-switches) (const setpagedevice)                   (const lpr-switches) (const setpagedevice)
# Line 2718  It has effect only when `ps-spool-duplex Line 2756  It has effect only when `ps-spool-duplex
2756       (space-width . 2.2)       (space-width . 2.2)
2757       (avg-char-width . 4.10811))       (avg-char-width . 4.10811))
2758      )      )
2759    "*Font info database: font family (the key), name, bold, italic, bold-italic,    "*Font info database.
2760    Each element comprises: font family (the key), name, bold, italic, bold-italic,
2761  reference size, line height, space width, average character width.  reference size, line height, space width, average character width.
2762  To get the info for another specific font (say Helvetica), do the following:  To get the info for another specific font (say Helvetica), do the following:
2763  - create a new buffer  - create a new buffer
# Line 2852  uses the fonts resident in your printer. Line 2891  uses the fonts resident in your printer.
2891  ;;; Colors  ;;; Colors
2892    
2893  ;; Printing color requires x-color-values.  ;; Printing color requires x-color-values.
2894    ;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
2895    ;;                widget to work.
2896    ;;;###autoload
2897  (defcustom ps-print-color-p  (defcustom ps-print-color-p
2898    (or (and (fboundp 'color-values)      ; Emacs    (or (fboundp 'x-color-values)         ; Emacs
            (ps-e-color-values "Green"))  
       (fboundp 'x-color-values)         ; Emacs  
2899        (fboundp 'color-instance-rgb-components))        (fboundp 'color-instance-rgb-components))
2900                                          ; XEmacs                                          ; XEmacs
2901    "*Specify how buffer's text color is printed.    "*Specify how buffer's text color is printed.
# Line 2877  Any other value is treated as t." Line 2917  Any other value is treated as t."
2917                   (const :tag "Print Black/White Color" black-white))                   (const :tag "Print Black/White Color" black-white))
2918    :group 'ps-print-color)    :group 'ps-print-color)
2919    
2920  (defcustom ps-default-fg '(0.0 0.0 0.0)  (defcustom ps-default-fg '(0.0 0.0 0.0) ; black
2921    "*RGB values of the default foreground color.  Defaults to black."    "*RGB values of the default foreground color.  Defaults to black.
2922    
2923    The `ps-default-fg' variable contains the default foreground color used by
2924    ps-print, that is, if there is a face in a text that doesn't have a foreground
2925    color, the `ps-default-fg' color should be used.
2926    
2927    Valid values are:
2928    
2929       t            The foreground color of Emacs session will be used.
2930    
2931       NUMBER       It's a real value between 0.0 (black) and 1.0 (white) that
2932                    indicate the gray color.
2933    
2934       COLOR-NAME   It's a string wich contains the color name.  For example:
2935                    \"yellow\".
2936    
2937       LIST         It's a list of RGB values, that is a list of three real values
2938                    of the form:
2939    
2940                      (RED, GREEN, BLUE)
2941    
2942                    Where RED, GREEN and BLUE are reals between 0.0 (no color) and
2943                    1.0 (full color).
2944    
2945    Any other value is ignored and it's used the black color.
2946    
2947    It's used only when `ps-print-color-p' is non-nil."
2948    :type '(choice :menu-tag "Default Foreground Gray/Color"    :type '(choice :menu-tag "Default Foreground Gray/Color"
2949                   :tag "Default Foreground Gray/Color"                   :tag "Default Foreground Gray/Color"
2950                     (const :tag "Session Foreground" t)
2951                   (number :tag "Gray Scale" :value 0.0)                   (number :tag "Gray Scale" :value 0.0)
2952                   (string :tag "Color Name" :value "black")                   (string :tag "Color Name" :value "black")
2953                   (list :tag "RGB Color" :value (0.0 0.0 0.0)                   (list :tag "RGB Color" :value (0.0 0.0 0.0)
# Line 2889  Any other value is treated as t." Line 2956  Any other value is treated as t."
2956                         (number :tag "Blue")))                         (number :tag "Blue")))
2957    :group 'ps-print-color)    :group 'ps-print-color)
2958    
2959  (defcustom ps-default-bg '(1.0 1.0 1.0)  (defcustom ps-default-bg '(1.0 1.0 1.0) ; white
2960    "*RGB values of the default background color.  Defaults to white."    "*RGB values of the default background color.  Defaults to white.
2961    
2962    The `ps-default-bg' variable contains the default background color used by
2963    ps-print, that is, if there is a face in a text that doesn't have a background
2964    color, the `ps-default-bg' color should be used.
2965    
2966    Valid values are:
2967    
2968       t            The background color of Emacs session will be used.
2969    
2970       NUMBER       It's a real value between 0.0 (black) and 1.0 (white) that
2971                    indicate the gray color.
2972    
2973       COLOR-NAME   It's a string wich contains the color name.  For example:
2974                    \"yellow\".
2975    
2976       LIST         It's a list of RGB values, that is a list of three real values
2977                    of the form:
2978    
2979                      (RED, GREEN, BLUE)
2980    
2981                    Where RED, GREEN and BLUE are reals between 0.0 (no color) and
2982                    1.0 (full color).
2983    
2984    Any other value is ignored and it's used the white color.
2985    
2986    It's used only when `ps-print-color-p' is non-nil.
2987    
2988    See also `ps-use-face-background'."
2989    :type '(choice :menu-tag "Default Background Gray/Color"    :type '(choice :menu-tag "Default Background Gray/Color"
2990                   :tag "Default Background Gray/Color"                   :tag "Default Background Gray/Color"
2991                     (const :tag "Session Background" t)
2992                   (number :tag "Gray Scale" :value 1.0)                   (number :tag "Gray Scale" :value 1.0)
2993                   (string :tag "Color Name" :value "white")                   (string :tag "Color Name" :value "white")
2994                   (list :tag "RGB Color" :value (1.0 1.0 1.0)                   (list :tag "RGB Color" :value (1.0 1.0 1.0)
# Line 3040  There are the following basic functions Line 3136  There are the following basic functions
3136     `ps-time-stamp-mon-dd-yyyy'          Return date as \"Jun 18 2001\".     `ps-time-stamp-mon-dd-yyyy'          Return date as \"Jun 18 2001\".
3137    
3138  You can also create your own time stamp function by using `format-time-string'  You can also create your own time stamp function by using `format-time-string'
3139  (which see)."  \(which see)."
3140    :type '(repeat (choice :menu-tag "Right Header"    :type '(repeat (choice :menu-tag "Right Header"
3141                           :tag "Right Header"                           :tag "Right Header"
3142                           string symbol))                           string symbol))
# Line 3087  There are the following basic functions Line 3183  There are the following basic functions
3183     `ps-time-stamp-mon-dd-yyyy'          Return date as \"Jun 18 2001\".     `ps-time-stamp-mon-dd-yyyy'          Return date as \"Jun 18 2001\".
3184    
3185  You can also create your own time stamp function by using `format-time-string'  You can also create your own time stamp function by using `format-time-string'
3186  (which see)."  \(which see)."
3187    :version "21.1"    :version "21.1"
3188    :type '(repeat (choice :menu-tag "Right Footer"    :type '(repeat (choice :menu-tag "Right Footer"
3189                           :tag "Right Footer"                           :tag "Right Footer"
# Line 3136  It's like the very first character of bu Line 3232  It's like the very first character of bu
3232    :group 'ps-print-headers)    :group 'ps-print-headers)
3233    
3234  (defcustom ps-postscript-code-directory  (defcustom ps-postscript-code-directory
3235    (or (and (fboundp 'locate-data-directory) ; xemacs    (or (cond
3236             (locate-data-directory "ps-print"))         ((eq ps-print-emacs-type 'emacs) ; emacs
3237        data-directory)                   ; emacs          data-directory)
3238           ((fboundp 'locate-data-directory) ; xemacs
3239            (locate-data-directory "ps-print"))
3240           ((boundp 'data-directory)        ; xemacs
3241            data-directory)
3242           (t                               ; don't know what to do
3243            nil))
3244          (error "`ps-postscript-code-directory' isn't set properly"))
3245    "*Directory where it's located the PostScript prologue file used by ps-print.    "*Directory where it's located the PostScript prologue file used by ps-print.
3246  By default, this directory is the same as in the variable `data-directory'."  By default, this directory is the same as in the variable `data-directory'."
3247    :type 'directory    :type 'directory
# Line 3201  manual for more information. Line 3304  manual for more information.
3304  Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what  Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
3305  actually gets printed.  Both variables may be set to nil in which case no  actually gets printed.  Both variables may be set to nil in which case no
3306  cutting occurs."  cutting occurs."
3307    :type 'regexp    :type '(choice (const :tag "No Delimiter" nil)
3308                     (regexp :tag "Delimiter Regexp"))
3309    :version "21.1"    :version "21.1"
3310    :group 'ps-print-miscellany)    :group 'ps-print-miscellany)
3311    
# Line 3209  cutting occurs." Line 3313  cutting occurs."
3313    "*Specify regexp which is end of the region to cut out when printing.    "*Specify regexp which is end of the region to cut out when printing.
3314    
3315  See `ps-begin-cut-regexp' for more information."  See `ps-begin-cut-regexp' for more information."
3316    :type 'regexp    :type '(choice (const :tag "No Delimiter" nil)
3317                     (regexp :tag "Delimiter Regexp"))
3318    :version "21.1"    :version "21.1"
3319    :group 'ps-print-miscellany)    :group 'ps-print-miscellany)
3320    
# Line 3247  See `ps-begin-cut-regexp' for more infor Line 3352  See `ps-begin-cut-regexp' for more infor
3352  (defun ps-print-buffer (&optional filename)  (defun ps-print-buffer (&optional filename)
3353    "Generate and print a PostScript image of the buffer.    "Generate and print a PostScript image of the buffer.
3354    
3355  Interactively, when you use a prefix argument (C-u), the command prompts the  Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3356  user for a file name, and saves the PostScript image in that file instead of  user for a file name, and saves the PostScript image in that file instead of
3357  sending it to the printer.  sending it to the printer.
3358    
# Line 3334  Use the command `ps-despool' to send the Line 3439  Use the command `ps-despool' to send the
3439  (defun ps-despool (&optional filename)  (defun ps-despool (&optional filename)
3440    "Send the spooled PostScript to the printer.    "Send the spooled PostScript to the printer.
3441    
3442  Interactively, when you use a prefix argument (C-u), the command prompts the  Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3443  user for a file name, and saves the spooled PostScript image in that file  user for a file name, and saves the spooled PostScript image in that file
3444  instead of sending it to the printer.  instead of sending it to the printer.
3445    
# Line 3346  image in a file with that name." Line 3451  image in a file with that name."
3451    
3452  ;;;###autoload  ;;;###autoload
3453  (defun ps-line-lengths ()  (defun ps-line-lengths ()
3454    "Display the correspondence between a line length and a font size, using the    "Display the correspondence between a line length and a font size.
3455  current ps-print setup.  Done using the current ps-print setup.
3456  Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"  Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3457    (interactive)    (interactive)
3458    (ps-line-lengths-internal))    (ps-line-lengths-internal))
# Line 3517  generated is: Line 3622  generated is:
3622    
3623  If `ps-prefix-quote' is nil, it's set to t after generating string."  If `ps-prefix-quote' is nil, it's set to t after generating string."
3624    (cond    (cond
    ((null elt)    "")  
3625     ((stringp elt) elt)     ((stringp elt) elt)
3626     (t     ((and (consp elt) (integerp (car elt))
3627             (symbolp (cdr elt)) (boundp (cdr elt)))
3628      (let* ((col (car elt))      (let* ((col (car elt))
3629             (sym (cdr elt))             (sym (cdr elt))
3630             (key (symbol-name sym))             (key (symbol-name sym))
# Line 3537  If `ps-prefix-quote' is nil, it's set to Line 3642  If `ps-prefix-quote' is nil, it's set to
3642                      ((eq val t) "t")                      ((eq val t) "t")
3643                      ((or (symbolp val) (listp val)) (format "'%S" val))                      ((or (symbolp val) (listp val)) (format "'%S" val))
3644                      (t          (format "%S" val))))))                      (t          (format "%S" val))))))
3645       (t "")
3646     ))     ))
3647    
3648    
# Line 3594  It can be retrieved with `(ps-get ALIST- Line 3700  It can be retrieved with `(ps-get ALIST-
3700    
3701    
3702  (eval-and-compile  (eval-and-compile
3703    (defvar ps-print-emacs-type    (and (eq ps-print-emacs-type 'xemacs)
3704      (cond ((string-match "XEmacs" emacs-version) 'xemacs)         ;; XEmacs change: Need to check for emacs-major-version too.
3705            ((string-match "Lucid" emacs-version) 'lucid)         (or (< emacs-major-version 19)
3706            ((string-match "Epoch" emacs-version) 'epoch)             (and (= emacs-major-version 19) (< emacs-minor-version 12)))
3707            (t 'emacs)))         (setq ps-print-color-p nil))
   
   (if (memq ps-print-emacs-type '(lucid xemacs))  
       (if (< emacs-minor-version 12)  
           (setq ps-print-color-p nil))  
     (require 'faces))                   ; face-font, face-underline-p,  
                                         ; x-font-regexp  
3708    
3709    
3710    ;; Return t if the device (which can be changed during an emacs session)    ;; Return t if the device (which can be changed during an emacs session)
3711    ;; can handle colors.    ;; can handle colors.
3712    ;; This function is not yet implemented for GNU emacs.    ;; This function is not yet implemented for GNU emacs.
3713    (cond ((and (eq ps-print-emacs-type 'xemacs)    (cond ((and (eq ps-print-emacs-type 'xemacs)
3714                (>= emacs-minor-version 12)) ; xemacs                ;; XEmacs change: Need to check for emacs-major-version too.
3715                  (or (> emacs-major-version 19)
3716                      (and (= emacs-major-version 19)
3717                           (>= emacs-minor-version 12)))) ; xemacs >= 19.12
3718           (defun ps-color-device ()           (defun ps-color-device ()
3719             (eq (ps-x-device-class) 'color)))             (eq (ps-x-device-class) 'color)))
3720    
# Line 3642  It can be retrieved with `(ps-get ALIST- Line 3745  It can be retrieved with `(ps-get ALIST-
3745             (case-fold-search t))             (case-fold-search t))
3746        (and kind-spec (string-match kind-regex kind-spec))))        (and kind-spec (string-match kind-regex kind-spec))))
3747    
   (defun ps-xemacs-color-name (color)  
     (if (ps-x-color-specifier-p color)  
         (ps-x-color-name color)  
       color))  
   
3748    (cond ((eq ps-print-emacs-type 'emacs) ; emacs    (cond ((eq ps-print-emacs-type 'emacs) ; emacs
3749    
3750           (defun ps-color-values (x-color)           (defun ps-color-values (x-color)
# Line 3658  It can be retrieved with `(ps-get ALIST- Line 3756  It can be retrieved with `(ps-get ALIST-
3756              (t              (t
3757               (error "No available function to determine X color values"))))               (error "No available function to determine X color values"))))
3758    
          (defalias 'ps-face-foreground-name 'face-foreground)  
          (defalias 'ps-face-background-name 'face-background)  
   
3759           (defun ps-face-bold-p (face)           (defun ps-face-bold-p (face)
3760             (or (ps-e-face-bold-p face)             (or (ps-e-face-bold-p face)
3761                 (memq face ps-bold-faces)))                 (memq face ps-bold-faces)))
# Line 3669  It can be retrieved with `(ps-get ALIST- Line 3764  It can be retrieved with `(ps-get ALIST-
3764             (or (ps-e-face-italic-p face)             (or (ps-e-face-italic-p face)
3765                 (memq face ps-italic-faces)))                 (memq face ps-italic-faces)))
3766           )           )
3767                                          ; xemacs  
3768                                          ; lucid          (t                              ; xemacs
         (t                              ; epoch  
3769    
3770           ;; to avoid XEmacs compilation gripes           ;; to avoid XEmacs compilation gripes
3771           (defvar coding-system-for-write   nil)           (defvar coding-system-for-write   nil)
# Line 3696  It can be retrieved with `(ps-get ALIST- Line 3790  It can be retrieved with `(ps-get ALIST-
3790                (t                (t
3791                 (error "No available function to determine X color values")))))                 (error "No available function to determine X color values")))))
3792    
          (defun ps-face-foreground-name (face)  
            (ps-xemacs-color-name (face-foreground face)))  
   
          (defun ps-face-background-name (face)  
            (ps-xemacs-color-name (face-background face)))  
   
3793           (defun ps-face-bold-p (face)           (defun ps-face-bold-p (face)
3794             (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")             (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
3795                 (memq face ps-bold-faces))) ; Kludge-compatible                 (memq face ps-bold-faces))) ; Kludge-compatible
# Line 3727  It can be retrieved with `(ps-get ALIST- Line 3815  It can be retrieved with `(ps-get ALIST-
3815    
3816    
3817  (defun ps-prologue-file (filenumber)  (defun ps-prologue-file (filenumber)
3818    "If prologue FILENUMBER exists and is readable, returns contents as string.    "If prologue FILENUMBER exists and is readable, return contents as string.
3819    
3820  Note: No major/minor-mode is activated and no local variables are evaluated for  Note: No major/minor-mode is activated and no local variables are evaluated for
3821        FILENUMBER, but proper EOL-conversion and character interpretation is        FILENUMBER, but proper EOL-conversion and character interpretation is
# Line 3783  Note: No major/minor-mode is activated a Line 3871  Note: No major/minor-mode is activated a
3871    
3872  (defvar ps-current-font 0)  (defvar ps-current-font 0)
3873  (defvar ps-default-foreground nil)  (defvar ps-default-foreground nil)
3874    (defvar ps-default-background nil)
3875  (defvar ps-default-color nil)  (defvar ps-default-color nil)
3876  (defvar ps-current-color nil)  (defvar ps-current-color nil)
3877  (defvar ps-current-bg nil)  (defvar ps-current-bg nil)
# Line 3799  Note: No major/minor-mode is activated a Line 3888  Note: No major/minor-mode is activated a
3888        ;; PostScript output.        ;; PostScript output.
3889        "%0.3f %0.3f %0.3f"        "%0.3f %0.3f %0.3f"
3890    
3891      ;; Lucid emacsen will have to make do with %s (princ) for floats.      ;; XEmacs will have to make do with %s (princ) for floats.
3892      "%s %s %s"))      "%s %s %s"))
3893    
3894  ;; These values determine how much print-height to deduct when headers/footers  ;; These values determine how much print-height to deduct when headers/footers
# Line 3843  This is in units of points (1/72 inch)." Line 3932  This is in units of points (1/72 inch)."
3932  (defvar ps-black-white-faces-alist nil  (defvar ps-black-white-faces-alist nil
3933    "Alist of symbolic faces used for black/white PostScript printers.    "Alist of symbolic faces used for black/white PostScript printers.
3934  An element of this list has the same form as `ps-print-face-extension-alist'  An element of this list has the same form as `ps-print-face-extension-alist'
3935  (which see).  \(which see).
3936    
3937  Don't change this list directly; instead,  Don't change this list directly; instead,
3938  use `ps-extend-face' and `ps-extend-face-list'.  use `ps-extend-face' and `ps-extend-face-list'.
# Line 4138  which long lines wrap around." Line 4227  which long lines wrap around."
4227    (get font-sym 'avg-char-width))    (get font-sym 'avg-char-width))
4228    
4229  (defun ps-line-lengths-internal ()  (defun ps-line-lengths-internal ()
4230    "Display the correspondence between a line length and a font size,    "Display the correspondence between a line length and a font size.
4231  using the current ps-print setup.  Done using the current ps-print setup.
4232  Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"  Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
4233    (let* ((ps-font-size-internal    (let* ((ps-font-size-internal
4234            (or ps-font-size-internal            (or ps-font-size-internal
# Line 4408  page-height == ((floor print-height ((th Line 4497  page-height == ((floor print-height ((th
4497    
4498    
4499  (defun ps-print-preprint-region (prefix-arg)  (defun ps-print-preprint-region (prefix-arg)
4500    (or mark-active    (or (ps-mark-active-p)
4501        (error "The mark is not set now"))        (error "The mark is not set now"))
4502    (list (point) (mark) (ps-print-preprint prefix-arg)))    (list (point) (mark) (ps-print-preprint prefix-arg)))
4503    
# Line 4484  page-height == ((floor print-height ((th Line 4573  page-height == ((floor print-height ((th
4573    (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))    (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4574      (let ((special (following-char)))      (let ((special (following-char)))
4575        (delete-char 1)        (delete-char 1)
4576        (insert (aref ps-string-escape-codes special))))        (insert
4577           (if (and (<= 0 special) (<= special 255))
4578               (aref ps-string-escape-codes special)
4579             ;; insert hexadecimal representation if character code is out of range
4580             (format "\\%04X" special)
4581             ))))
4582    (goto-char (point-max))    (goto-char (point-max))
4583    (insert ")"))                         ;insert end-string delimiter    (insert ")"))                         ;insert end-string delimiter
4584    
# Line 4660  page-height == ((floor print-height ((th Line 4754  page-height == ((floor print-height ((th
4754    
4755  ;; Emacs understands the %f format; we'll use it to limit color RGB values  ;; Emacs understands the %f format; we'll use it to limit color RGB values
4756  ;; to three decimals to cut down some on the size of the PostScript output.  ;; to three decimals to cut down some on the size of the PostScript output.
4757  ;; Lucid emacsen will have to make do with %s (princ) for floats.  ;; XEmacs will have to make do with %s (princ) for floats.
4758    
4759  (defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)  (defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
4760                              "%0.3f "    ; emacs                              "%0.3f "    ; emacs
4761                            "%s "))       ; Lucid emacsen                            "%s "))       ; xemacs
4762    
4763    
4764  (defun ps-float-format (value &optional default)  (defun ps-float-format (value &optional default)
# Line 5346  XSTART YSTART are the relative position Line 5440  XSTART YSTART are the relative position
5440                 "/ZebraColor       "                 "/ZebraColor       "
5441                 (ps-format-color ps-zebra-color 0.95)                 (ps-format-color ps-zebra-color 0.95)
5442                 "def\n/BackgroundColor  "                 "def\n/BackgroundColor  "
5443                 (ps-format-color ps-default-bg 1.0)                 (ps-format-color ps-default-background 1.0)
5444                 "def\n/UseSetpagedevice "                 "def\n/UseSetpagedevice "
5445                 (if (eq ps-spool-config 'setpagedevice)                 (if (eq ps-spool-config 'setpagedevice)
5446                     "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"                     "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
# Line 5530  XSTART YSTART are the relative position Line 5624  XSTART YSTART are the relative position
5624    (ps-get-size (symbol-value font-sym) "font size" font-sym))    (ps-get-size (symbol-value font-sym) "font size" font-sym))
5625    
5626    
5627  (defsubst ps-rgb-color (color default)  (defun ps-rgb-color (color default)
5628    (cond ((and color (listp color)) color)    (cond ((and color (listp color) (= (length color) 3)
5629                  (let ((cl color)
5630                        (ok t) e)
5631                    (while (and ok cl)
5632                      (setq e  (car cl)
5633                            cl (cdr cl)
5634                            ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
5635                    ok))
5636             color)
5637            ((and (floatp color) (<= 0.0 color) (<= color 1.0))
5638             (list color color color))
5639          ((stringp color) (ps-color-scale color))          ((stringp color) (ps-color-scale color))
         ((numberp color) (list color color color))  
5640          (t (list default default default))          (t (list default default default))
5641          ))          ))
5642    
# Line 5607  XSTART YSTART are the relative position Line 5710  XSTART YSTART are the relative position
5710                ((eq ps-print-control-characters 'control)                ((eq ps-print-control-characters 'control)
5711                 "[\000-\037\177]")                 "[\000-\037\177]")
5712                (t "[\t\n\f]"))                (t "[\t\n\f]"))
5713          ps-default-foreground (ps-rgb-color ps-default-fg 0.0)          ps-default-background (ps-rgb-color
5714                                   (if (eq ps-default-bg t)
5715                                       (ps-face-background-name 'default)
5716                                     ps-default-bg)
5717                                   1.0)
5718            ps-default-foreground (ps-rgb-color
5719                                   (if (eq ps-default-fg t)
5720                                       (ps-face-foreground-name 'default)
5721                                     ps-default-fg)
5722                                   0.0)
5723          ps-default-color (and (eq ps-print-color-p t) ps-default-foreground)          ps-default-color (and (eq ps-print-color-p t) ps-default-foreground)
5724          ps-current-color ps-default-color          ps-current-color ps-default-color
5725          ;; Set the color scale.  We do it here instead of in the defvar so          ;; Set the color scale.  We do it here instead of in the defvar so
# Line 5618  XSTART YSTART are the relative position Line 5730  XSTART YSTART are the relative position
5730                                   (float (car (ps-color-values "white")))                                   (float (car (ps-color-values "white")))
5731                                 1.0))                                 1.0))
5732    ;; initialize page dimensions    ;; initialize page dimensions
5733    (ps-get-page-dimensions))    (ps-get-page-dimensions)
5734      ;; final check
5735      (and ps-color-p
5736           (equal ps-default-background ps-default-foreground)
5737           (error
5738            (concat
5739             "`ps-default-fg' and `ps-default-bg' have the same color.\n"
5740             "Text won't appear on page.  Please, check these variables."))))
5741    
5742    
5743  (defun ps-page-number ()  (defun ps-page-number ()
# Line 6154  If FACE is not a valid face name, it is Line 6273  If FACE is not a valid face name, it is
6273      (let ((face 'default)      (let ((face 'default)
6274            (position to))            (position to))
6275        (cond        (cond
6276         ((memq ps-print-emacs-type '(xemacs lucid))         ((eq ps-print-emacs-type 'xemacs)
6277          ;; Build the list of extents...          ;; Build the list of extents...
6278          (let ((a (cons 'dummy nil))          (let ((a (cons 'dummy nil))
6279                record type extent extent-list)                record type extent extent-list)

Legend:
Removed from v.1.126  
changed lines
  Added in v.1.126.4.1

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