;;; printing.el --- printing utilities
;; Copyright (C) 2000, 2001, 2003, 2004, 2005,
-;; 2006, 2007 Free Software Foundation, Inc.
+;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Version: 6.9
+;; Version: 6.9.3
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-(defconst pr-version "6.9"
- "printing.el, v 6.9 <2007/02/11 vinicius>
+(defconst pr-version "6.9.3"
+ "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>
;; GNU Emacs is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2, or (at your option) any later
+;; Software Foundation; either version 3, or (at your option) any later
;; version.
;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
;; `http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'.
;; Please, see README file for ps-print installation instructions.
;;
-;; `printing' was inspired on:
+;; `printing' was inspired by:
;;
;; print-nt.el Frederic Corne <frederic.corne@erli.fr>
;; Special printing functions for Windows NT
(set-default-file-modes umask)))))
+(eval-when-compile
+ ;; User Interface --- declared here to avoid compiler warnings
+ (defvar pr-path-style)
+ (defvar pr-auto-region)
+ (defvar pr-menu-char-height)
+ (defvar pr-menu-char-width)
+ (defvar pr-menu-lock)
+ (defvar pr-ps-printer-alist)
+ (defvar pr-txt-printer-alist)
+ (defvar pr-ps-utility-alist)
+
+
+ ;; Internal fun alias to avoid compilation gripes
+ (defalias 'pr-menu-lookup 'ignore)
+ (defalias 'pr-menu-lock 'ignore)
+ (defalias 'pr-menu-alist 'ignore)
+ (defalias 'pr-even-or-odd-pages 'ignore)
+ (defalias 'pr-menu-get-item 'ignore)
+ (defalias 'pr-menu-set-item-name 'ignore)
+ (defalias 'pr-menu-set-utility-title 'ignore)
+ (defalias 'pr-menu-set-ps-title 'ignore)
+ (defalias 'pr-menu-set-txt-title 'ignore)
+ (defalias 'pr-region-active-p 'ignore)
+ (defalias 'pr-do-update-menus 'ignore)
+ (defalias 'pr-update-mode-line 'ignore)
+ (defalias 'pr-read-string 'ignore)
+ (defalias 'pr-set-keymap-parents 'ignore)
+ (defalias 'pr-keep-region-active 'ignore))
+
+
+;; Internal Vars --- defined here to avoid compiler warnings
+(defvar pr-menu-print-item "print"
+ "Non-nil means that menu binding was not done.
+
+Used by `pr-menu-bind' and `pr-update-menus'.")
+
+(defvar pr-ps-printer-menu-modified t
+ "Non-nil means `pr-ps-printer-alist' was modified and we need to update menu.")
+
+(defvar pr-txt-printer-menu-modified t
+ "Non-nil means `pr-txt-printer-alist' was modified and we need to update menu.")
+
+(defvar pr-ps-utility-menu-modified t
+ "Non-nil means `pr-ps-utility-alist' was modified and we need to update menu.")
+
+(defconst pr-even-or-odd-alist
+ '((nil . "Print All Pages")
+ (even-page . "Print Even Pages")
+ (odd-page . "Print Odd Pages")
+ (even-sheet . "Print Even Sheets")
+ (odd-sheet . "Print Odd Sheets")))
+
\f
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cond
((featurep 'xemacs) ; XEmacs
;; XEmacs
- (defalias 'pr-f-set-keymap-parents 'set-keymap-parents)
- (defalias 'pr-f-set-keymap-name 'set-keymap-name)
+ (defalias 'pr-set-keymap-parents 'set-keymap-parents)
+ (defalias 'pr-set-keymap-name 'set-keymap-name)
;; XEmacs
- (defun pr-f-read-string (prompt initial history default)
+ (defun pr-read-string (prompt initial history default)
(let ((str (read-string prompt initial)))
(if (and str (not (string= str "")))
str
(pr-menu-lock 'postscript-options 8 12 'toggle nil)))
)
- (t ; emacs
+ (t ; GNU Emacs
;; Do nothing
)) ; end cond featurep
\f
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Emacs Definitions
+;; GNU Emacs Definitions
(cond
)
(t ; GNU Emacs
;; GNU Emacs
- (defalias 'pr-f-set-keymap-parents 'set-keymap-parent)
- (defalias 'pr-f-set-keymap-name 'ignore)
- (defalias 'pr-f-read-string 'read-string)
+ (defalias 'pr-set-keymap-parents 'set-keymap-parent)
+ (defalias 'pr-set-keymap-name 'ignore)
+ (defalias 'pr-read-string 'read-string)
;; GNU Emacs
- (defvar deactivate-mark nil)
+ (defvar deactivate-mark)
;; GNU Emacs
(defun pr-keep-region-active ()
(defun pr-menu-char-width ()
(frame-char-width))
+ (defvar pr-menu-bar nil
+ "Specify Printing menu-bar entry.")
+
;; GNU Emacs
;; Menu binding
- (require 'easymenu)
;; Replace existing "print" item by "Printing" item.
;; If you're changing this file, you'll load it a second,
;; third... time, but "print" item exists only in the first load.
+ (eval-when-compile
+ (require 'easymenu)) ; to avoid compilation gripes
+
(eval-and-compile
(cond
- ;; Emacs 20
+ ;; GNU Emacs 20
((< emacs-major-version 21)
(defun pr-global-menubar (pr-menu-spec)
+ (require 'easymenu)
(easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item)
(when pr-menu-print-item
(easy-menu-remove-item nil '("tools") pr-menu-print-item)
pr-menu-bar (vector 'menu-bar 'tools
(pr-get-symbol "Printing")))))
)
- ;; Emacs 21 & 22
+ ;; GNU Emacs 21 & 22
(t
(defun pr-global-menubar (pr-menu-spec)
+ (require 'easymenu)
(let ((menu-file (if (= emacs-major-version 21)
- '("menu-bar" "files") ; Emacs 21
- '("menu-bar" "file")))) ; Emacs 22 or higher
+ '("menu-bar" "files") ; GNU Emacs 21
+ '("menu-bar" "file")))) ; GNU Emacs 22 or higher
(cond
(pr-menu-print-item
(easy-menu-add-item global-map menu-file
)))
(defvar pr-menu-position nil)
- (defvar pr-menu-state nil)
+ (defvar pr-menu-state nil)
;; GNU Emacs
(defun pr-menu-lookup (path)
)) ; end cond featurep
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal Functions (I)
+
+
+(defun pr-dosify-file-name (path)
+ "Replace unix-style directory separator character with dos/windows one."
+ (interactive "sPath: ")
+ (if (eq pr-path-style 'windows)
+ (subst-char-in-string ?/ ?\\ path)
+ path))
+
+
+(defun pr-unixify-file-name (path)
+ "Replace dos/windows-style directory separator character with unix one."
+ (interactive "sPath: ")
+ (if (eq pr-path-style 'windows)
+ (subst-char-in-string ?\\ ?/ path)
+ path))
+
+
+(defun pr-standard-file-name (path)
+ "Ensure the proper directory separator depending on the OS.
+That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory
+separator; otherwise, ensure unix-style directory separator."
+ (if (or pr-cygwin-system ps-windows-system)
+ (subst-char-in-string ?/ ?\\ path)
+ (subst-char-in-string ?\\ ?/ path)))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User Interface (I)
+;; User Interface
(defgroup printing nil
:tag "Printing Utilities"
:link '(emacs-library-link :tag "Source Lisp File" "printing.el")
:prefix "pr-"
- :version "20"
+ :version "22.1"
:group 'wp
:group 'postscript)
:type '(choice :tag "Path style"
(const :tag "Windows 9x/NT Style (\\)" :value windows)
(const :tag "Unix Style (/)" :value unix))
- :version "20"
:group 'printing)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Internal Functions (I)
-
-
-(defun pr-dosify-file-name (path)
- "Replace unix-style directory separator character with dos/windows one."
- (interactive "sPath: ")
- (if (eq pr-path-style 'windows)
- (subst-char-in-string ?/ ?\\ path)
- path))
-
-
-(defun pr-unixify-file-name (path)
- "Replace dos/windows-style directory separator character with unix one."
- (interactive "sPath: ")
- (if (eq pr-path-style 'windows)
- (subst-char-in-string ?\\ ?/ path)
- path))
-
-
-(defun pr-standard-file-name (path)
- "Ensure the proper directory separator depending on the OS.
-That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory
-separator; otherwise, ensure unix-style directory separator."
- (if (or pr-cygwin-system ps-windows-system)
- (subst-char-in-string ?/ ?\\ path)
- (subst-char-in-string ?\\ ?/ path)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User Interface (II)
-
-
(defcustom pr-path-alist
'((unix PATH)
(cygwin PATH)
:tag "Directory"
(string :value "")
(symbol :value symbol)))))
- :version "20"
:group 'printing)
function (see it for documentation) to update text printer menu."
:type 'symbol
:set 'pr-txt-name-custom-set
- :version "20"
:group 'printing)
(const :tag "None" nil)
string)))
:set 'pr-alist-custom-set
- :version "20"
:group 'printing)
function (see it for documentation) to update PostScript printer menu."
:type 'symbol
:set 'pr-ps-name-custom-set
- :version "20"
:group 'printing)
(sexp :tag "Value")))
))
:set 'pr-alist-custom-set
- :version "20"
:group 'printing)
See also `pr-ps-temp-file' and `pr-file-modes'."
:type '(directory :tag "Temporary Directory")
- :version "20"
:group 'printing)
See also `pr-temp-dir' and `pr-file-modes'."
:type '(file :tag "PostScript Temporary File Name")
- :version "21"
:group 'printing)
See also `pr-temp-dir' and `pr-ps-temp-file'."
:type '(integer :tag "File Permission Bits")
- :version "21.3"
:group 'printing)
`http://www.cs.wisc.edu/~ghost/macos/index.htm'
"
:type '(string :tag "Ghostview Utility")
- :version "20"
:group 'printing)
`http://www.cs.wisc.edu/~ghost/doc/printer.htm'
"
:type '(string :tag "Ghostscript Utility")
- :version "20"
:group 'printing)
`http://www.cs.wisc.edu/~ghost/doc/printer.htm'
"
:type '(repeat (string :tag "Ghostscript Switch"))
- :version "20"
:group 'printing)
See `pr-gs-switches' for documentation.
See also `pr-ps-printer-alist'."
:type '(string :tag "Ghostscript Device")
- :version "20"
:group 'printing)
See `pr-gs-switches' for documentation.
See also `pr-ps-printer-alist'."
:type '(integer :tag "Ghostscript Resolution")
- :version "20"
:group 'printing)
In GNU or Unix system, if ghostscript is set as a PostScript filter, this
variable should be nil."
:type 'boolean
- :version "20"
:group 'printing)
(defcustom pr-faces-p nil
"*Non-nil means print with face attributes."
:type 'boolean
- :version "20"
:group 'printing)
(defcustom pr-spool-p nil
"*Non-nil means spool printing in a buffer."
:type 'boolean
- :version "20"
:group 'printing)
(defcustom pr-file-landscape nil
"*Non-nil means print PostScript file in landscape orientation."
:type 'boolean
- :version "20"
:group 'printing)
(defcustom pr-file-duplex nil
"*Non-nil means print PostScript file in duplex mode."
:type 'boolean
- :version "20"
:group 'printing)
If tumble is on, produces a printing suitable for binding at the top or
bottom."
:type 'boolean
- :version "20"
:group 'printing)
`*-region*' commands, that is, `*-buffer*' commands will print only the region
marked instead of all buffer."
:type 'boolean
- :version "20"
:group 'printing)
`*-buffer*' commands will print the current buffer and `*-region*' commands
will print the current region."
:type 'boolean
- :version "20"
:group 'printing)
(variable :tag "Other"))
(sexp :tag "Value")))
))
- :version "20"
:group 'printing)
`pr-ps-utility-alist'."
:type '(symbol :tag "PS File Utility")
:set 'pr-ps-utility-custom-set
- :version "20"
:group 'printing)
(sexp :tag "Value")))
))
:set 'pr-alist-custom-set
- :version "20"
:group 'printing)
See also `pr-menu-char-height' and `pr-menu-char-width'."
:type 'boolean
- :version "20"
:group 'printing)
See also `pr-menu-lock' and `pr-menu-char-width'."
:type 'integer
- :version "20"
:group 'printing)
See also `pr-menu-lock' and `pr-menu-char-height'."
:type 'integer
- :version "20"
:group 'printing)
(variable :tag "Other"))
(sexp :tag "Value")))
))
- :version "20"
:group 'printing)
(const postscript-process)
(const printing)
(const help)))
- :version "20"
:group 'printing)
Error: could not open \"c:\\temp\\prspool.ps\" for reading."
:type 'boolean
- :version "20"
:group 'printing)
`pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory'
and `pr-txt-directory'."
:type 'boolean
- :version "20"
:group 'printing)
It's used by `pr-interface'."
:type 'string
- :version "20"
:group 'printing)
It's used by `pr-interface'."
:type '(repeat (regexp :tag "Buffer Name Regexp"))
- :version "20"
:group 'printing)
It's used by `pr-interface'."
:type 'boolean
- :version "20"
:group 'printing)
See `pr-ps-printer-alist'.")
-(defvar pr-menu-bar nil
- "Specify Printing menu-bar entry.")
-
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Macros
)))
-(defvar pr-menu-print-item "print"
- "Non-nil means that menu binding was not done.
-
-Used by `pr-menu-bind' and `pr-update-menus'.")
-
-
(defun pr-menu-bind ()
"Install `printing' menu in the menubar.
C-u 2 M-x pr-ps-fast-fire RET
The command prompts the user for a N-UP value, then for a current
PostScript printer and, finally, for a file name. Then change the active
- printer to that choosen by user and saves the PostScript image in
+ printer to that chosen by user and saves the PostScript image in
that file instead of sending it to the printer.
If it's an integer greater or equal to 2, the command prompts the user for a
current PostScript printer and for a file name. Then change the active
- printer to that choosen by user and saves the PostScript image in that file
+ printer to that chosen by user and saves the PostScript image in that file
instead of sending it to the printer.
If it's a symbol which it's defined in `pr-ps-printer-alist', it's the new
If FORCE is non-nil, update menus doesn't matter if `pr-ps-printer-alist',
`pr-txt-printer-alist' or `pr-ps-utility-alist' were modified or not;
-otherwise, update PostScript printer menu iff `pr-ps-printer-menu-modified' is
-non-nil, update text printer menu iff `pr-txt-printer-menu-modified' is
-non-nil, and update PostScript File menus iff `pr-ps-utility-menu-modified' is
+otherwise, update PostScript printer menu if `pr-ps-printer-menu-modified' is
+non-nil, update text printer menu if `pr-txt-printer-menu-modified' is
+non-nil, and update PostScript File menus if `pr-ps-utility-menu-modified' is
non-nil.
If menu binding was not done, calls `pr-menu-bind'."
(pr-do-update-menus force)))
-(defvar pr-ps-printer-menu-modified t
- "Non-nil means `pr-ps-printer-alist' was modified and we need to update menu.")
-(defvar pr-txt-printer-menu-modified t
- "Non-nil means `pr-txt-printer-alist' was modified and we need to update menu.")
-(defvar pr-ps-utility-menu-modified t
- "Non-nil means `pr-ps-utility-alist' was modified and we need to update menu.")
-
-
-(defconst pr-even-or-odd-alist
- '((nil . "Print All Pages")
- (even-page . "Print Even Pages")
- (odd-page . "Print Odd Pages")
- (even-sheet . "Print Even Sheets")
- (odd-sheet . "Print Odd Sheets")))
-
-
(defun pr-menu-create (name alist var-sym fun entry index)
(cons name
(mapcar
(defun pr-eval-local-alist (alist)
(let (local-list)
- (mapcar #'(lambda (option)
- (let ((var-sym (car option))
- (value (cdr option)))
- (setq local-list
- (if (eq var-sym 'inherits-from:)
- (nconc (pr-eval-setting-alist value) local-list)
- (set (make-local-variable var-sym) (eval value))
- (cons var-sym local-list)))))
- alist)
+ (mapc #'(lambda (option)
+ (let ((var-sym (car option))
+ (value (cdr option)))
+ (setq local-list
+ (if (eq var-sym 'inherits-from:)
+ (nconc (pr-eval-setting-alist value) local-list)
+ (set (make-local-variable var-sym) (eval value))
+ (cons var-sym local-list)))))
+ alist)
local-list))
(setq local-list
(pr-eval-setting-alist inherits global
(cons inherits old)))))
- (mapcar
+ (mapc
(cond ((not local) ; global settings
#'(lambda (option)
(let ((var-sym (car option)))
(save-match-data
(let* ((fmt-prompt "%s[%s] N-up printing (default 1): ")
(prompt "")
- (str (pr-f-read-string (format fmt-prompt prompt mess) "1" nil "1"))
+ (str (pr-read-string (format fmt-prompt prompt mess) "1" nil "1"))
int)
(while (if (string-match "^\\s *[0-9]+$" str)
(setq int (string-to-number str)
(setq prompt "Invalid integer syntax; "))
(ding)
(setq str
- (pr-f-read-string (format fmt-prompt prompt mess) str nil "1")))
+ (pr-read-string (format fmt-prompt prompt mess) str nil "1")))
int)))
(defun pr-interactive-regexp (mess)
- (pr-f-read-string (format "[%s] File regexp to print: " mess) "" nil ""))
+ (pr-read-string (format "[%s] File regexp to print: " mess) "" nil ""))
(defun pr-interactive-dir-args (mess)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Printing Interface (inspired on ps-print-interface.el)
+;; Printing Interface (inspired by ps-print-interface.el)
-(require 'widget)
-(require 'wid-edit)
-(require 'cus-edit)
+(eval-when-compile
+ (require 'cus-edit)
+ (require 'wid-edit)
+ (require 'widget))
(defvar pr-i-window-configuration nil)
"Keymap for pr-interface.")
(unless pr-interface-map
- (setq pr-interface-map (make-sparse-keymap))
- (cond ((featurep 'xemacs) ; XEmacs
- (pr-f-set-keymap-parents pr-interface-map (list widget-keymap))
- (pr-f-set-keymap-name pr-interface-map 'pr-interface-map))
- (t ; GNU Emacs
- (pr-f-set-keymap-parents pr-interface-map widget-keymap)))
- (define-key pr-interface-map "q" 'pr-interface-quit)
- (define-key pr-interface-map "?" 'pr-interface-help))
+ (let ((map (make-sparse-keymap)))
+ (cond ((featurep 'xemacs) ; XEmacs
+ (pr-set-keymap-parents map (list widget-keymap))
+ (pr-set-keymap-name map 'pr-interface-map))
+ (t ; GNU Emacs
+ (pr-set-keymap-parents map widget-keymap)))
+ (define-key map "q" 'pr-interface-quit)
+ (define-key map "?" 'pr-interface-help)
+ (setq pr-interface-map map)))
(defmacro pr-interface-save (&rest body)