;;; printing.el --- printing utilities
-;; Copyright (C) 2000-2001, 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2003-2014 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
"printing.el, v 6.9.3 <2007/12/09 vinicius>
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.
;; To avoid compilation gripes
-(or (fboundp 'subst-char-in-string) ; hacked from subr.el
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+;; Emacs has this since at least 21.1.
+(when (featurep 'xemacs)
+ (or (fboundp 'subst-char-in-string) ; hacked from subr.el
+ (defun subst-char-in-string (fromchar tochar string &optional inplace)
+ "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> (setq i (1- i)) 0)
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-
-(or (fboundp 'make-temp-file) ; hacked from subr.el
- (defun make-temp-file (prefix &optional dir-flag suffix)
+ (let ((i (length string))
+ (newstr (if inplace string (copy-sequence string))))
+ (while (> (setq i (1- i)) 0)
+ (if (eq (aref newstr i) fromchar)
+ (aset newstr i tochar)))
+ newstr))))
+
+
+;; Emacs has this since at least 21.1, but the SUFFIX argument
+;; (which this file uses) only since 22.1. So the fboundp test
+;; wasn't even correct/adequate. Whatever, no-one is using
+;; this file on older Emacs version, so it's irrelevant.
+(when (featurep 'xemacs)
+ (or (fboundp 'make-temp-file) ; hacked from subr.el
+ (defun make-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
of PREFIX, and expanding against `temporary-file-directory' if necessary),
nil)
file)
;; Reset the umask.
- (set-default-file-modes umask)))))
+ (set-default-file-modes umask))))))
(eval-when-compile
(defmacro pr-save-file-modes (&rest body)
- "Set temporally file modes to `pr-file-modes'."
- `(let ((pr--default-file-modes (default-file-modes))) ; save default
- (set-default-file-modes pr-file-modes)
- ,@body
- (set-default-file-modes pr--default-file-modes))) ; restore default
-
+ "Execute BODY with file permissions temporarily set to `pr-file-modes'."
+ (declare (obsolete with-file-modes "24.5"))
+ `(with-file-modes pr-file-modes ,@body))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keys & Menus
(defalias 'pr-get-symbol
- (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el
- 'easy-menu-intern
- (lambda (s) (if (stringp s) (intern s) s))))
+ (if (featurep 'emacs) 'easy-menu-intern ; since 22.1
+ (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el
+ 'easy-menu-intern
+ (lambda (s) (if (stringp s) (intern s) s)))))
(defconst pr-menu-spec
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name."
(interactive (list (ps-print-preprint current-prefix-arg)))
- (pr-save-file-modes
- (let ((ps-lpr-command (pr-command pr-ps-command))
- (ps-lpr-switches pr-ps-switches)
- (ps-printer-name-option pr-ps-printer-switch)
- (ps-printer-name pr-ps-printer))
- (ps-despool filename))))
+ (with-file-modes pr-file-modes
+ (let ((ps-lpr-command (pr-command pr-ps-command))
+ (ps-lpr-switches pr-ps-switches)
+ (ps-printer-name-option pr-ps-printer-switch)
+ (ps-printer-name pr-ps-printer))
+ (ps-despool filename))))
;;;###autoload
(goto-char (point-max))
(insert (format "%s %S\n" cmd args)))
;; *Printing Command Output* == show any return message from command
- (pr-save-file-modes
- (setq status
- (condition-case data
- (apply 'call-process cmd nil buffer nil args)
- ((quit error)
- (error-message-string data)))))
+ (with-file-modes pr-file-modes
+ (setq status
+ (condition-case data
+ (apply 'call-process cmd nil buffer nil args)
+ ((quit error)
+ (error-message-string data)))))
;; *Printing Command Output* == show exit status
(with-current-buffer buffer
(goto-char (point-max))
(defun pr-text2ps (kind n-up filename &optional from to)
- (pr-save-file-modes
- (let ((ps-n-up-printing n-up)
- (ps-spool-config (and (eq ps-spool-config 'setpagedevice)
- 'setpagedevice)))
- (pr-delete-file-if-exists filename)
- (cond (pr-faces-p
- (cond (pr-spool-p
- ;; pr-faces-p and pr-spool-p
- ;; here FILENAME arg is ignored
- (cond ((eq kind 'buffer)
- (ps-spool-buffer-with-faces))
- ((eq kind 'region)
- (ps-spool-region-with-faces (or from (point))
- (or to (mark))))
- ))
- ;; pr-faces-p and not pr-spool-p
- ((eq kind 'buffer)
- (ps-print-buffer-with-faces filename))
- ((eq kind 'region)
- (ps-print-region-with-faces (or from (point))
- (or to (mark)) filename))
- ))
- (pr-spool-p
- ;; not pr-faces-p and pr-spool-p
- ;; here FILENAME arg is ignored
- (cond ((eq kind 'buffer)
- (ps-spool-buffer))
- ((eq kind 'region)
- (ps-spool-region (or from (point)) (or to (mark))))
- ))
- ;; not pr-faces-p and not pr-spool-p
- ((eq kind 'buffer)
- (ps-print-buffer filename))
- ((eq kind 'region)
- (ps-print-region (or from (point)) (or to (mark)) filename))
- ))))
+ (with-file-modes pr-file-modes
+ (let ((ps-n-up-printing n-up)
+ (ps-spool-config (and (eq ps-spool-config 'setpagedevice)
+ 'setpagedevice)))
+ (pr-delete-file-if-exists filename)
+ (cond (pr-faces-p
+ (cond (pr-spool-p
+ ;; pr-faces-p and pr-spool-p
+ ;; here FILENAME arg is ignored
+ (cond ((eq kind 'buffer)
+ (ps-spool-buffer-with-faces))
+ ((eq kind 'region)
+ (ps-spool-region-with-faces (or from (point))
+ (or to (mark))))
+ ))
+ ;; pr-faces-p and not pr-spool-p
+ ((eq kind 'buffer)
+ (ps-print-buffer-with-faces filename))
+ ((eq kind 'region)
+ (ps-print-region-with-faces (or from (point))
+ (or to (mark)) filename))
+ ))
+ (pr-spool-p
+ ;; not pr-faces-p and pr-spool-p
+ ;; here FILENAME arg is ignored
+ (cond ((eq kind 'buffer)
+ (ps-spool-buffer))
+ ((eq kind 'region)
+ (ps-spool-region (or from (point)) (or to (mark))))
+ ))
+ ;; not pr-faces-p and not pr-spool-p
+ ((eq kind 'buffer)
+ (ps-print-buffer filename))
+ ((eq kind 'region)
+ (ps-print-region (or from (point)) (or to (mark)) filename))
+ ))))
(defun pr-command (command)
(defun pr-i-directory ()
- (or (and (file-directory-p pr-i-directory)
- (file-readable-p pr-i-directory))
+ (or (file-accessible-directory-p pr-i-directory)
(error "Please specify be a readable directory")))
(and pr-buffer-verbose
(message "You can use M-TAB or ESC TAB for file completion"))
(let ((dir (widget-value widget)))
- (and (file-directory-p dir)
- (file-readable-p dir)
+ (and (file-accessible-directory-p dir)
(setq pr-i-directory dir))))
HCoop / bpt / emacs.git / blobdiff