-;;; ps-print.el --- Print text from the buffer as PostScript
+;;; ps-print.el --- print text from the buffer as PostScript
-;; Copyright (C) 1993,94,95,96,97,98,99,00,2001
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+;; 2003 Free Software Foundation, Inc.
-;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
-;; Author: Jacques Duthen (was <duthen@cegelec-red.fr>)
-;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Keywords: wp, print, PostScript
-;; Time-stamp: <2001/04/07 13:41:03 Vinicius>
-;; Version: 6.5.1
-;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
+;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
+;; Jacques Duthen (was <duthen@cegelec-red.fr>)
+;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Keywords: wp, print, PostScript
+;; Time-stamp: <2003/03/05 21:54:55 vinicius>
+;; Version: 6.6
+;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
-(defconst ps-print-version "6.5.1"
- "ps-print.el, v 6.5.1 <2001/04/07 vinicius>
+(defconst ps-print-version "6.6"
+ "ps-print.el, v 6.6 <2003/03/05 vinicius>
Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number. When reporting bugs, please also
report the version of Emacs, if any, that ps-print was distributed with.
Please send all bug fixes and enhancements to
- Vinicius Jose Latorre <vinicius@cpqd.com.br>.
-")
+ Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
;; This file is part of GNU Emacs.
;;
;; This package provides printing of Emacs buffers on PostScript printers; the
;; buffer's bold and italic text attributes are preserved in the printer
-;; output. ps-print is intended for use with Emacs or Lucid Emacs, together
-;; with a fontifying package such as font-lock or hilit.
+;; output. ps-print is intended for use with Emacs or XEmacs, together with a
+;; fontifying package such as font-lock or hilit.
;;
;; ps-print uses the same face attributes defined through font-lock or hilit to
;; print a PostScript file, but some faces are better seeing on the screen than
;; 11 8 5 2 11 8 5 2
;; 12 9 6 3 10 7 4 1
;;
-;; Any other value is treated as left-top.
+;; Any other value is treated as `left-top'.
;;
;; The default value is left-top.
;;
;; (face...) list of faces whose background color will be used.
;;
;; Any other value will be treated as t.
-;; The default value is t.
+;; The default value is nil.
;;
;;
;; How Ps-Print Deals With Color
;; embeds color information in the PostScript image.
;; The default foreground and background colors are defined by the variables
;; `ps-default-fg' and `ps-default-bg'.
-;; On black-and-white printers, colors are displayed in gray scale.
+;; On black/white printers, colors are displayed in gray scale.
;; To turn off color output, set `ps-print-color-p' to nil.
+;; You can also set `ps-print-color-p' to 'black-white to have a better looking
+;; on black/white printers. See also `ps-black-white-faces' for documentation.
;;
;;
;; How Ps-Print Maps Faces
;; New since version 2.8
;; ---------------------
;;
-;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;;
+;; 20010619
+;; `ps-time-stamp-locale-default'
+;;
+;; 20010530
+;; Handle before-string and after-string overlay properties.
;;
;; 20010407
;; `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
;;
;; `ps-print-region-function'
;;
-;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
;;
;; 19990301
;; PostScript tumble and setpagedevice.
;;
;; Multi-byte buffer handling.
;;
-;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
;;
;; 19980306
;; Skip invisible text.
;;
;; Faces are always treated as opaque.
;;
-;; Epoch and Emacs 19 not supported. At all.
+;; Epoch, Lucid and Emacs 19 not supported. At all.
;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
;; Acknowledgments
;; ---------------
;;
+;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
+;; for black/white PostScript printers.
+;;
;; Thanks to Toni Ronkko <tronkko@hytti.uku.fi> for line and paragraph spacing,
;; region to cut out when printing and footer suggestions.
;;
;;; Code:
(eval-and-compile
- (unless (featurep 'lisp-float-type)
- (error "`ps-print' requires floating point support"))
+ (require 'lpr)
+
+ (or (featurep 'lisp-float-type)
+ (error "`ps-print' requires floating point support"))
+
+
+ (defvar ps-print-emacs-type
+ (let ((case-fold-search t))
+ (cond ((string-match "XEmacs" emacs-version) 'xemacs)
+ ((string-match "Lucid" emacs-version)
+ (error "`ps-print' doesn't support Lucid"))
+ ((string-match "Epoch" emacs-version)
+ (error "`ps-print' doesn't support Epoch"))
+ (t
+ (unless (and (boundp 'emacs-major-version)
+ (> emacs-major-version 19))
+ (error "`ps-print' only supports Emacs 20 and higher"))
+ 'emacs))))
;; For Emacs 20.2 and the earlier version.
(defalias 'ps-e-next-overlay-change 'next-overlay-change)
(defalias 'ps-e-overlays-at 'overlays-at)
(defalias 'ps-e-overlay-get 'overlay-get)
+ (defalias 'ps-e-overlay-end 'overlay-end)
(defalias 'ps-e-x-color-values 'x-color-values)
(defalias 'ps-e-color-values 'color-values)
(if (fboundp 'find-composition)
(defconst ps-windows-system
(memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
(defconst ps-lp-system
- (memq system-type '(usq-unix-v dgux hpux irix))))
+ (memq system-type '(usg-unix-v dgux hpux irix)))
+
+
+ (defun ps-xemacs-color-name (color)
+ (if (ps-x-color-specifier-p color)
+ (ps-x-color-name color)
+ color))
+
+
+ (cond ((eq ps-print-emacs-type 'emacs) ; emacs
+ (defvar mark-active nil)
+ (defun ps-mark-active-p ()
+ mark-active)
+ (defalias 'ps-face-foreground-name 'face-foreground)
+ (defalias 'ps-face-background-name 'face-background)
+ )
+ (t ; xemacs
+ (defalias 'ps-mark-active-p 'region-active-p)
+ (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)))
+ )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
:tag "Background"
:group 'ps-print)
-(defgroup ps-print-printer nil
+(defgroup ps-print-printer '((lpr custom-group))
"Printer customization"
:prefix "ps-"
:tag "Printer"
;; Setting for HP PostScript printer
(setq ps-user-defined-prologue
(concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
- \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))
-"
+ \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
:type '(choice :menu-tag "User Defined Prologue"
:tag "User Defined Prologue"
(const :tag "none" nil) string symbol)
\"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
requirements and set %%LanguageLevel: to 2, do:
-(setq ps-print-prologue-header
- \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
+ (setq ps-print-prologue-header
+ \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
"-P" ))
"*Option for `ps-printer-name' variable (see it).
-On Unix-like systems, if it's been used lpr utility, it should be the string
-\"-P\"; if it's been used lp utility, it should be the string \"-d\".
+On Unix-like systems, if `lpr' is in use, this should be the string
+\"-P\"; if `lp' is in use, this should be the string \"-d\".
-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
the string \"/D:\".
-For any other printing utility, see the proper manual or documentation.
+For any other printing utility, see its documentation.
-Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty
-option printer name option.
+Set this to \"\" or nil, if the utility given by `ps-lpr-command'
+needs an empty printer name option--that is, pass the printer name
+with no special option preceding it.
-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.
This variable is used only when `ps-printer-name' is a non-empty string."
:type '(choice :menu-tag "Printer Name Option"
;; B4 10.125 inch x 14.33 inch
;; B5 7.16 inch x 10.125 inch
+;;;###autoload
(defcustom ps-page-dimensions-database
(list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
(list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
:group 'ps-print-page)
(defcustom ps-print-upside-down nil
- "*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)."
:type 'boolean
:version "21.1"
:group 'ps-print-page)
(defcustom ps-selected-pages nil
"*Specify which pages to print.
-If it's nil, all pages are printed.
+If nil, print all pages.
-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)
designating FROM page to TO page; any invalid element is ignored, that is, an
integer lesser than one or if FROM is greater than TO.
Otherwise, it's treated as nil.
-After ps-print processing `ps-selected-pages' is set to nil. But the latest
-`ps-selected-pages' is saved in `ps-last-selected-pages' (see it for
-documentation). So you can restore the latest selected pages by using
-`ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see
-it for documentation).
+After ps-print processing `ps-selected-pages' is set to nil. But the
+latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which
+see). So you can restore the latest selected pages by using
+`ps-last-selected-pages' or with the `ps-restore-selected-pages'
+command (which see).
See also `ps-even-or-odd-pages'."
:type '(repeat :tag "Selected Pages"
:group 'ps-print-n-up)
(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
- "*Specify the number of columns"
+ "*Specify the number of columns."
:type 'number
:group 'ps-print-miscellany)
22 + 22 +
-------- ----------- --------- ----------------
-Any other value is treated as `nil'."
+Any other value is treated as nil."
:type '(choice :menu-tag "Zebra Stripe Follow"
:tag "Zebra Stripe Follow"
(const :tag "Always Restart" nil)
If PAGES is nil, print background image on all pages.
X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
-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
programming that returns a float or integer value.
For example, if you wish to print an EPS image on all pages do:
If PAGES is nil, print background text on all pages.
X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
-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
programming that returns a float or integer value.
For example, if you wish to print text \"Preliminary\" on all pages do:
:group 'ps-print-vertical)
(defcustom ps-header-line-pad 0.15
- "*Portion of a header title line height to insert between the header frame
-and the text it contains, both in the vertical and horizontal directions."
+ "*Portion of a header title line height to insert.
+The insertion is done between the header frame and the text it contains,
+both in the vertical and horizontal directions."
:type 'number
:group 'ps-print-vertical)
:group 'ps-print-vertical)
(defcustom ps-footer-line-pad 0.15
- "*Portion of a footer title line height to insert between the footer frame
-and the text it contains, both in the vertical and horizontal directions."
+ "*Portion of a footer title line height to insert.
+The insertion is done between the footer frame and the text it contains,
+both in the vertical and horizontal directions."
:type 'number
:group 'ps-print-vertical)
:group 'ps-print-headers)
(defcustom ps-header-frame-alist
- '((fore-color . 0)
+ '((fore-color . 0.0)
(back-color . 0.9)
(border-width . 0.4)
- (border-color . 0)
- (shadow-color . 0))
+ (border-color . 0.0)
+ (shadow-color . 0.0))
"*Specify header frame properties alist.
Valid frame properties are:
(const :format "" fore-color)
(choice :menu-tag "Foreground Color"
:tag "Foreground Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" border-color)
(choice :menu-tag "Border Color"
:tag "Border Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" shadow-color)
(choice :menu-tag "Shadow Color"
:tag "Shadow Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))))
:group 'ps-print-headers)
(defcustom ps-footer-frame-alist
- '((fore-color . 0)
+ '((fore-color . 0.0)
(back-color . 0.9)
(border-width . 0.4)
- (border-color . 0)
- (shadow-color . 0))
+ (border-color . 0.0)
+ (shadow-color . 0.0))
"*Specify footer frame properties alist.
Don't change this alist directly, instead use customization, or `ps-value',
(const :format "" fore-color)
(choice :menu-tag "Foreground Color"
:tag "Foreground Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" border-color)
(choice :menu-tag "Border Color"
:tag "Border Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" shadow-color)
(choice :menu-tag "Shadow Color"
:tag "Shadow Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))))
specified by setpagedevice, your printing will be aborted.
So, if you need to use setpagedevice, set `ps-spool-config' to
`setpagedevice', generate a test file and send it to your printer; if
- the printed file isn't ok, set `ps-spool-config' to nil."
+ the printed file isn't OK, set `ps-spool-config' to nil."
:type '(choice :menu-tag "Spool Config"
:tag "Spool Config"
(const lpr-switches) (const setpagedevice)
(space-width . 2.2)
(avg-char-width . 4.10811))
)
- "*Font info database: font family (the key), name, bold, italic, bold-italic,
+ "*Font info database.
+Each element comprises: font family (the key), name, bold, italic, bold-italic,
reference size, line height, space width, average character width.
To get the info for another specific font (say Helvetica), do the following:
- create a new buffer
;;; Colors
;; Printing color requires x-color-values.
+;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
+;; widget to work.
+;;;###autoload
(defcustom ps-print-color-p
- (or (and (fboundp 'color-values) ; Emacs
- (ps-e-color-values "Green"))
- (fboundp 'x-color-values) ; Emacs
+ (or (fboundp 'x-color-values) ; Emacs
(fboundp 'color-instance-rgb-components))
; XEmacs
- "*Non-nil means print the buffer's text in color."
- :type 'boolean
+ "*Specify how buffer's text color is printed.
+
+Valid values are:
+
+ nil Do not print colors.
+
+ t Print colors.
+
+ black-white Print colors on black/white printer.
+ See also `ps-black-white-faces'.
+
+Any other value is treated as t."
+ :type '(choice :menu-tag "Print Color"
+ :tag "Print Color"
+ (const :tag "Do NOT Print Color" nil)
+ (const :tag "Print Always Color" t)
+ (const :tag "Print Black/White Color" black-white))
:group 'ps-print-color)
-(defcustom ps-default-fg '(0.0 0.0 0.0)
- "*RGB values of the default foreground color. Defaults to black."
+(defcustom ps-default-fg '(0.0 0.0 0.0) ; black
+ "*RGB values of the default foreground color. Defaults to black.
+
+The `ps-default-fg' variable contains the default foreground color used by
+ps-print, that is, if there is a face in a text that doesn't have a foreground
+color, the `ps-default-fg' color should be used.
+
+Valid values are:
+
+ t The foreground color of Emacs session will be used.
+
+ NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
+ indicate the gray color.
+
+ COLOR-NAME It's a string wich contains the color name. For example:
+ \"yellow\".
+
+ LIST It's a list of RGB values, that is a list of three real values
+ of the form:
+
+ (RED, GREEN, BLUE)
+
+ Where RED, GREEN and BLUE are reals between 0.0 (no color) and
+ 1.0 (full color).
+
+Any other value is ignored and it's used the black color.
+
+It's used only when `ps-print-color-p' is non-nil."
:type '(choice :menu-tag "Default Foreground Gray/Color"
:tag "Default Foreground Gray/Color"
+ (const :tag "Session Foreground" t)
(number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
(list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Blue")))
:group 'ps-print-color)
-(defcustom ps-default-bg '(1.0 1.0 1.0)
- "*RGB values of the default background color. Defaults to white."
+(defcustom ps-default-bg '(1.0 1.0 1.0) ; white
+ "*RGB values of the default background color. Defaults to white.
+
+The `ps-default-bg' variable contains the default background color used by
+ps-print, that is, if there is a face in a text that doesn't have a background
+color, the `ps-default-bg' color should be used.
+
+Valid values are:
+
+ t The background color of Emacs session will be used.
+
+ NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
+ indicate the gray color.
+
+ COLOR-NAME It's a string wich contains the color name. For example:
+ \"yellow\".
+
+ LIST It's a list of RGB values, that is a list of three real values
+ of the form:
+
+ (RED, GREEN, BLUE)
+
+ Where RED, GREEN and BLUE are reals between 0.0 (no color) and
+ 1.0 (full color).
+
+Any other value is ignored and it's used the white color.
+
+It's used only when `ps-print-color-p' is non-nil.
+
+See also `ps-use-face-background'."
:type '(choice :menu-tag "Default Background Gray/Color"
:tag "Default Background Gray/Color"
+ (const :tag "Session Background" t)
(number :tag "Gray Scale" :value 1.0)
(string :tag "Color Name" :value "white")
(list :tag "RGB Color" :value (1.0 1.0 1.0)
:type 'boolean
:group 'ps-print-font)
+(defcustom ps-black-white-faces
+ '((font-lock-builtin-face "black" nil bold )
+ (font-lock-comment-face "gray20" nil italic)
+ (font-lock-constant-face "black" nil bold )
+ (font-lock-function-name-face "black" nil bold )
+ (font-lock-keyword-face "black" nil bold )
+ (font-lock-string-face "black" nil italic)
+ (font-lock-type-face "black" nil italic)
+ (font-lock-variable-name-face "black" nil bold italic)
+ (font-lock-warning-face "black" nil bold italic))
+ "*Specify list of face attributes to print colors on black/white printers.
+
+The list elements are the same as defined on `ps-extend-face' (which see).
+
+This variable is used only when `ps-print-color-p' is set to `black-white'."
+ :version "21.1"
+ :type '(repeat
+ (list :tag "Face Specification"
+ (face :tag "Face Symbol")
+ (choice :menu-tag "Foreground Color"
+ :tag "Foreground Color"
+ (const :tag "Black" nil)
+ (string :tag "Color Name"))
+ (choice :menu-tag "Background Color"
+ :tag "Background Color"
+ (const :tag "None" nil)
+ (string :tag "Color Name"))
+ (repeat :inline t
+ (choice :menu-tag "Attribute"
+ (const bold)
+ (const italic)
+ (const underline)
+ (const strikeout)
+ (const overline)
+ (const shadow)
+ (const box)
+ (const outline)))))
+ :group 'ps-print-face)
+
(defcustom ps-bold-faces
(unless ps-print-color-p
'(font-lock-function-name-face
(defcustom ps-right-header
(list "/pagenumberstring load"
- 'ps-time-stamp-mon-dd-yyyy 'ps-time-stamp-hh:mm:ss)
+ 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
"*The items to display (each on a line) on the right part of the page header.
This applies to generating PostScript.
See the variable `ps-left-header' for a description of the format of this
-variable."
+variable.
+
+There are the following basic functions implemented:
+
+ `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
+ as, for example, \"06/18/01\".
+
+ `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
+
+ `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
+
+You can also create your own time stamp function by using `format-time-string'
+\(which see)."
:type '(repeat (choice :menu-tag "Right Header"
:tag "Right Header"
string symbol))
(defcustom ps-right-footer
(list "/pagenumberstring load"
- 'ps-time-stamp-mon-dd-yyyy 'ps-time-stamp-hh:mm:ss)
+ 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
"*The items to display (each on a line) on the right part of the page footer.
This applies to generating PostScript.
See the variable `ps-left-footer' for a description of the format of this
-variable."
+variable.
+
+There are the following basic functions implemented:
+
+ `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
+ as, for example, \"06/18/01\".
+
+ `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
+
+ `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
+
+You can also create your own time stamp function by using `format-time-string'
+\(which see)."
:version "21.1"
:type '(repeat (choice :menu-tag "Right Footer"
:tag "Right Footer"
:group 'ps-print-headers)
(defcustom ps-postscript-code-directory
- (or (and (fboundp 'locate-data-directory) ; xemacs
- (locate-data-directory "ps-print"))
- data-directory) ; emacs
+ (or (cond
+ ((eq ps-print-emacs-type 'emacs) ; emacs
+ data-directory)
+ ((fboundp 'locate-data-directory) ; xemacs
+ (locate-data-directory "ps-print"))
+ ((boundp 'data-directory) ; xemacs
+ data-directory)
+ (t ; don't know what to do
+ nil))
+ (error "`ps-postscript-code-directory' isn't set properly"))
"*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
:type 'directory
Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
actually gets printed. Both variables may be set to nil in which case no
cutting occurs."
- :type 'regexp
+ :type '(choice (const :tag "No Delimiter" nil)
+ (regexp :tag "Delimiter Regexp"))
:version "21.1"
:group 'ps-print-miscellany)
"*Specify regexp which is end of the region to cut out when printing.
See `ps-begin-cut-regexp' for more information."
- :type 'regexp
+ :type '(choice (const :tag "No Delimiter" nil)
+ (regexp :tag "Delimiter Regexp"))
:version "21.1"
:group 'ps-print-miscellany)
(defun ps-print-buffer (&optional filename)
"Generate and print a PostScript image of the buffer.
-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
user for a file name, and saves the PostScript image in that file instead of
sending it to the printer.
(defun ps-print-region (from to &optional filename)
"Generate and print a PostScript image of the region.
Like `ps-print-buffer', but prints just the current region."
- (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
+ (interactive (ps-print-preprint-region current-prefix-arg))
(ps-print-without-faces from to filename t))
Like `ps-print-region', but includes font, color, and underline information in
the generated image. This command works only if you are using a window system,
so it has a way to determine color values."
- (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
+ (interactive (ps-print-preprint-region current-prefix-arg))
(ps-print-with-faces from to filename t))
(defun ps-despool (&optional filename)
"Send the spooled PostScript to the printer.
-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
user for a file name, and saves the spooled PostScript image in that file
instead of sending it to the printer.
;;;###autoload
(defun ps-line-lengths ()
- "Display the correspondence between a line length and a font size, using the
-current ps-print setup.
+ "Display the correspondence between a line length and a font size.
+Done using the current ps-print setup.
Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
(interactive)
(ps-line-lengths-internal))
(defun ps-nb-pages-buffer (nb-lines)
"Display number of pages to print this buffer, for various font heights.
The table depends on the current ps-print setup."
- (interactive (list (count-lines (point-min) (point-max))))
+ (interactive (ps-count-lines-preprint (point-min) (point-max)))
(ps-nb-pages nb-lines))
;;;###autoload
(defun ps-nb-pages-region (nb-lines)
"Display number of pages to print the region, for various font heights.
The table depends on the current ps-print setup."
- (interactive (list (count-lines (mark) (point))))
+ (interactive (ps-count-lines-preprint (mark) (point)))
(ps-nb-pages nb-lines))
+(defvar ps-prefix-quote nil
+ "Used for `ps-print-quote' (which see).")
+
;;;###autoload
(defun ps-setup ()
"Return the current PostScript-generation setup."
- (let (prefix)
+ (let (ps-prefix-quote)
(mapconcat
- #'(lambda (elt)
- (cond
- ((null elt) "")
- ((stringp elt) elt)
- (t
- (let* ((col (car elt))
- (sym (cdr elt))
- (key (symbol-name sym))
- (len (length key))
- (val (symbol-value sym)))
- (concat (if prefix
- prefix
- (setq prefix " ")
- "(setq ")
- key
- (if (> col len)
- (make-string (- col len) ?\ )
- " ")
- (cond ((null val) "nil")
- ((eq val t) "t")
- ((or (symbolp val) (listp val)) (format "'%S" val))
- (t (format "%S" val))))))
- ))
+ #'ps-print-quote
(list
(concat "\n;;; ps-print version " ps-print-version "\n")
'(25 . ps-print-color-p)
'(20 . ps-bold-faces)
'(20 . ps-italic-faces)
'(20 . ps-underlined-faces)
- ")\n
+ '(20 . ps-black-white-faces)
+ " )\n
;; The following customized variables have long lists and are seldom modified:
;; ps-page-dimensions-database
;; ps-font-info-database
;; Utility functions and variables:
+(defun ps-print-quote (elt)
+ "Quote ELT for printing (used for showing settings).
+
+If ELT is nil, return an empty string.
+If ELT is string, return it.
+Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
+LEN is the field length where SYM name will be inserted. The variable
+`ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
+used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
+generated is:
+
+ * If `ps-prefix-quote' is nil:
+ \"(setq SYM-NAME SYM-VALUE\"
+ |<------->|
+ LEN
+
+ * If `ps-prefix-quote' is non-nil:
+ \" SYM-NAME SYM-VALUE\"
+ |<------->|
+ LEN
+
+If `ps-prefix-quote' is nil, it's set to t after generating string."
+ (cond
+ ((stringp elt) elt)
+ ((and (consp elt) (integerp (car elt))
+ (symbolp (cdr elt)) (boundp (cdr elt)))
+ (let* ((col (car elt))
+ (sym (cdr elt))
+ (key (symbol-name sym))
+ (len (length key))
+ (val (symbol-value sym)))
+ (concat (if ps-prefix-quote
+ " "
+ (setq ps-prefix-quote t)
+ "(setq ")
+ key
+ (if (> col len)
+ (make-string (- col len) ?\ )
+ " ")
+ (cond ((null val) "nil")
+ ((eq val t) "t")
+ ((or (symbolp val) (listp val)) (format "'%S" val))
+ (t (format "%S" val))))))
+ (t "")
+ ))
+
+
(defun ps-value (alist-sym key)
"Return value from association list ALIST-SYM which car is `eq' to KEY."
(cdr (assq key (symbol-value alist-sym))))
(symbol-value alist-sym))
+(defun ps-time-stamp-locale-default ()
+ "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
+ (format-time-string "%x"))
+
+
(defun ps-time-stamp-mon-dd-yyyy ()
+ "Return date as \"Jun 18 2001\"."
(format-time-string "%b %d %Y"))
(defun ps-time-stamp-hh:mm:ss ()
+ "Return time as \"17:28:31\"."
(format-time-string "%T"))
(eval-and-compile
- (defvar ps-print-emacs-type
- (cond ((string-match "XEmacs" emacs-version) 'xemacs)
- ((string-match "Lucid" emacs-version) 'lucid)
- ((string-match "Epoch" emacs-version) 'epoch)
- (t 'emacs)))
-
- (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
+ (and (eq ps-print-emacs-type 'xemacs)
+ ;; XEmacs change: Need to check for emacs-major-version too.
+ (or (< emacs-major-version 19)
+ (and (= emacs-major-version 19) (< emacs-minor-version 12)))
+ (setq ps-print-color-p nil))
;; Return t if the device (which can be changed during an emacs session)
;; can handle colors.
;; This function is not yet implemented for GNU emacs.
(cond ((and (eq ps-print-emacs-type 'xemacs)
- (>= emacs-minor-version 12)) ; xemacs
+ ;; XEmacs change: Need to check for emacs-major-version too.
+ (or (> emacs-major-version 19)
+ (and (= emacs-major-version 19)
+ (>= emacs-minor-version 12)))) ; xemacs >= 19.12
(defun ps-color-device ()
(eq (ps-x-device-class) 'color)))
(case-fold-search t))
(and kind-spec (string-match kind-regex kind-spec))))
- (defun ps-xemacs-color-name (color)
- (if (ps-x-color-specifier-p color)
- (ps-x-color-name color)
- color))
-
(cond ((eq ps-print-emacs-type 'emacs) ; emacs
- ;; to avoid XEmacs compilation gripes
- (defvar coding-system-for-write nil)
-
(defun ps-color-values (x-color)
(cond
((fboundp 'color-values)
((fboundp 'x-color-values)
(ps-e-x-color-values x-color))
(t
- (error "No available function to determine X color values."))))
-
- (defalias 'ps-face-foreground-name 'face-foreground)
- (defalias 'ps-face-background-name 'face-background)
+ (error "No available function to determine X color values"))))
(defun ps-face-bold-p (face)
(or (ps-e-face-bold-p face)
(or (ps-e-face-italic-p face)
(memq face ps-italic-faces)))
)
- ; xemacs
- ; lucid
- (t ; epoch
+
+ (t ; xemacs
+
+ ;; to avoid XEmacs compilation gripes
+ (defvar coding-system-for-write nil)
+ (defvar coding-system-for-read nil)
+ (defvar buffer-file-coding-system nil)
(and (fboundp 'find-coding-system)
(or (ps-x-find-coding-system 'raw-text-unix)
x-color
(ps-x-make-color-instance color))))
(t
- (error "No available function to determine X color values.")))))
-
- (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)))
+ (error "No available function to determine X color values")))))
(defun ps-face-bold-p (face)
(or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
(defun ps-prologue-file (filenumber)
- "If prologue FILENUMBER exists and is readable, returns contents as string.
+ "If prologue FILENUMBER exists and is readable, return contents as string.
Note: No major/minor-mode is activated and no local variables are evaluated for
FILENUMBER, but proper EOL-conversion and character interpretation is
(with-temp-buffer
(insert-file-contents filename)
(buffer-string))
- (error "ps-print PostScript prologue `%s' file was not found."
+ (error "ps-print PostScript prologue `%s' file was not found"
filename))))
(defvar ps-current-font 0)
(defvar ps-default-foreground nil)
+(defvar ps-default-background nil)
(defvar ps-default-color nil)
(defvar ps-current-color nil)
(defvar ps-current-bg nil)
;; PostScript output.
"%0.3f %0.3f %0.3f"
- ;; Lucid emacsen will have to make do with %s (princ) for floats.
+ ;; XEmacs will have to make do with %s (princ) for floats.
"%s %s %s"))
;; These values determine how much print-height to deduct when headers/footers
;; Internal Variables
+(defvar ps-black-white-faces-alist nil
+ "Alist of symbolic faces used for black/white PostScript printers.
+An element of this list has the same form as `ps-print-face-extension-alist'
+\(which see).
+
+Don't change this list directly; instead,
+use `ps-extend-face' and `ps-extend-face-list'.
+See documentation for `ps-extend-face' for valid extension symbol.
+See also documentation for `ps-print-color-p'.")
+
+
(defvar ps-print-face-extension-alist nil
"Alist of symbolic faces *WITH* extension features (box, outline, etc).
An element of this list has the following form:
;;;###autoload
-(defun ps-extend-face-list (face-extension-list &optional merge-p)
- "Extend face in `ps-print-face-extension-alist'.
+(defun ps-extend-face-list (face-extension-list &optional merge-p alist-sym)
+ "Extend face in ALIST-SYM.
If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
-with face extension in `ps-print-face-extension-alist'; otherwise, overrides.
+with face extension in ALIST-SYM; otherwise, overrides.
+
+If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
+otherwise, it should be an alist symbol.
The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
See `ps-extend-face' for documentation."
(while face-extension-list
- (ps-extend-face (car face-extension-list) merge-p)
+ (ps-extend-face (car face-extension-list) merge-p alist-sym)
(setq face-extension-list (cdr face-extension-list))))
;;;###autoload
-(defun ps-extend-face (face-extension &optional merge-p)
- "Extend face in `ps-print-face-extension-alist'.
+(defun ps-extend-face (face-extension &optional merge-p alist-sym)
+ "Extend face in ALIST-SYM.
If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
-with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
+with face extensions in ALIST-SYM; otherwise, overrides.
+
+If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
+otherwise, it should be an alist symbol.
The elements of FACE-EXTENSION list have the form:
outline - print characters as hollow outlines.
If EXTENSION is any other symbol, it is ignored."
- (let* ((face-name (nth 0 face-extension))
- (foreground (nth 1 face-extension))
- (background (nth 2 face-extension))
- (ps-face (cdr (assq face-name ps-print-face-extension-alist)))
+ (or alist-sym
+ (setq alist-sym 'ps-print-face-extension-alist))
+ (let* ((background (nth 2 face-extension))
+ (foreground (nth 1 face-extension))
+ (face-name (nth 0 face-extension))
+ (ps-face (cdr (assq face-name (symbol-value alist-sym))))
(face-vector (or ps-face (vector 0 nil nil)))
- (face-bit (ps-extension-bit face-extension)))
+ (face-bit (ps-extension-bit face-extension)))
;; extend face
(aset face-vector 0 (if merge-p
(logior (aref face-vector 0) face-bit)
face-bit))
- (and foreground (stringp foreground) (aset face-vector 1 foreground))
- (and background (stringp background) (aset face-vector 2 background))
+ (and (or (not merge-p) (and foreground (stringp foreground)))
+ (aset face-vector 1 foreground))
+ (and (or (not merge-p) (and background (stringp background)))
+ (aset face-vector 2 background))
;; if face does not exist, insert it
(or ps-face
- (setq ps-print-face-extension-alist
- (cons (cons face-name face-vector)
- ps-print-face-extension-alist)))))
+ (set alist-sym (cons (cons face-name face-vector)
+ (symbol-value alist-sym))))))
(defun ps-extension-bit (face-extension)
(setq face-spec (cons ':background
(cons background face-spec))))
(when bold-p
- (setq face-spec (append '(:bold t) face-spec)))
+ (setq face-spec (append '(:weight bold) face-spec)))
(when italic-p
- (setq face-spec (append '(:italic t) face-spec)))
+ (setq face-spec (append '(:slant italic) face-spec)))
(when underline-p
(setq face-spec (append '(:underline t) face-spec)))
(custom-declare-face face (list (list t face-spec)) nil)
(ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
+(defun ps-count-lines-preprint (from to)
+ (or (and from to)
+ (error "The mark is not set now"))
+ (list (count-lines from to)))
+
+
(defun ps-count-lines (from to)
(+ (count-lines from to)
(save-excursion
(get font-sym 'avg-char-width))
(defun ps-line-lengths-internal ()
- "Display the correspondence between a line length and a font size,
-using the current ps-print setup.
+ "Display the correspondence between a line length and a font size.
+Done using the current ps-print setup.
Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
(let* ((ps-font-size-internal
(or ps-font-size-internal
ps-line-spacing-internal
ps-print-height))))))
+
+(defun ps-print-preprint-region (prefix-arg)
+ (or (ps-mark-active-p)
+ (error "The mark is not set now"))
+ (list (point) (mark) (ps-print-preprint prefix-arg)))
+
+
(defun ps-print-preprint (prefix-arg)
(and prefix-arg
(or (numberp prefix-arg)
(while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
(let ((special (following-char)))
(delete-char 1)
- (insert (aref ps-string-escape-codes special))))
+ (insert
+ (if (and (<= 0 special) (<= special 255))
+ (aref ps-string-escape-codes special)
+ ;; insert hexadecimal representation if character code is out of range
+ (format "\\%04X" special)
+ ))))
(goto-char (point-max))
(insert ")")) ;insert end-string delimiter
(defun ps-output-frame-properties (name alist)
(ps-output "/" name " ["
- (ps-format-color (cdr (assq 'fore-color alist)) 0)
+ (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
(ps-format-color (cdr (assq 'back-color alist)) 0.9)
(ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
- (ps-format-color (cdr (assq 'border-color alist)) 0)
- (ps-format-color (cdr (assq 'shadow-color alist)) 0)
+ (ps-format-color (cdr (assq 'border-color alist)) 0.0)
+ (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
"]def\n"))
;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
-;; Lucid emacsen will have to make do with %s (princ) for floats.
+;; XEmacs will have to make do with %s (princ) for floats.
(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
"%0.3f " ; emacs
- "%s ")) ; Lucid emacsen
+ "%s ")) ; xemacs
(defun ps-float-format (value &optional default)
(let ((literal (or value default)))
- (if literal
- (format (if (numberp literal)
- ps-float-format
- "%s ")
- literal)
- " ")))
+ (cond ((null literal)
+ " ")
+ ((numberp literal)
+ (format ps-float-format (* literal 1.0))) ; force float number
+ (t
+ (format "%s " literal))
+ )))
(defun ps-background-text ()
"/ZebraColor "
(ps-format-color ps-zebra-color 0.95)
"def\n/BackgroundColor "
- (ps-format-color ps-default-bg 1.0)
+ (ps-format-color ps-default-background 1.0)
"def\n/UseSetpagedevice "
(if (eq ps-spool-config 'setpagedevice)
"/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
(if (and the-color (listp the-color))
(concat "["
(format ps-color-format
- (nth 0 the-color)
- (nth 1 the-color)
- (nth 2 the-color))
+ (* (nth 0 the-color) 1.0) ; force float number
+ (* (nth 1 the-color) 1.0) ; force float number
+ (* (nth 2 the-color) 1.0)) ; force float number
"] ")
(ps-float-format (if (numberp the-color) the-color default)))))
(ps-get-size (symbol-value font-sym) "font size" font-sym))
-(defsubst ps-rgb-color (color default)
- (cond ((and color (listp color)) color)
+(defun ps-rgb-color (color default)
+ (cond ((and color (listp color) (= (length color) 3)
+ (let ((cl color)
+ (ok t) e)
+ (while (and ok cl)
+ (setq e (car cl)
+ cl (cdr cl)
+ ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
+ ok))
+ color)
+ ((and (floatp color) (<= 0.0 color) (<= color 1.0))
+ (list color color color))
((stringp color) (ps-color-scale color))
- ((numberp color) (list color color color))
(t (list default default default))
))
((eq ps-print-control-characters 'control)
"[\000-\037\177]")
(t "[\t\n\f]"))
- ps-default-foreground (ps-rgb-color ps-default-fg 0.0)
- ps-default-color (and ps-print-color-p ps-default-foreground)
+ ps-default-background (ps-rgb-color
+ (if (eq ps-default-bg t)
+ (ps-face-background-name 'default)
+ ps-default-bg)
+ 1.0)
+ ps-default-foreground (ps-rgb-color
+ (if (eq ps-default-fg t)
+ (ps-face-foreground-name 'default)
+ ps-default-fg)
+ 0.0)
+ ps-default-color (and (eq ps-print-color-p t) ps-default-foreground)
ps-current-color ps-default-color
;; Set the color scale. We do it here instead of in the defvar so
;; that ps-print can be dumped into emacs. This expression can't be
(float (car (ps-color-values "white")))
1.0))
;; initialize page dimensions
- (ps-get-page-dimensions))
+ (ps-get-page-dimensions)
+ ;; final check
+ (and ps-color-p
+ (equal ps-default-background ps-default-foreground)
+ (error
+ (concat
+ "`ps-default-fg' and `ps-default-bg' have the same color.\n"
+ "Text won't appear on page. Please, check these variables."))))
(defun ps-page-number ()
(cons to (* todo char-width))
(cons (+ from avail) ps-width-remaining))))
+(defun ps-basic-plot-str (from to string)
+ (let* ((wrappoint (ps-find-wrappoint from to
+ (ps-avg-char-width 'ps-font-for-text)))
+ (to (car wrappoint))
+ (str (substring string from to)))
+ (ps-mule-prepare-ascii-font str)
+ (ps-output-string str)
+ (ps-output " S\n")
+ wrappoint))
+
(defun ps-basic-plot-string (from to &optional bg-color)
(let* ((wrappoint (ps-find-wrappoint from to
(ps-avg-char-width 'ps-font-for-text)))
" FG\n"))
+(defsubst ps-plot-string (string)
+ (ps-plot 'ps-basic-plot-str 0 (length string) string))
+
+
(defvar ps-current-effect 0)
(defun ps-plot-region (from to font &optional fg-color bg-color effects)
- (if (not (equal font ps-current-font))
+ (or (equal font ps-current-font)
(ps-set-font font))
;; Specify a foreground color only if one's specified and it's
;; different than the current.
- (if (not (equal fg-color ps-current-color))
- (ps-set-color fg-color))
+ (let ((fg (or fg-color ps-default-foreground)))
+ (or (equal fg ps-current-color)
+ (ps-set-color fg)))
- (if (not (equal bg-color ps-current-bg))
+ (or (equal bg-color ps-current-bg)
(ps-set-bg bg-color))
;; Specify effects (underline, overline, box, etc)
If FACE is not a valid face name, it is used default face."
(cond
+ (ps-black-white-faces-alist
+ (or (and (symbolp face)
+ (cdr (assq face ps-black-white-faces-alist)))
+ (vector 0 nil nil)))
((symbolp face)
(cdr (or (assq face ps-print-face-extension-alist)
(assq face ps-print-face-alist)
ps-build-face-reference)
(message "Collecting face information...")
(ps-build-reference-face-lists))
+
+ ;; Black/white printer.
+ (setq ps-black-white-faces-alist nil)
+ (and (eq ps-print-color-p 'black-white)
+ (ps-extend-face-list ps-black-white-faces nil
+ 'ps-black-white-faces-alist))
+
;; Generate some PostScript.
(save-restriction
(narrow-to-region from to)
(let ((face 'default)
(position to))
(cond
- ((memq ps-print-emacs-type '(xemacs lucid))
+ ((eq ps-print-emacs-type 'xemacs)
;; Build the list of extents...
(let ((a (cons 'dummy nil))
record type extent extent-list)
(let ((property-change from)
(overlay-change from)
(save-buffer-invisibility-spec buffer-invisibility-spec)
- (buffer-invisibility-spec nil))
+ (buffer-invisibility-spec nil)
+ before-string after-string)
(while (< from to)
(and (< property-change to) ; Don't search for property change
; unless previous search succeeded.
; unless previous search succeeded.
(setq overlay-change (min (ps-e-next-overlay-change from)
to)))
- (setq position (min property-change overlay-change))
+ (setq position (min property-change overlay-change)
+ before-string nil
+ after-string nil)
;; The code below is not quite correct,
;; because a non-nil overlay invisible property
;; which is inactive according to the current value
(while (and overlays
(not (eq face 'emacs--invisible--face)))
(let* ((overlay (car overlays))
- (overlay-invisible (ps-e-overlay-get overlay 'invisible))
- (overlay-priority (or (ps-e-overlay-get overlay 'priority)
- 0)))
+ (overlay-invisible
+ (ps-e-overlay-get overlay 'invisible))
+ (overlay-priority
+ (or (ps-e-overlay-get overlay 'priority) 0)))
(and (> overlay-priority face-priority)
- (setq face
- (cond ((if (eq save-buffer-invisibility-spec t)
- (not (null overlay-invisible))
- (or (memq overlay-invisible
- save-buffer-invisibility-spec)
- (assq overlay-invisible
- save-buffer-invisibility-spec)))
- 'emacs--invisible--face)
- ((ps-e-overlay-get overlay 'face))
- (t face))
- face-priority overlay-priority)))
+ (setq before-string
+ (or (ps-e-overlay-get overlay 'before-string)
+ before-string)
+ after-string
+ (or (and (<= (ps-e-overlay-end overlay) position)
+ (ps-e-overlay-get overlay 'after-string))
+ after-string)
+ face-priority overlay-priority
+ face
+ (cond
+ ((if (eq save-buffer-invisibility-spec t)
+ (not (null overlay-invisible))
+ (or (memq overlay-invisible
+ save-buffer-invisibility-spec)
+ (assq overlay-invisible
+ save-buffer-invisibility-spec)))
+ 'emacs--invisible--face)
+ ((ps-e-overlay-get overlay 'face))
+ (t face)
+ ))))
(setq overlays (cdr overlays))))
;; Plot up to this record.
+ (and before-string
+ (ps-plot-string before-string))
(ps-plot-with-face from position face)
+ (and after-string
+ (ps-plot-string after-string))
(setq from position)))))
(ps-plot-with-face from to face))))