diff options
Diffstat (limited to 'lisp/printing.el')
| -rw-r--r-- | lisp/printing.el | 153 |
1 files changed, 78 insertions, 75 deletions
diff --git a/lisp/printing.el b/lisp/printing.el index 5b6173ceb35..39da132d64e 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1038,20 +1038,27 @@ Please send all bug fixes and enhancements to ;; 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), @@ -1086,7 +1093,7 @@ If SUFFIX is non-nil, add that at the end of the file name." nil) file) ;; Reset the umask. - (set-default-file-modes umask))))) + (set-default-file-modes umask)))))) (eval-when-compile @@ -3164,12 +3171,9 @@ See `pr-ps-printer-alist'.") (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 @@ -3192,9 +3196,10 @@ See `pr-ps-printer-alist'.") (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 @@ -4364,12 +4369,12 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil, 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 @@ -5632,12 +5637,12 @@ If menu binding was not done, calls `pr-menu-bind'." (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)) @@ -5882,42 +5887,42 @@ If menu binding was not done, calls `pr-menu-bind'." (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) @@ -6543,8 +6548,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (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"))) @@ -6552,8 +6556,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (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)))) |