(print-region-function): Don't default to nil.
(lpr-print-region): New function, extracted from print-region-1.
Check lpr's return value and signal an error in case of problem.
(print-region-1): Use it.
* lisp/ps-print.el (ps-windows-system, ps-lp-system): Remove. Use the lpr-*
versions instead.
(ps-printer-name): Default to nil.
(ps-printer-name-option): Default to lpr-printer-switch.
(ps-print-region-function): Don't default to nil.
(ps-postscript-code-directory): Simplify default.
(ps-do-despool): Use lpr-print-region to properly check the outcome.
(ps-string-list, ps-eval-switch, ps-flatten-list)
(ps-flatten-list-1): Remove.
(ps-multibyte-buffer): Avoid setq.
* lisp/dos-w32.el (direct-print-region-helper): Use proper regexp operators.
(print-region-function, ps-print-region-function): Don't set them here.
+2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lpr.el: Signal print errors more prominently.
+ (print-region-function): Don't default to nil.
+ (lpr-print-region): New function, extracted from print-region-1.
+ Check lpr's return value and signal an error in case of problem.
+ (print-region-1): Use it.
+ * ps-print.el (ps-windows-system, ps-lp-system): Remove. Use the lpr-*
+ versions instead.
+ (ps-printer-name): Default to nil.
+ (ps-printer-name-option): Default to lpr-printer-switch.
+ (ps-print-region-function): Don't default to nil.
+ (ps-postscript-code-directory): Simplify default.
+ (ps-do-despool): Use lpr-print-region to properly check the outcome.
+ (ps-string-list, ps-eval-switch, ps-flatten-list)
+ (ps-flatten-list-1): Remove.
+ (ps-multibyte-buffer): Avoid setq.
+ * dos-w32.el (direct-print-region-helper): Use proper regexp operators.
+ (print-region-function, ps-print-region-function): Don't set them here.
+
2013-07-24 Xue Fuqiao <xfq.free@gmail.com>
* ansi-color.el: Fix old URL.
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
(defun direct-print-region-helper (printer
- start end
- lpr-prog
- _delete-text _buf _display
- rest)
+ start end
+ lpr-prog
+ _delete-text _buf _display
+ rest)
(let* (;; Ignore case when matching known external program names.
(case-fold-search t)
;; Convert / to \ in printer name, for sake of external programs.
(unwind-protect
(cond
;; nprint.exe is the standard print command on Netware
- ((string-match-p "^nprint\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+ ((string-match-p "\\`nprint\\(\\.exe\\)?\\'"
+ (file-name-nondirectory lpr-prog))
(write-region start end tempfile nil 0)
(call-process lpr-prog nil errbuf nil
tempfile (concat "P=" printer)))
;; print.exe is a standard command on NT
- ((string-match-p "^print\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+ ((string-match-p "\\`print\\(\\.exe\\)?\\'"
+ (file-name-nondirectory lpr-prog))
;; Be careful not to invoke print.exe on MS-DOS or Windows 9x
;; though, because it is a TSR program there (hangs Emacs).
(or (and (eq system-type 'windows-nt)
(write-region-annotate-functions
(cons
(lambda (_start end)
- (if (not (char-equal (char-before end) ?\C-l))
+ (if (not (char-equal (char-before end) ?\f))
`((,end . "\f"))))
write-region-annotate-functions))
(printer (or (and (boundp 'dos-printer)
(direct-print-region-helper printer start end lpr-prog
delete-text buf display rest)))
-(defvar print-region-function)
(defvar lpr-headers-switches)
-(setq print-region-function 'direct-print-region-function)
;; Set this to nil if you have a port of the `pr' program
;; (e.g., from GNU Textutils), or if you have an `lpr'
(direct-print-region-helper printer start end lpr-prog
delete-text buf display rest)))
-(defvar ps-print-region-function)
-(setq ps-print-region-function 'direct-ps-print-region-function)
-
;(setq ps-lpr-command "gs")
;(setq ps-lpr-switches '("-q" "-dNOPAUSE" "-sDEVICE=epson" "-r240x60"
(repeat :tag "Multiple arguments" (string :tag "Argument")))
:group 'lpr)
-(defcustom print-region-function nil
+(defcustom print-region-function
+ (if (memq system-type '(ms-dos windows-nt))
+ #'direct-print-region-function
+ #'call-process-region)
"Function to call to print the region on a printer.
See definition of `print-region-1' for calling conventions."
- :type '(choice (const nil) function)
+ :type 'function
:group 'lpr)
(defcustom lpr-page-header-program "pr"
(print-region-1 start end lpr-switches t))
(defun print-region-1 (start end switches page-headers)
+ (and page-headers lpr-headers-switches
+ ;; It's possible to use an lpr option to get page headers.
+ (setq switches (append (if (stringp lpr-headers-switches)
+ (list lpr-headers-switches)
+ lpr-headers-switches)
+ switches)))
;; On some MIPS system, having a space in the job name
;; crashes the printer demon. But using dashes looks ugly
;; and it seems to annoying to do for that MIPS system.
- (let ((name (concat (buffer-name) " Emacs buffer"))
- (title (concat (buffer-name) " Emacs buffer"))
- ;; Make pipes use the same coding system as
- ;; writing the buffer to a file would.
- (coding-system-for-write (or coding-system-for-write
- buffer-file-coding-system))
- (coding-system-for-read (or coding-system-for-read
- buffer-file-coding-system))
- (width tab-width)
- nswitches
- switch-string)
- (save-excursion
- (and page-headers lpr-headers-switches
- ;; It's possible to use an lpr option to get page headers.
- (setq switches (append (if (stringp lpr-headers-switches)
- (list lpr-headers-switches)
- lpr-headers-switches)
- switches)))
- (setq nswitches (lpr-flatten-list
- (mapcar 'lpr-eval-switch ; Dynamic evaluation
- switches))
- switch-string (if switches
- (concat " with options "
- (mapconcat 'identity switches " "))
- ""))
- (message "Spooling%s..." switch-string)
+ (save-excursion
+ (let ((name (concat (buffer-name) " Emacs buffer"))
+ ;; Make pipes use the same coding system as
+ ;; writing the buffer to a file would.
+ (coding-system-for-write (or coding-system-for-write
+ buffer-file-coding-system))
+ (coding-system-for-read (or coding-system-for-read
+ buffer-file-coding-system))
+ (width tab-width))
(if (/= tab-width 8)
(let ((new-coords (print-region-new-buffer start end)))
(setq start (car new-coords)
(let ((new-coords (print-region-new-buffer start end)))
(apply 'call-process-region (car new-coords) (cdr new-coords)
lpr-page-header-program t t nil
- (mapcar (lambda (e) (format e title))
+ (mapcar (lambda (e) (format e name))
lpr-page-header-switches)))
(setq start (point-min)
end (point-max))))
- (let ((buf (current-buffer)))
- (with-temp-buffer
- (let ((tempbuf (current-buffer)))
- (with-current-buffer buf
- (apply (or print-region-function 'call-process-region)
- (nconc (list start end lpr-command
- nil tempbuf nil)
- (and lpr-add-switches
- (list "-J" name))
- ;; These belong in pr if we are using that.
- (and lpr-add-switches lpr-headers-switches
- (list "-T" title))
- (and (stringp printer-name)
- (list (concat lpr-printer-switch
- printer-name)))
- nswitches))))
- (if (markerp end)
- (set-marker end nil))
- (message "Spooling%s...done%s%s" switch-string
- (pcase (count-lines (point-min) (point-max))
- (0 "")
- (1 ": ")
- (_ ":\n"))
- (buffer-string)))))))
+ (lpr-print-region start end switches name))))
+
+(defun lpr-print-region (start end switches name)
+ (let ((buf (current-buffer))
+ (nswitches (lpr-flatten-list
+ (mapcar #'lpr-eval-switch ; Dynamic evaluation
+ switches)))
+ (switch-string (if switches
+ (concat " with options "
+ (mapconcat #'identity switches " "))
+ "")))
+ (message "Spooling%s..." switch-string)
+ (with-temp-buffer
+ (let ((retval
+ (let ((tempbuf (current-buffer)))
+ (with-current-buffer buf
+ (apply (or print-region-function 'call-process-region)
+ start end lpr-command
+ nil tempbuf nil
+ (nconc (and name lpr-add-switches
+ (list "-J" name))
+ ;; These belong in pr if we are using that.
+ (and name lpr-add-switches lpr-headers-switches
+ (list "-T" name))
+ (and (stringp printer-name)
+ (string< "" printer-name)
+ (list (concat lpr-printer-switch
+ printer-name)))
+ nswitches))))))
+ (if (markerp end)
+ (set-marker end nil))
+ (funcall (if (memq retval '(nil 0)) #'message #'user-error)
+ "Spooling%s...done%s%s" switch-string
+ (pcase (count-lines (point-min) (point-max))
+ (0 "")
+ (1 ": ")
+ (_ ":\n"))
+ (buffer-string))))))
;; This function copies the text between start and end
;; into a new buffer, makes that buffer current.
;; Dynamic evaluation
(defun lpr-eval-switch (arg)
(cond ((stringp arg) arg)
- ((functionp arg) (apply arg nil))
+ ((functionp arg) (funcall arg))
((symbolp arg) (symbol-value arg))
((consp arg) (apply (car arg) (cdr arg)))
(t nil)))
(defun lpr-flatten-list-1 (list)
(cond
- ((null list) (list))
+ ((null list) nil)
((consp list)
(append (lpr-flatten-list-1 (car list))
(lpr-flatten-list-1 (cdr list))))
(= (skip-chars-forward "\x00-\x7F" to) to)))
;; All characters can be printed by normal PostScript fonts.
(setq ps-basic-plot-string-function 'ps-basic-plot-string
+ ;; FIXME: Doesn't ps-encode-header-string-function take 2 args?
ps-encode-header-string-function 'identity)
(setq ps-basic-plot-string-function 'ps-mule-plot-string
ps-encode-header-string-function 'ps-mule-encode-header-string
(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))
+ #'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
: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.
: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
") 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)
"%%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 "
(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" "b39f881d3a029049994ef6aa3de93c89")
+;;;### (autoloads nil "ps-mule" "ps-mule.el" "a90e8414a27ac8fdf093251ac648d761")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
projects / emacs.git / commitdiff