;;; ps-print.el --- print text from the buffer as PostScript
-;; Copyright (C) 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2014 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
report the version of Emacs, if any, that ps-print was distributed with.
Please send all bug fixes and enhancements to
- Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
;; This file is part of GNU Emacs.
(error "`ps-print' only supports Emacs 23 and higher")))
-(defconst ps-windows-system
- (memq system-type '(ms-dos windows-nt)))
-(defconst ps-lp-system
- (memq system-type '(usg-unix-v hpux irix)))
-
-
;; Load XEmacs/Emacs definitions
(require 'ps-def)
:version "20"
:group 'ps-print-miscellany)
-(defcustom ps-printer-name (and (boundp 'printer-name)
- (symbol-value 'printer-name))
+(defcustom ps-printer-name nil
"The name of a local printer for printing PostScript files.
On Unix-like systems, a string value should be a name understood by lpr's -P
:group 'ps-print-printer)
(defcustom ps-printer-name-option
- (cond (ps-windows-system
- "/D:")
- (ps-lp-system
- "-d")
- (t
- "-P" ))
+ (cond (lpr-windows-system "/D:")
+ (t lpr-printer-switch))
"Option for `ps-printer-name' variable (see it).
On Unix-like systems, if `lpr' is in use, this should be the string
needs an empty printer name option--that is, pass the printer name
with no special option preceding it.
-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"
:tag "Printer Name Option"
:version "20"
:group 'ps-print-printer)
-(defcustom ps-print-region-function nil
+(defcustom ps-print-region-function
+ (if (memq system-type '(ms-dos windows-nt))
+ #'w32-direct-ps-print-region-function
+ #'call-process-region)
"Specify a function to print the region on a PostScript printer.
See definition of `call-process-region' for calling conventions. The fourth
and the sixth arguments are both nil."
- :type '(choice (const nil) function)
+ :type 'function
:version "20"
:group 'ps-print-printer)
:version "20"
:group 'ps-print-printer)
-(defcustom ps-end-with-control-d (and ps-windows-system t)
+(defcustom ps-end-with-control-d (and lpr-windows-system t)
"Non-nil means insert C-d at end of PostScript file generated."
:version "21.1"
:type 'boolean
Any other value is treated as nil.
-If you set `ps-selected-pages' (see it for documentation), first the pages are
-filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
-example, if we have:
+If you set option `ps-selected-pages', first the pages are
+filtered by option `ps-selected-pages' and then by `ps-even-or-odd-pages'.
+For example, if we have:
(setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
-Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
+Combining with `ps-even-or-odd-pages' and option `ps-n-up-printing', we have:
`ps-n-up-printing' = 1:
`ps-even-or-odd-pages' PAGES PRINTED
:group 'ps-print-headers)
(defcustom ps-spool-config
- (if ps-windows-system
+ (if lpr-windows-system
nil
'lpr-switches)
"Specify who is responsible for setting duplex and page size.
This variable is used only when `ps-print-color-p' (which see) is neither nil
nor black-white."
:type '(choice :menu-tag "Default Foreground Gray/Color"
- :tag "Default Foreground Gray/Color"
(const :tag "Session Foreground" t)
(const :tag "Frame Foreground" frame-parameter)
(number :tag "Gray Scale" :value 0.0)
(list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
- (number :tag "Blue")))
+ (number :tag "Blue"))
+ (other :tag "Default Foreground Gray/Color" nil))
:version "20"
:group 'ps-print-color)
See also `ps-use-face-background'."
:type '(choice :menu-tag "Default Background Gray/Color"
- :tag "Default Background Gray/Color"
(const :tag "Session Background" t)
(const :tag "Frame Background" frame-parameter)
(number :tag "Gray Scale" :value 1.0)
(list :tag "RGB Color" :value (1.0 1.0 1.0)
(number :tag "Red")
(number :tag "Green")
- (number :tag "Blue")))
+ (number :tag "Blue"))
+ (other :tag "Default Background Gray/Color" nil))
:version "20"
:group 'ps-print-color)
:group 'ps-print-headers)
(defcustom ps-postscript-code-directory
- (or (if (featurep 'xemacs)
- (cond ((fboundp 'locate-data-directory) ; XEmacs
- (funcall 'locate-data-directory "ps-print"))
- ((boundp 'data-directory) ; XEmacs
- (symbol-value 'data-directory))
- (t ; don't know what to do
- nil))
- data-directory) ; Emacs
- (error "`ps-postscript-code-directory' isn't set properly"))
+ (cond ((fboundp 'locate-data-directory) ; XEmacs
+ (locate-data-directory "ps-print"))
+ ((boundp 'data-directory) ; XEmacs and Emacs.
+ data-directory)
+ (t ; don't know what to do
+ (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
;;;###autoload
(defun ps-spool-buffer-with-faces ()
"Generate and spool a PostScript image of the buffer.
-Like `ps-spool-buffer', 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.
+Like the command `ps-spool-buffer', 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.
Use the command `ps-despool' to send the spooled images to the printer."
(interactive)
") ps-print version " ps-print-version "\n")
";; internal vars"
(ps-comment-string "emacs-version " emacs-version)
- (ps-comment-string "ps-windows-system " ps-windows-system)
- (ps-comment-string "ps-lp-system " ps-lp-system)
+ (ps-comment-string "lpr-windows-system" lpr-windows-system)
nil
'(25 . ps-print-color-p)
'(25 . ps-lpr-command)
(KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
Where:
-KIND is a valid value of `ps-n-up-filling'.
+KIND is a valid value of the variable `ps-n-up-filling'.
XCOL YCOL are the relative position for the next column.
XLIN YLIN are the relative position for the beginning of next line.
REPEAT is the number of repetitions for external loop.
"%%Title: " (buffer-name) ; Take job name from name of
; first buffer printed
"\n%%Creator: ps-print v" ps-print-version
- "\n%%For: " (user-full-name)
- "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
+ "\n%%For: " (user-full-name) ;FIXME: may need encoding!
+ "\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding!
"\n%%Orientation: "
(if ps-landscape-mode "Landscape" "Portrait")
"\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
(goto-char from)
;; ...break the region up into chunks separated by tabs, linefeeds,
- ;; pagefeeds, control characters, and plot each chunk.
+ ;; formfeeds, control characters, and plot each chunk.
(while (< from to)
;; skip lines between cut markers
(and ps-begin-cut-regexp ps-end-cut-regexp
;; only background color, not a `real' face
((ps-face-background-color-p (car face-or-list))
(vector 0 nil (ps-face-extract-color face-or-list)))
+ ;; Anonymous face.
+ ((keywordp (car face-or-list))
+ (vector 0 (plist-get face-or-list :foreground)
+ (plist-get face-or-list :background)))
;; list of faces
(t
(let ((effects 0)
(save-restriction
(narrow-to-region from to)
(ps-print-ensure-fontified from to)
+ (deactivate-mark) ;bug#16866.
(ps-generate-postscript-with-faces1 from to)))
(defun ps-generate-postscript (from to)
(write-region (point-min) (point-max) filename))
(and ps-razzle-dazzle (message "Wrote %s" filename)))
;; Else, spool to the printer
- (and ps-razzle-dazzle (message "Printing..."))
(with-current-buffer ps-spool-buffer
(let* ((coding-system-for-write 'raw-text-unix)
- (ps-printer-name (or ps-printer-name
- (and (boundp 'printer-name)
- (symbol-value 'printer-name))))
- (ps-lpr-switches
- (append ps-lpr-switches
- (and (stringp ps-printer-name)
- (string< "" ps-printer-name)
- (list (concat
- (and (stringp ps-printer-name-option)
- ps-printer-name-option)
- ps-printer-name))))))
- (or (stringp ps-printer-name)
- (setq ps-printer-name nil))
- (apply (or ps-print-region-function 'call-process-region)
- (point-min) (point-max) ps-lpr-command nil
- (and (fboundp 'start-process) 0)
- nil
- (ps-flatten-list ; dynamic evaluation
- (ps-string-list
- (mapcar 'ps-eval-switch ps-lpr-switches))))))
- (and ps-razzle-dazzle (message "Printing...done")))
+ (printer-name (or ps-printer-name printer-name))
+ (lpr-printer-switch ps-printer-name-option)
+ (print-region-function ps-print-region-function)
+ (lpr-command ps-lpr-command))
+ (lpr-print-region (point-min) (point-max) ps-lpr-switches nil))))
(kill-buffer ps-spool-buffer)))
-(defun ps-string-list (arg)
- (let (lstr)
- (dolist (elm arg)
- (cond ((stringp elm)
- (setq lstr (cons elm lstr)))
- ((listp elm)
- (let ((s (ps-string-list elm)))
- (when s
- (setq lstr (cons s lstr)))))
- (t ))) ; ignore any other value
- (nreverse lstr)))
-
-;; Dynamic evaluation
-(defun ps-eval-switch (arg)
- (cond ((stringp arg) arg)
- ((functionp arg) (apply arg nil))
- ((symbolp arg) (symbol-value arg))
- ((consp arg) (apply (car arg) (cdr arg)))
- (t nil)))
-
-;; `ps-flatten-list' is defined here (copied from "message.el" and
-;; enhanced to handle dotted pairs as well) until we can get some
-;; sensible autoloads, or `flatten-list' gets put somewhere decent.
-
-;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
-;; => (a b c d e f g h i j)
-
-(defun ps-flatten-list (&rest list)
- (ps-flatten-list-1 list))
-
-(defun ps-flatten-list-1 (list)
- (cond ((null list) nil)
- ((consp list) (append (ps-flatten-list-1 (car list))
- (ps-flatten-list-1 (cdr list))))
- (t (list list))))
-
(defun ps-kill-emacs-check ()
- (let (ps-buffer)
- (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
- (buffer-name ps-buffer) ; check if it's not killed
+ (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
+ (and (buffer-live-p ps-buffer)
(buffer-modified-p ps-buffer)
(y-or-n-p "Unprinted PostScript waiting; print now? ")
- (ps-despool))
- (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
- (buffer-name ps-buffer) ; check if it's not killed
+ (ps-despool)))
+ (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
+ (and (buffer-live-p ps-buffer)
(buffer-modified-p ps-buffer)
(not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
(error "Unprinted PostScript"))))
-(cond ((fboundp 'add-hook)
- (unless noninteractive
- (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)))
- (kill-emacs-hook
- (message "Won't override existing `kill-emacs-hook'"))
- (t
- (setq kill-emacs-hook 'ps-kill-emacs-check)))
+(unless noninteractive
+ (add-hook 'kill-emacs-hook #'ps-kill-emacs-check))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; To make this file smaller, some commands go in a separate file.
;; But autoload them here to make the separation invisible.
\f
-;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
-;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "86bf8e46dac41afe73df5ab098038ab0")
+;;;### (autoloads nil "ps-mule" "ps-mule.el" "173235d6520575a877c25be437fb9e5f")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
HCoop / bpt / emacs.git / blobdiff