;;; 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.1
+;; Version: 6.9.3
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-(defconst pr-version "6.9.1"
- "printing.el, v 6.9.1 <2007/08/02 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>
;; This file is part of GNU Emacs.
-;; 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 3, or (at your option) any later
-;; version.
+;; 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 3 of the License, or
+;; (at your option) any later version.
-;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
-;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-;; details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
-;; You should have received a copy of the GNU General Public License along with
-;; GNU Emacs; see the file COPYING. If not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; `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)))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User Interface (I)
+(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'.")
-(defgroup printing nil
- "Printing Utilities group."
- :tag "Printing Utilities"
- :link '(emacs-library-link :tag "Source Lisp File" "printing.el")
- :prefix "pr-"
- :version "20"
- :group 'wp
- :group 'postscript)
+(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.")
-(defcustom pr-path-style
- (if (and (not pr-cygwin-system)
- ps-windows-system)
- 'windows
- 'unix)
- "*Specify which path style to use for external commands.
+(defvar pr-ps-utility-menu-modified t
+ "Non-nil means `pr-ps-utility-alist' was modified and we need to update menu.")
-Valid values are:
+(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")))
- windows Windows 9x/NT style (\\)
+\f
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; XEmacs Definitions
- unix Unix style (/)"
- :type '(choice :tag "Path style"
- (const :tag "Windows 9x/NT Style (\\)" :value windows)
- (const :tag "Unix Style (/)" :value unix))
- :version "20"
- :group 'printing)
+(cond
+ ((featurep 'xemacs) ; XEmacs
+ ;; XEmacs
+ (defalias 'pr-set-keymap-parents 'set-keymap-parents)
+ (defalias 'pr-set-keymap-name 'set-keymap-name)
+ ;; XEmacs
+ (defun pr-read-string (prompt initial history default)
+ (let ((str (read-string prompt initial)))
+ (if (and str (not (string= str "")))
+ str
+ default)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Customization Functions
+ ;; XEmacs
+ (defvar zmacs-region-stays nil)
+ ;; XEmacs
+ (defun pr-keep-region-active ()
+ (setq zmacs-region-stays t))
-(defun pr-alist-custom-set (symbol value)
- "Set the value of custom variables for printer & utility selection."
- (set symbol value)
- (and (featurep 'printing) ; update only after printing is loaded
- (pr-update-menus t)))
+ ;; XEmacs
+ (defun pr-region-active-p ()
+ (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p)))
+ ;; XEmacs
+ (defun pr-menu-char-height ()
+ (font-height (face-font 'default)))
-(defun pr-ps-utility-custom-set (symbol value)
- "Update utility menu entry."
- (set symbol value)
- (and (featurep 'printing) ; update only after printing is loaded
- (pr-menu-set-utility-title value)))
+ ;; XEmacs
+ (defun pr-menu-char-width ()
+ (font-width (face-font 'default)))
+ ;; XEmacs
+ (defmacro pr-xemacs-global-menubar (&rest body)
+ `(save-excursion
+ (let ((temp (get-buffer-create (make-temp-name " *Temp"))))
+ ;; be sure to access global menubar
+ (set-buffer temp)
+ ,@body
+ (kill-buffer temp))))
-(defun pr-ps-name-custom-set (symbol value)
- "Update `PostScript Printer:' menu entry."
- (set symbol value)
- (and (featurep 'printing) ; update only after printing is loaded
- (pr-menu-set-ps-title value)))
+ ;; XEmacs
+ (defun pr-global-menubar (pr-menu-spec)
+ ;; Menu binding
+ (pr-xemacs-global-menubar
+ (add-submenu nil (cons "Printing" pr-menu-spec) "Apps"))
+ (setq pr-menu-print-item nil))
+ ;; XEmacs
+ (defvar current-mouse-event nil)
+ (defun pr-menu-position (entry index horizontal)
+ (make-event
+ 'button-release
+ (list 'button 1
+ 'x (- (event-x-pixel current-mouse-event) ; X
+ (* horizontal pr-menu-char-width))
+ 'y (- (event-y-pixel current-mouse-event) ; Y
+ (* (pr-menu-index entry index) pr-menu-char-height)))))
-(defun pr-txt-name-custom-set (symbol value)
- "Update `Text Printer:' menu entry."
- (set symbol value)
- (and (featurep 'printing) ; update only after printing is loaded
- (pr-menu-set-txt-title value)))
+ (defvar pr-menu-position nil)
+ (defvar pr-menu-state nil)
+ ;; XEmacs
+ (defvar current-menubar nil) ; to avoid compilation gripes
+ (defun pr-menu-lookup (path)
+ (car (find-menu-item current-menubar (cons "Printing" path))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Internal Functions (I)
+ ;; XEmacs
+ (defun pr-menu-lock (entry index horizontal state path)
+ (when pr-menu-lock
+ (or (and pr-menu-position (eq state pr-menu-state))
+ (setq pr-menu-position (pr-menu-position entry index horizontal)
+ pr-menu-state state))
+ (let* ((menu (pr-menu-lookup path))
+ (result (get-popup-menu-response menu pr-menu-position)))
+ (and (misc-user-event-p result)
+ (funcall (event-function result)
+ (event-object result))))
+ (setq pr-menu-position nil)))
+ ;; XEmacs
+ (defalias 'pr-update-mode-line 'set-menubar-dirty-flag)
-(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))
+ ;; XEmacs
+ (defvar pr-ps-name-old "PostScript Printers")
+ (defvar pr-txt-name-old "Text Printers")
+ (defvar pr-ps-utility-old "PostScript Utility")
+ (defvar pr-even-or-odd-old "Print All Pages")
+ ;; XEmacs
+ (defun pr-do-update-menus (&optional force)
+ (pr-menu-alist pr-ps-printer-alist
+ 'pr-ps-name
+ 'pr-menu-set-ps-title
+ '("Printing")
+ 'pr-ps-printer-menu-modified
+ force
+ pr-ps-name-old
+ 'postscript 2)
+ (pr-menu-alist pr-txt-printer-alist
+ 'pr-txt-name
+ 'pr-menu-set-txt-title
+ '("Printing")
+ 'pr-txt-printer-menu-modified
+ force
+ pr-txt-name-old
+ 'text 2)
+ (let ((save-var pr-ps-utility-menu-modified))
+ (pr-menu-alist pr-ps-utility-alist
+ 'pr-ps-utility
+ 'pr-menu-set-utility-title
+ '("Printing" "PostScript Print" "File")
+ 'save-var
+ force
+ pr-ps-utility-old
+ nil 1))
+ (pr-menu-alist pr-ps-utility-alist
+ 'pr-ps-utility
+ 'pr-menu-set-utility-title
+ '("Printing" "PostScript Preview" "File")
+ 'pr-ps-utility-menu-modified
+ force
+ pr-ps-utility-old
+ nil 1)
+ (pr-even-or-odd-pages ps-even-or-odd-pages force))
-(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))
+ ;; XEmacs
+ (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
+ entry index)
+ (when (and alist (or force (symbol-value modified-sym)))
+ (pr-xemacs-global-menubar
+ (add-submenu menu-path
+ (pr-menu-create name alist var-sym
+ fun entry index)))
+ (funcall fun (symbol-value var-sym))
+ (set modified-sym nil)))
+ ;; XEmacs
+ (defun pr-relabel-menu-item (newname var-sym)
+ (pr-xemacs-global-menubar
+ (relabel-menu-item
+ (list "Printing" (symbol-value var-sym))
+ newname)
+ (set var-sym newname)))
-(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)))
+ ;; XEmacs
+ (defun pr-menu-set-ps-title (value &optional item entry index)
+ (pr-relabel-menu-item (format "PostScript Printer: %s" value)
+ 'pr-ps-name-old)
+ (pr-ps-set-printer value)
+ (and index
+ (pr-menu-lock entry index 12 'toggle nil)))
+ ;; XEmacs
+ (defun pr-menu-set-txt-title (value &optional item entry index)
+ (pr-relabel-menu-item (format "Text Printer: %s" value)
+ 'pr-txt-name-old)
+ (pr-txt-set-printer value)
+ (and index
+ (pr-menu-lock entry index 12 'toggle nil)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User Interface (II)
+ ;; XEmacs
+ (defun pr-menu-set-utility-title (value &optional item entry index)
+ (pr-xemacs-global-menubar
+ (let ((newname (format "%s" value)))
+ (relabel-menu-item
+ (list "Printing" "PostScript Print" "File" pr-ps-utility-old)
+ newname)
+ (relabel-menu-item
+ (list "Printing" "PostScript Preview" "File" pr-ps-utility-old)
+ newname)
+ (setq pr-ps-utility-old newname)))
+ (pr-ps-set-utility value)
+ (and index
+ (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
+ ;; XEmacs
+ (defun pr-even-or-odd-pages (value &optional no-lock)
+ (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist))
+ 'pr-even-or-odd-old)
+ (setq ps-even-or-odd-pages value)
+ (or no-lock
+ (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
-(defcustom pr-path-alist
- '((unix PATH)
- (cygwin PATH)
- (windows PATH))
- "*Specify an alist for command paths.
+ )
+ (t ; GNU Emacs
+ ;; Do nothing
+ )) ; end cond featurep
-It's used to find commands used for printing package, like gv, gs, gsview.exe,
-mpage, print.exe, etc. See also `pr-command' function.
-Each element has the form:
-
- (ENTRY DIRECTORY...)
+\f
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GNU Emacs Definitions
-Where:
-ENTRY It's a symbol, used to identify this entry.
- There must exist at least one of the following entries:
+(cond
+ ((featurep 'xemacs) ; XEmacs
+ ;; Do nothing
+ )
+ (t ; GNU Emacs
+ ;; GNU Emacs
+ (defalias 'pr-set-keymap-parents 'set-keymap-parent)
+ (defalias 'pr-set-keymap-name 'ignore)
+ (defalias 'pr-read-string 'read-string)
- unix this entry is used when Emacs is running on GNU or
- Unix system.
+ ;; GNU Emacs
+ (defvar deactivate-mark)
- cygwin this entry is used when Emacs is running on Windows
- 95/98/NT/2000 with Cygwin.
+ ;; GNU Emacs
+ (defun pr-keep-region-active ()
+ (setq deactivate-mark nil))
- windows this entry is used when Emacs is running on Windows
- 95/98/NT/2000.
+ ;; GNU Emacs
+ (defun pr-region-active-p ()
+ (and pr-auto-region transient-mark-mode mark-active))
-DIRECTORY It should be a string or a symbol. If it's a symbol, it should
- exist an equal entry in `pr-path-alist'. If it's a string,
- it's considered a directory specification.
+ ;; GNU Emacs
+ (defun pr-menu-char-height ()
+ (frame-char-height))
- The directory specification may contain:
- $var environment variable expansion
- ~/ tilde expansion
- ./ current directory
- ../ previous directory
+ ;; GNU Emacs
+ (defun pr-menu-char-width ()
+ (frame-char-width))
- For example, let's say the home directory is /home/my and the
- current directory is /home/my/dir, so:
+ (defvar pr-menu-bar nil
+ "Specify Printing menu-bar entry.")
- THE ENTRY IS EXPANDED TO
- ~/entry /home/my/entry
- ./entry /home/my/dir/entry
- ../entry /home/my/entry
- $HOME/entry /home/my/entry
- $HOME/~/other/../my/entry /home/my/entry
+ ;; GNU Emacs
+ ;; Menu binding
+ ;; 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
- SPECIAL SYMBOL: If the symbol `PATH' is used in the directory
- list and there isn't a `PATH' entry in `pr-path-alist' or the
- `PATH' entry has a null directory list, the PATH environment
- variable is used.
+ (eval-and-compile
+ (cond
+ ;; 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)
+ (setq pr-menu-print-item nil
+ pr-menu-bar (vector 'menu-bar 'tools
+ (pr-get-symbol "Printing")))))
+ )
+ ;; 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") ; GNU Emacs 21
+ '("menu-bar" "file")))) ; GNU Emacs 22 or higher
+ (cond
+ (pr-menu-print-item
+ (easy-menu-add-item global-map menu-file
+ (easy-menu-create-menu "Print" pr-menu-spec)
+ "print-buffer")
+ (dolist (item '("print-buffer" "print-region"
+ "ps-print-buffer-faces" "ps-print-region-faces"
+ "ps-print-buffer" "ps-print-region"))
+ (easy-menu-remove-item global-map menu-file item))
+ (setq pr-menu-print-item nil
+ pr-menu-bar (vector 'menu-bar
+ (pr-get-symbol (nth 1 menu-file))
+ (pr-get-symbol "Print"))))
+ (t
+ (easy-menu-add-item global-map menu-file
+ (easy-menu-create-menu "Print" pr-menu-spec)))
+ )))
+ )))
-Examples:
+ (eval-and-compile
+ (cond
+ (ps-windows-system
+ ;; GNU Emacs for Windows 9x/NT
+ (defun pr-menu-position (entry index horizontal)
+ (let ((pos (cdr (mouse-pixel-position))))
+ (list
+ (list (or (car pos) 0) ; X
+ (- (or (cdr pos) 0) ; Y
+ (* (pr-menu-index entry index) pr-menu-char-height)))
+ (selected-frame)))) ; frame
+ )
+ (t
+ ;; GNU Emacs
+ (defun pr-menu-position (entry index horizontal)
+ (let ((pos (cdr (mouse-pixel-position))))
+ (list
+ (list (- (or (car pos) 0) ; X
+ (* horizontal pr-menu-char-width))
+ (- (or (cdr pos) 0) ; Y
+ (* (pr-menu-index entry index) pr-menu-char-height)))
+ (selected-frame)))) ; frame
+ )))
-* On GNU or Unix system:
+ (defvar pr-menu-position nil)
+ (defvar pr-menu-state nil)
- '((unix \".\" \"~/bin\" ghostview mpage PATH)
- (ghostview \"$HOME/bin/gsview-dir\")
- (mpage \"$HOME/bin/mpage-dir\")
- )
+ ;; GNU Emacs
+ (defun pr-menu-lookup (path)
+ (lookup-key global-map
+ (if path
+ (vconcat pr-menu-bar
+ (mapcar 'pr-get-symbol
+ (if (listp path)
+ path
+ (list path))))
+ pr-menu-bar)))
-* On Windows system:
+ ;; GNU Emacs
+ (defun pr-menu-lock (entry index horizontal state path)
+ (when pr-menu-lock
+ (or (and pr-menu-position (eq state pr-menu-state))
+ (setq pr-menu-position (pr-menu-position entry index horizontal)
+ pr-menu-state state))
+ (let* ((menu (pr-menu-lookup path))
+ (result (x-popup-menu pr-menu-position menu)))
+ (and result
+ (let ((command (lookup-key menu (vconcat result))))
+ (if (fboundp command)
+ (funcall command)
+ (eval command)))))
+ (setq pr-menu-position nil)))
- '((windows \"c:/applications/executables\" PATH ghostview mpage)
- (ghostview \"c:/gs/gsview-dir\")
- (mpage \"c:/mpage-dir\")
- )"
- :type '(repeat
- (cons :tag ""
- (symbol :tag "Identifier ")
- (repeat :tag "Directory List"
- (choice :menu-tag "Directory"
- :tag "Directory"
- (string :value "")
- (symbol :value symbol)))))
- :version "20"
- :group 'printing)
+ ;; GNU Emacs
+ (defalias 'pr-update-mode-line 'force-mode-line-update)
+ ;; GNU Emacs
+ (defun pr-do-update-menus (&optional force)
+ (pr-menu-alist pr-ps-printer-alist
+ 'pr-ps-name
+ 'pr-menu-set-ps-title
+ "PostScript Printers"
+ 'pr-ps-printer-menu-modified
+ force
+ "PostScript Printers"
+ 'postscript 2)
+ (pr-menu-alist pr-txt-printer-alist
+ 'pr-txt-name
+ 'pr-menu-set-txt-title
+ "Text Printers"
+ 'pr-txt-printer-menu-modified
+ force
+ "Text Printers"
+ 'text 2)
+ (let ((save-var pr-ps-utility-menu-modified))
+ (pr-menu-alist pr-ps-utility-alist
+ 'pr-ps-utility
+ 'pr-menu-set-utility-title
+ '("PostScript Print" "File" "PostScript Utility")
+ 'save-var
+ force
+ "PostScript Utility"
+ nil 1))
+ (pr-menu-alist pr-ps-utility-alist
+ 'pr-ps-utility
+ 'pr-menu-set-utility-title
+ '("PostScript Preview" "File" "PostScript Utility")
+ 'pr-ps-utility-menu-modified
+ force
+ "PostScript Utility"
+ nil 1)
+ (pr-even-or-odd-pages ps-even-or-odd-pages force))
-(defcustom pr-txt-name 'default
- "*Specify a printer for printing a text file.
+ ;; GNU Emacs
+ (defun pr-menu-get-item (name-list)
+ ;; NAME-LIST is a string or a list of strings.
+ (or (listp name-list)
+ (setq name-list (list name-list)))
+ (and name-list
+ (let* ((reversed (reverse name-list))
+ (name (pr-get-symbol (car reversed)))
+ (path (nreverse (cdr reversed)))
+ (menu (lookup-key
+ global-map
+ (vconcat pr-menu-bar
+ (mapcar 'pr-get-symbol path)))))
+ (assq name (nthcdr 2 menu)))))
-The printer name symbol should be defined on `pr-txt-printer-alist' (see it for
-documentation).
+ ;; GNU Emacs
+ (defvar pr-temp-menu nil)
-This variable should be modified by customization engine. If this variable is
-modified by other means (for example, a lisp function), use `pr-update-menus'
-function (see it for documentation) to update text printer menu."
- :type 'symbol
- :set 'pr-txt-name-custom-set
- :version "20"
- :group 'printing)
+ ;; GNU Emacs
+ (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
+ entry index)
+ (when (and alist (or force (symbol-value modified-sym)))
+ (easy-menu-define pr-temp-menu nil ""
+ (pr-menu-create name alist var-sym fun entry index))
+ (let ((item (pr-menu-get-item menu-path)))
+ (and item
+ (let* ((binding (nthcdr 3 item))
+ (key-binding (cdr binding)))
+ (setcar binding pr-temp-menu)
+ (and key-binding (listp (car key-binding))
+ (setcdr binding (cdr key-binding))) ; skip KEY-BINDING
+ (funcall fun (symbol-value var-sym) item))))
+ (set modified-sym nil)))
+ ;; GNU Emacs
+ (defun pr-menu-set-item-name (item name)
+ (and item
+ (setcar (nthcdr 2 item) name))) ; ITEM-NAME
-(defcustom pr-txt-printer-alist
- (list (list 'default lpr-command nil
- (cond ((boundp 'printer-name) printer-name)
- (ps-windows-system "PRN")
- (t nil)
- )))
+ ;; GNU Emacs
+ (defun pr-menu-set-ps-title (value &optional item entry index)
+ (pr-menu-set-item-name (or item
+ (pr-menu-get-item "PostScript Printers"))
+ (format "PostScript Printer: %s" value))
+ (pr-ps-set-printer value)
+ (and index
+ (pr-menu-lock entry index 12 'toggle nil)))
+
+ ;; GNU Emacs
+ (defun pr-menu-set-txt-title (value &optional item entry index)
+ (pr-menu-set-item-name (or item
+ (pr-menu-get-item "Text Printers"))
+ (format "Text Printer: %s" value))
+ (pr-txt-set-printer value)
+ (and index
+ (pr-menu-lock entry index 12 'toggle nil)))
+
+ ;; GNU Emacs
+ (defun pr-menu-set-utility-title (value &optional item entry index)
+ (let ((name (symbol-name value)))
+ (if item
+ (pr-menu-set-item-name item name)
+ (pr-menu-set-item-name
+ (pr-menu-get-item
+ '("PostScript Print" "File" "PostScript Utility"))
+ name)
+ (pr-menu-set-item-name
+ (pr-menu-get-item
+ '("PostScript Preview" "File" "PostScript Utility"))
+ name)))
+ (pr-ps-set-utility value)
+ (and index
+ (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
+
+ ;; GNU Emacs
+ (defun pr-even-or-odd-pages (value &optional no-lock)
+ (pr-menu-set-item-name (pr-menu-get-item "Print All Pages")
+ (cdr (assq value pr-even-or-odd-alist)))
+ (setq ps-even-or-odd-pages value)
+ (or no-lock
+ (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
+
+ )) ; 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
+
+
+(defun pr-alist-custom-set (symbol value)
+ "Set the value of custom variables for printer & utility selection."
+ (set symbol value)
+ (and (featurep 'printing) ; update only after printing is loaded
+ (pr-update-menus t)))
+
+
+(defun pr-ps-utility-custom-set (symbol value)
+ "Update utility menu entry."
+ (set symbol value)
+ (and (featurep 'printing) ; update only after printing is loaded
+ (pr-menu-set-utility-title value)))
+
+
+(defun pr-ps-name-custom-set (symbol value)
+ "Update `PostScript Printer:' menu entry."
+ (set symbol value)
+ (and (featurep 'printing) ; update only after printing is loaded
+ (pr-menu-set-ps-title value)))
+
+
+(defun pr-txt-name-custom-set (symbol value)
+ "Update `Text Printer:' menu entry."
+ (set symbol value)
+ (and (featurep 'printing) ; update only after printing is loaded
+ (pr-menu-set-txt-title value)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; User Interface
+
+
+(defgroup printing nil
+ "Printing Utilities group."
+ :tag "Printing Utilities"
+ :link '(emacs-library-link :tag "Source Lisp File" "printing.el")
+ :prefix "pr-"
+ :version "22.1"
+ :group 'wp
+ :group 'postscript)
+
+
+(defcustom pr-path-style
+ (if (and (not pr-cygwin-system)
+ ps-windows-system)
+ 'windows
+ 'unix)
+ "*Specify which path style to use for external commands.
+
+Valid values are:
+
+ windows Windows 9x/NT style (\\)
+
+ unix Unix style (/)"
+ :type '(choice :tag "Path style"
+ (const :tag "Windows 9x/NT Style (\\)" :value windows)
+ (const :tag "Unix Style (/)" :value unix))
+ :group 'printing)
+
+
+(defcustom pr-path-alist
+ '((unix PATH)
+ (cygwin PATH)
+ (windows PATH))
+ "*Specify an alist for command paths.
+
+It's used to find commands used for printing package, like gv, gs, gsview.exe,
+mpage, print.exe, etc. See also `pr-command' function.
+
+Each element has the form:
+
+ (ENTRY DIRECTORY...)
+
+Where:
+
+ENTRY It's a symbol, used to identify this entry.
+ There must exist at least one of the following entries:
+
+ unix this entry is used when Emacs is running on GNU or
+ Unix system.
+
+ cygwin this entry is used when Emacs is running on Windows
+ 95/98/NT/2000 with Cygwin.
+
+ windows this entry is used when Emacs is running on Windows
+ 95/98/NT/2000.
+
+DIRECTORY It should be a string or a symbol. If it's a symbol, it should
+ exist an equal entry in `pr-path-alist'. If it's a string,
+ it's considered a directory specification.
+
+ The directory specification may contain:
+ $var environment variable expansion
+ ~/ tilde expansion
+ ./ current directory
+ ../ previous directory
+
+ For example, let's say the home directory is /home/my and the
+ current directory is /home/my/dir, so:
+
+ THE ENTRY IS EXPANDED TO
+ ~/entry /home/my/entry
+ ./entry /home/my/dir/entry
+ ../entry /home/my/entry
+ $HOME/entry /home/my/entry
+ $HOME/~/other/../my/entry /home/my/entry
+
+ SPECIAL SYMBOL: If the symbol `PATH' is used in the directory
+ list and there isn't a `PATH' entry in `pr-path-alist' or the
+ `PATH' entry has a null directory list, the PATH environment
+ variable is used.
+
+Examples:
+
+* On GNU or Unix system:
+
+ '((unix \".\" \"~/bin\" ghostview mpage PATH)
+ (ghostview \"$HOME/bin/gsview-dir\")
+ (mpage \"$HOME/bin/mpage-dir\")
+ )
+
+* On Windows system:
+
+ '((windows \"c:/applications/executables\" PATH ghostview mpage)
+ (ghostview \"c:/gs/gsview-dir\")
+ (mpage \"c:/mpage-dir\")
+ )"
+ :type '(repeat
+ (cons :tag ""
+ (symbol :tag "Identifier ")
+ (repeat :tag "Directory List"
+ (choice :menu-tag "Directory"
+ :tag "Directory"
+ (string :value "")
+ (symbol :value symbol)))))
+ :group 'printing)
+
+
+(defcustom pr-txt-name 'default
+ "*Specify a printer for printing a text file.
+
+The printer name symbol should be defined on `pr-txt-printer-alist' (see it for
+documentation).
+
+This variable should be modified by customization engine. If this variable is
+modified by other means (for example, a lisp function), use `pr-update-menus'
+function (see it for documentation) to update text printer menu."
+ :type 'symbol
+ :set 'pr-txt-name-custom-set
+ :group 'printing)
+
+
+(defcustom pr-txt-printer-alist
+ (list (list 'default lpr-command nil
+ (cond ((boundp 'printer-name) printer-name)
+ (ps-windows-system "PRN")
+ (t nil)
+ )))
;; Examples:
;; * On GNU or Unix system:
;; '((prt_06a "lpr" nil "prt_06a")
(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)
-(defcustom pr-setting-database
- '((no-duplex ; setting symbol name
- nil nil nil ; inherits local kill-local
- (pr-file-duplex . nil) ; settings
- (pr-file-tumble . nil))
- )
- "*Specify an alist for settings in general.
+(defcustom pr-menu-char-height (pr-menu-char-height)
+ "*Specify menu char height in pixels.
-The elements have the following form:
+This variable is used to guess which vertical position should be locked the
+menu, so don't forget to adjust it if menu position is not ok.
- (SYMBOL INHERITS LOCAL KILL-LOCAL SETTING...)
+See also `pr-menu-lock' and `pr-menu-char-width'."
+ :type 'integer
+ :group 'printing)
-Where:
-SYMBOL It's a symbol to identify the setting group.
+(defcustom pr-menu-char-width (pr-menu-char-width)
+ "*Specify menu char width in pixels.
-INHERITS Specify the inheritance for SYMBOL group. It's a symbol name
+This variable is used to guess which horizontal position should be locked the
+menu, so don't forget to adjust it if menu position is not ok.
+
+See also `pr-menu-lock' and `pr-menu-char-height'."
+ :type 'integer
+ :group 'printing)
+
+
+(defcustom pr-setting-database
+ '((no-duplex ; setting symbol name
+ nil nil nil ; inherits local kill-local
+ (pr-file-duplex . nil) ; settings
+ (pr-file-tumble . nil))
+ )
+ "*Specify an alist for settings in general.
+
+The elements have the following form:
+
+ (SYMBOL INHERITS LOCAL KILL-LOCAL SETTING...)
+
+Where:
+
+SYMBOL It's a symbol to identify the setting group.
+
+INHERITS Specify the inheritance for SYMBOL group. It's a symbol name
setting from which the current setting inherits the context.
If INHERITS is nil, means that there is no inheritance.
This is a simple inheritance mechanism.
(variable :tag "Other"))
(sexp :tag "Value")))
))
- :version "20"
:group 'printing)
`help' | Customize >|
| Show Settings >|
| Help |
- +------------------------------+
-
-Any other value is ignored."
- :type '(repeat :tag "Menu Visible Part"
- (choice :menu-tag "Menu Part"
- :tag "Menu Part"
- (const postscript)
- (const text)
- (const postscript-options)
- (const postscript-process)
- (const printing)
- (const help)))
- :version "20"
- :group 'printing)
-
-
-(defcustom pr-delete-temp-file t
- "*Non-nil means delete temporary files.
-
-Set `pr-delete-temp-file' to nil, if the following message (or a similar)
-happens when printing:
-
- Error: could not open \"c:\\temp\\prspool.ps\" for reading."
- :type 'boolean
- :version "20"
- :group 'printing)
-
-
-(defcustom pr-list-directory nil
- "*Non-nil means list directory when processing a directory.
-
-That is, any subdirectories (and the superdirectory) of the directory (given as
-argument of functions below) are also printed (as dired-mode listings).
-
-It's used by `pr-ps-directory-preview', `pr-ps-directory-using-ghostscript',
-`pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory'
-and `pr-txt-directory'."
- :type 'boolean
- :version "20"
- :group 'printing)
-
-
-(defcustom pr-buffer-name "*Printing Interface*"
- "*Specify the name of the buffer interface for printing package.
-
-It's used by `pr-interface'."
- :type 'string
- :version "20"
- :group 'printing)
-
-
-(defcustom pr-buffer-name-ignore
- (list (regexp-quote pr-buffer-name) ; ignore printing interface buffer
- "^ .*$") ; ignore invisible buffers
- "*Specify a regexp list for buffer names to be ignored in interface buffer.
-
-NOTE: Case is important for matching, that is, `case-fold-search' is always
- nil.
-
-It's used by `pr-interface'."
- :type '(repeat (regexp :tag "Buffer Name Regexp"))
- :version "20"
- :group 'printing)
-
-
-(defcustom pr-buffer-verbose t
- "*Non-nil means to be verbose when editing a field in interface buffer.
-
-It's used by `pr-interface'."
- :type 'boolean
- :version "20"
- :group 'printing)
-
-(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")))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Internal Variables
-
-
-(defvar pr-txt-command nil
- "Name of program for printing a text file.
-See `pr-txt-printer-alist'.")
-
-
-(defvar pr-txt-switches nil
- "List of sexp's to pass as extra options to the text printer program.
-See `pr-txt-printer-alist'.")
-
-
-(defvar pr-txt-printer nil
- "Specify text printer name.
-See `pr-txt-printer-alist'.")
-
-
-(defvar pr-ps-command nil
- "Name of program for printing a PostScript file.
-See `pr-ps-printer-alist'.")
-
-
-(defvar pr-ps-switches nil
- "List of sexp's to pass as extra options to the PostScript printer program.
-See `pr-ps-printer-alist'.")
-
-
-(defvar pr-ps-printer-switch nil
- "Specify PostScript printer name switch.
-See `pr-ps-printer-alist'.")
-
-
-(defvar pr-ps-printer nil
- "Specify PostScript printer name.
-See `pr-ps-printer-alist'.")
-
-
-(defvar pr-menu-bar nil
- "Specify Printing menu-bar entry.")
-
-(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.")
-
-(defvar pr-menu-char-width) ;; Pacify the byte compiler.
-(defvar pr-menu-char-height)
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; XEmacs Definitions
-
-
-(cond
- ((featurep 'xemacs) ; XEmacs
- ;; XEmacs
- (defalias 'pr-f-set-keymap-parents 'set-keymap-parents)
- (defalias 'pr-f-set-keymap-name 'set-keymap-name)
-
- ;; XEmacs
- (defun pr-f-read-string (prompt initial history default)
- (let ((str (read-string prompt initial)))
- (if (and str (not (string= str "")))
- str
- default)))
-
- ;; XEmacs
- (defvar zmacs-region-stays nil)
-
- ;; XEmacs
- (defun pr-keep-region-active ()
- (setq zmacs-region-stays t))
-
- ;; XEmacs
- (defun pr-region-active-p ()
- (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p)))
-
- ;; XEmacs
- (defun pr-menu-char-height ()
- (font-height (face-font 'default)))
-
- ;; XEmacs
- (defun pr-menu-char-width ()
- (font-width (face-font 'default)))
-
- ;; XEmacs
- (defmacro pr-xemacs-global-menubar (&rest body)
- `(save-excursion
- (let ((temp (get-buffer-create (make-temp-name " *Temp"))))
- ;; be sure to access global menubar
- (set-buffer temp)
- ,@body
- (kill-buffer temp))))
-
- ;; XEmacs
- (defun pr-global-menubar (pr-menu-spec)
- ;; Menu binding
- (pr-xemacs-global-menubar
- (add-submenu nil (cons "Printing" pr-menu-spec) "Apps"))
- (setq pr-menu-print-item nil))
-
- ;; XEmacs
- (defvar current-mouse-event nil)
- (defun pr-menu-position (entry index horizontal)
- (make-event
- 'button-release
- (list 'button 1
- 'x (- (event-x-pixel current-mouse-event) ; X
- (* horizontal pr-menu-char-width))
- 'y (- (event-y-pixel current-mouse-event) ; Y
- (* (pr-menu-index entry index) pr-menu-char-height)))))
-
- (defvar pr-menu-position nil)
- (defvar pr-menu-state nil)
-
- ;; XEmacs
- (defvar current-menubar nil) ; to avoid compilation gripes
- (defun pr-menu-lookup (path)
- (car (find-menu-item current-menubar (cons "Printing" path))))
-
- ;; XEmacs
- (defun pr-menu-lock (entry index horizontal state path)
- (when pr-menu-lock
- (or (and pr-menu-position (eq state pr-menu-state))
- (setq pr-menu-position (pr-menu-position entry index horizontal)
- pr-menu-state state))
- (let* ((menu (pr-menu-lookup path))
- (result (get-popup-menu-response menu pr-menu-position)))
- (and (misc-user-event-p result)
- (funcall (event-function result)
- (event-object result))))
- (setq pr-menu-position nil)))
-
- ;; XEmacs
- (defalias 'pr-update-mode-line 'set-menubar-dirty-flag)
-
- ;; XEmacs
- (defvar pr-ps-name-old "PostScript Printers")
- (defvar pr-txt-name-old "Text Printers")
- (defvar pr-ps-utility-old "PostScript Utility")
- (defvar pr-even-or-odd-old "Print All Pages")
-
- ;; XEmacs
- (defun pr-do-update-menus (&optional force)
- (pr-menu-alist pr-ps-printer-alist
- 'pr-ps-name
- 'pr-menu-set-ps-title
- '("Printing")
- 'pr-ps-printer-menu-modified
- force
- pr-ps-name-old
- 'postscript 2)
- (pr-menu-alist pr-txt-printer-alist
- 'pr-txt-name
- 'pr-menu-set-txt-title
- '("Printing")
- 'pr-txt-printer-menu-modified
- force
- pr-txt-name-old
- 'text 2)
- (let ((save-var pr-ps-utility-menu-modified))
- (pr-menu-alist pr-ps-utility-alist
- 'pr-ps-utility
- 'pr-menu-set-utility-title
- '("Printing" "PostScript Print" "File")
- 'save-var
- force
- pr-ps-utility-old
- nil 1))
- (pr-menu-alist pr-ps-utility-alist
- 'pr-ps-utility
- 'pr-menu-set-utility-title
- '("Printing" "PostScript Preview" "File")
- 'pr-ps-utility-menu-modified
- force
- pr-ps-utility-old
- nil 1)
- (pr-even-or-odd-pages ps-even-or-odd-pages force))
-
- ;; XEmacs
- (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
- entry index)
- (when (and alist (or force (symbol-value modified-sym)))
- (pr-xemacs-global-menubar
- (add-submenu menu-path
- (pr-menu-create name alist var-sym
- fun entry index)))
- (funcall fun (symbol-value var-sym))
- (set modified-sym nil)))
-
- ;; XEmacs
- (defun pr-relabel-menu-item (newname var-sym)
- (pr-xemacs-global-menubar
- (relabel-menu-item
- (list "Printing" (symbol-value var-sym))
- newname)
- (set var-sym newname)))
-
- ;; XEmacs
- (defun pr-menu-set-ps-title (value &optional item entry index)
- (pr-relabel-menu-item (format "PostScript Printer: %s" value)
- 'pr-ps-name-old)
- (pr-ps-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
-
- ;; XEmacs
- (defun pr-menu-set-txt-title (value &optional item entry index)
- (pr-relabel-menu-item (format "Text Printer: %s" value)
- 'pr-txt-name-old)
- (pr-txt-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
-
- ;; XEmacs
- (defun pr-menu-set-utility-title (value &optional item entry index)
- (pr-xemacs-global-menubar
- (let ((newname (format "%s" value)))
- (relabel-menu-item
- (list "Printing" "PostScript Print" "File" pr-ps-utility-old)
- newname)
- (relabel-menu-item
- (list "Printing" "PostScript Preview" "File" pr-ps-utility-old)
- newname)
- (setq pr-ps-utility-old newname)))
- (pr-ps-set-utility value)
- (and index
- (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
-
- ;; XEmacs
- (defun pr-even-or-odd-pages (value &optional no-lock)
- (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist))
- 'pr-even-or-odd-old)
- (setq ps-even-or-odd-pages value)
- (or no-lock
- (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
-
- )
- (t ; GNU Emacs
- ;; Do nothing
- )) ; end cond featurep
-
-
-\f
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; GNU Emacs Definitions
-
-
-(cond
- ((featurep 'xemacs) ; XEmacs
- ;; Do nothing
- )
- (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)
-
- ;; GNU Emacs
- (defvar deactivate-mark)
-
- ;; GNU Emacs
- (defun pr-keep-region-active ()
- (setq deactivate-mark nil))
-
- ;; GNU Emacs
- (defun pr-region-active-p ()
- (and pr-auto-region transient-mark-mode mark-active))
-
- ;; GNU Emacs
- (defun pr-menu-char-height ()
- (frame-char-height))
-
- ;; GNU Emacs
- (defun pr-menu-char-width ()
- (frame-char-width))
-
- ;; GNU Emacs
- ;; Menu binding
- ;; 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-and-compile
- (cond
- ;; 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)
- (setq pr-menu-print-item nil
- pr-menu-bar (vector 'menu-bar 'tools
- (pr-get-symbol "Printing")))))
- )
- ;; 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") ; GNU Emacs 21
- '("menu-bar" "file")))) ; GNU Emacs 22 or higher
- (cond
- (pr-menu-print-item
- (easy-menu-add-item global-map menu-file
- (easy-menu-create-menu "Print" pr-menu-spec)
- "print-buffer")
- (dolist (item '("print-buffer" "print-region"
- "ps-print-buffer-faces" "ps-print-region-faces"
- "ps-print-buffer" "ps-print-region"))
- (easy-menu-remove-item global-map menu-file item))
- (setq pr-menu-print-item nil
- pr-menu-bar (vector 'menu-bar
- (pr-get-symbol (nth 1 menu-file))
- (pr-get-symbol "Print"))))
- (t
- (easy-menu-add-item global-map menu-file
- (easy-menu-create-menu "Print" pr-menu-spec)))
- )))
- )))
+ +------------------------------+
- (eval-and-compile
- (cond
- (ps-windows-system
- ;; GNU Emacs for Windows 9x/NT
- (defun pr-menu-position (entry index horizontal)
- (let ((pos (cdr (mouse-pixel-position))))
- (list
- (list (or (car pos) 0) ; X
- (- (or (cdr pos) 0) ; Y
- (* (pr-menu-index entry index) pr-menu-char-height)))
- (selected-frame)))) ; frame
- )
- (t
- ;; GNU Emacs
- (defun pr-menu-position (entry index horizontal)
- (let ((pos (cdr (mouse-pixel-position))))
- (list
- (list (- (or (car pos) 0) ; X
- (* horizontal pr-menu-char-width))
- (- (or (cdr pos) 0) ; Y
- (* (pr-menu-index entry index) pr-menu-char-height)))
- (selected-frame)))) ; frame
- )))
+Any other value is ignored."
+ :type '(repeat :tag "Menu Visible Part"
+ (choice :menu-tag "Menu Part"
+ :tag "Menu Part"
+ (const postscript)
+ (const text)
+ (const postscript-options)
+ (const postscript-process)
+ (const printing)
+ (const help)))
+ :group 'printing)
- (defvar pr-menu-position nil)
- (defvar pr-menu-state nil)
- ;; GNU Emacs
- (defun pr-menu-lookup (path)
- (lookup-key global-map
- (if path
- (vconcat pr-menu-bar
- (mapcar 'pr-get-symbol
- (if (listp path)
- path
- (list path))))
- pr-menu-bar)))
+(defcustom pr-delete-temp-file t
+ "*Non-nil means delete temporary files.
- ;; GNU Emacs
- (defun pr-menu-lock (entry index horizontal state path)
- (when pr-menu-lock
- (or (and pr-menu-position (eq state pr-menu-state))
- (setq pr-menu-position (pr-menu-position entry index horizontal)
- pr-menu-state state))
- (let* ((menu (pr-menu-lookup path))
- (result (x-popup-menu pr-menu-position menu)))
- (and result
- (let ((command (lookup-key menu (vconcat result))))
- (if (fboundp command)
- (funcall command)
- (eval command)))))
- (setq pr-menu-position nil)))
+Set `pr-delete-temp-file' to nil, if the following message (or a similar)
+happens when printing:
- ;; GNU Emacs
- (defalias 'pr-update-mode-line 'force-mode-line-update)
+ Error: could not open \"c:\\temp\\prspool.ps\" for reading."
+ :type 'boolean
+ :group 'printing)
- ;; GNU Emacs
- (defun pr-do-update-menus (&optional force)
- (pr-menu-alist pr-ps-printer-alist
- 'pr-ps-name
- 'pr-menu-set-ps-title
- "PostScript Printers"
- 'pr-ps-printer-menu-modified
- force
- "PostScript Printers"
- 'postscript 2)
- (pr-menu-alist pr-txt-printer-alist
- 'pr-txt-name
- 'pr-menu-set-txt-title
- "Text Printers"
- 'pr-txt-printer-menu-modified
- force
- "Text Printers"
- 'text 2)
- (let ((save-var pr-ps-utility-menu-modified))
- (pr-menu-alist pr-ps-utility-alist
- 'pr-ps-utility
- 'pr-menu-set-utility-title
- '("PostScript Print" "File" "PostScript Utility")
- 'save-var
- force
- "PostScript Utility"
- nil 1))
- (pr-menu-alist pr-ps-utility-alist
- 'pr-ps-utility
- 'pr-menu-set-utility-title
- '("PostScript Preview" "File" "PostScript Utility")
- 'pr-ps-utility-menu-modified
- force
- "PostScript Utility"
- nil 1)
- (pr-even-or-odd-pages ps-even-or-odd-pages force))
- ;; GNU Emacs
- (defun pr-menu-get-item (name-list)
- ;; NAME-LIST is a string or a list of strings.
- (or (listp name-list)
- (setq name-list (list name-list)))
- (and name-list
- (let* ((reversed (reverse name-list))
- (name (pr-get-symbol (car reversed)))
- (path (nreverse (cdr reversed)))
- (menu (lookup-key
- global-map
- (vconcat pr-menu-bar
- (mapcar 'pr-get-symbol path)))))
- (assq name (nthcdr 2 menu)))))
+(defcustom pr-list-directory nil
+ "*Non-nil means list directory when processing a directory.
- ;; GNU Emacs
- (defvar pr-temp-menu nil)
+That is, any subdirectories (and the superdirectory) of the directory (given as
+argument of functions below) are also printed (as dired-mode listings).
- ;; GNU Emacs
- (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
- entry index)
- (when (and alist (or force (symbol-value modified-sym)))
- (easy-menu-define pr-temp-menu nil ""
- (pr-menu-create name alist var-sym fun entry index))
- (let ((item (pr-menu-get-item menu-path)))
- (and item
- (let* ((binding (nthcdr 3 item))
- (key-binding (cdr binding)))
- (setcar binding pr-temp-menu)
- (and key-binding (listp (car key-binding))
- (setcdr binding (cdr key-binding))) ; skip KEY-BINDING
- (funcall fun (symbol-value var-sym) item))))
- (set modified-sym nil)))
+It's used by `pr-ps-directory-preview', `pr-ps-directory-using-ghostscript',
+`pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory'
+and `pr-txt-directory'."
+ :type 'boolean
+ :group 'printing)
- ;; GNU Emacs
- (defun pr-menu-set-item-name (item name)
- (and item
- (setcar (nthcdr 2 item) name))) ; ITEM-NAME
- ;; GNU Emacs
- (defun pr-menu-set-ps-title (value &optional item entry index)
- (pr-menu-set-item-name (or item
- (pr-menu-get-item "PostScript Printers"))
- (format "PostScript Printer: %s" value))
- (pr-ps-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
+(defcustom pr-buffer-name "*Printing Interface*"
+ "*Specify the name of the buffer interface for printing package.
- ;; GNU Emacs
- (defun pr-menu-set-txt-title (value &optional item entry index)
- (pr-menu-set-item-name (or item
- (pr-menu-get-item "Text Printers"))
- (format "Text Printer: %s" value))
- (pr-txt-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
+It's used by `pr-interface'."
+ :type 'string
+ :group 'printing)
- ;; GNU Emacs
- (defun pr-menu-set-utility-title (value &optional item entry index)
- (let ((name (symbol-name value)))
- (if item
- (pr-menu-set-item-name item name)
- (pr-menu-set-item-name
- (pr-menu-get-item
- '("PostScript Print" "File" "PostScript Utility"))
- name)
- (pr-menu-set-item-name
- (pr-menu-get-item
- '("PostScript Preview" "File" "PostScript Utility"))
- name)))
- (pr-ps-set-utility value)
- (and index
- (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
- ;; GNU Emacs
- (defun pr-even-or-odd-pages (value &optional no-lock)
- (pr-menu-set-item-name (pr-menu-get-item "Print All Pages")
- (cdr (assq value pr-even-or-odd-alist)))
- (setq ps-even-or-odd-pages value)
- (or no-lock
- (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
+(defcustom pr-buffer-name-ignore
+ (list (regexp-quote pr-buffer-name) ; ignore printing interface buffer
+ "^ .*$") ; ignore invisible buffers
+ "*Specify a regexp list for buffer names to be ignored in interface buffer.
- )) ; end cond featurep
+NOTE: Case is important for matching, that is, `case-fold-search' is always
+ nil.
+
+It's used by `pr-interface'."
+ :type '(repeat (regexp :tag "Buffer Name Regexp"))
+ :group 'printing)
+
+
+(defcustom pr-buffer-verbose t
+ "*Non-nil means to be verbose when editing a field in interface buffer.
+
+It's used by `pr-interface'."
+ :type 'boolean
+ :group 'printing)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User Interface (III)
+;; Internal Variables
-(defcustom pr-menu-char-height (pr-menu-char-height)
- "*Specify menu char height in pixels.
-This variable is used to guess which vertical position should be locked the
-menu, so don't forget to adjust it if menu position is not ok.
+(defvar pr-txt-command nil
+ "Name of program for printing a text file.
+See `pr-txt-printer-alist'.")
-See also `pr-menu-lock' and `pr-menu-char-width'."
- :type 'integer
- :version "20"
- :group 'printing)
+(defvar pr-txt-switches nil
+ "List of sexp's to pass as extra options to the text printer program.
+See `pr-txt-printer-alist'.")
-(defcustom pr-menu-char-width (pr-menu-char-width)
- "*Specify menu char width in pixels.
-This variable is used to guess which horizontal position should be locked the
-menu, so don't forget to adjust it if menu position is not ok.
+(defvar pr-txt-printer nil
+ "Specify text printer name.
+See `pr-txt-printer-alist'.")
-See also `pr-menu-lock' and `pr-menu-char-height'."
- :type 'integer
- :version "20"
- :group 'printing)
+
+(defvar pr-ps-command nil
+ "Name of program for printing a PostScript file.
+See `pr-ps-printer-alist'.")
+
+
+(defvar pr-ps-switches nil
+ "List of sexp's to pass as extra options to the PostScript printer program.
+See `pr-ps-printer-alist'.")
+
+
+(defvar pr-ps-printer-switch nil
+ "Specify PostScript printer name switch.
+See `pr-ps-printer-alist'.")
+
+
+(defvar pr-ps-printer nil
+ "Specify PostScript printer name.
+See `pr-ps-printer-alist'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
(eval-when-compile
"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)