Mercurial > emacs
changeset 78413:15aa7ac77da1
Require lpr and ps-print when loading printing package
| author | Vinicius Jose Latorre <viniciusjl@ig.com.br> |
|---|---|
| date | Sun, 05 Aug 2007 12:58:00 +0000 |
| parents | 8a48dd7864d1 |
| children | 781746b1e97f |
| files | lisp/ChangeLog lisp/printing.el |
| diffstat | 2 files changed, 454 insertions(+), 427 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Aug 05 12:48:27 2007 +0000 +++ b/lisp/ChangeLog Sun Aug 05 12:58:00 2007 +0000 @@ -1,3 +1,8 @@ +2007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br> + + * printing.el: Require lpr and ps-print when loading printing package. + Reported by Glenn Morris <rgm@gnu.org>. + 2007-08-05 Michael Albinus <michael.albinus@gmx.de> * files.el (set-auto-mode): Handle also remote files wrt
--- a/lisp/printing.el Sun Aug 05 12:48:27 2007 +0000 +++ b/lisp/printing.el Sun Aug 05 12:58:00 2007 +0000 @@ -6,11 +6,11 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, print, PostScript -;; Version: 6.8.4 +;; Version: 6.9.1 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre -(defconst pr-version "6.8.4" - "printing.el, v 6.8.4 <2005/06/11 vinicius> +(defconst pr-version "6.9.1" + "printing.el, v 6.9.1 <2007/08/02 vinicius> Please send all bug fixes and enhancements to Vinicius Jose Latorre <viniciusjl@ig.com.br> @@ -1093,46 +1093,457 @@ (set-default-file-modes umask))))) -;; GNU Emacs -(defalias 'pr-e-frame-char-height 'frame-char-height) -(defalias 'pr-e-frame-char-width 'frame-char-width) -(defalias 'pr-e-mouse-pixel-position 'mouse-pixel-position) -;; XEmacs -(defalias 'pr-x-add-submenu 'add-submenu) -(defalias 'pr-x-event-function 'event-function) -(defalias 'pr-x-event-object 'event-object) -(defalias 'pr-x-find-menu-item 'find-menu-item) -(defalias 'pr-x-font-height 'font-height) -(defalias 'pr-x-font-width 'font-width) -(defalias 'pr-x-get-popup-menu-response 'get-popup-menu-response) -(defalias 'pr-x-make-event 'make-event) -(defalias 'pr-x-misc-user-event-p 'misc-user-event-p) -(defalias 'pr-x-relabel-menu-item 'relabel-menu-item) -(defalias 'pr-x-event-x-pixel 'event-x-pixel) -(defalias 'pr-x-event-y-pixel 'event-y-pixel) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; XEmacs Definitions + (cond ((featurep 'xemacs) ; XEmacs - (defvar current-menubar nil) - (defvar current-mouse-event nil) - (defvar zmacs-region-stays nil) + ;; 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))) - + (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 - (defvar deactivate-mark nil) + ;; Do nothing + )) ; end cond featurep + + + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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)))) + (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 + ))) + + (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))) + + ;; 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))) + + ;; 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)) + + ;; 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))))) + + ;; GNU Emacs + (defvar pr-temp-menu nil) + + ;; 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 + + ;; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1592,7 +2003,7 @@ (VARIABLE . VALUE) - That associates VARIABLE with VALUE. when this entry is + Which associates VARIABLE with VALUE. When this entry is selected, it's executed the following command: (set VARIABLE (eval VALUE)) @@ -2147,7 +2558,7 @@ (VARIABLE-SYM . VALUE) - That associates VARIABLE-SYM with VALUE. when this entry is + Which associates VARIABLE-SYM with VALUE. When this entry is selected, it's executed the following command: (set (make-local-variable VARIABLE-SYM) (eval VALUE)) @@ -2327,7 +2738,7 @@ (VARIABLE . VALUE) - That associates VARIABLE with VALUE. when this entry is + Which associates VARIABLE with VALUE. When this entry is selected, it's executed the following command: (set VARIABLE (eval VALUE)) @@ -2452,11 +2863,7 @@ :group 'printing) -(defcustom pr-menu-char-height - (cond ((featurep 'xemacs) ; XEmacs - (pr-x-font-height (face-font 'default))) - (t ; GNU Emacs - (pr-e-frame-char-height))) +(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 @@ -2468,11 +2875,7 @@ :group 'printing) -(defcustom pr-menu-char-width - (cond ((featurep 'xemacs) ; XEmacs - (pr-x-font-width (face-font 'default))) - (t ; GNU Emacs - (pr-e-frame-char-width))) +(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 @@ -2544,7 +2947,7 @@ (VARIABLE . VALUE) - That associates VARIABLE with VALUE. when this entry is + Which associates VARIABLE with VALUE. When this entry is selected, it's executed the following command: * If LOCAL is non-nil: @@ -2772,15 +3175,6 @@ ;; Keys & Menus -(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)))) - - (defsubst pr-visible-p (key) (memq key pr-visible-entry-list)) @@ -2802,16 +3196,6 @@ 'easy-menu-intern (lambda (s) (if (stringp s) (intern s) s)))) -(cond - ((featurep 'xemacs) ; XEmacs - (defvar zmacs-region-stays nil) ; to avoid compilation gripes - (defun pr-region-active-p () - (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p)))) - - (t ; GNU Emacs - (defun pr-region-active-p () - (and pr-auto-region transient-mark-mode mark-active)))) - (defconst pr-menu-spec ;; Menu mapping: @@ -3070,51 +3454,7 @@ Calls `pr-update-menus' to adjust menus." (interactive) - (cond - ((featurep 'xemacs) ; XEmacs - ;; Menu binding - (pr-xemacs-global-menubar - (pr-x-add-submenu nil (cons "Printing" pr-menu-spec) "Apps")) - (setq pr-menu-print-item nil)) - - - (t ; 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. - (cond - ;; Emacs 20 - ((< emacs-major-version 21) - (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"))))) - ;; Emacs 21 & 22 - (t - (let ((menu-file (if (= emacs-major-version 21) - '("menu-bar" "files") ; Emacs 21 - '("menu-bar" "file")))) ; 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))) - )))))) + (pr-global-menubar pr-menu-spec) (pr-update-menus t)) @@ -4841,94 +5181,6 @@ (+ index 2)) -(defvar pr-menu-position nil) -(defvar pr-menu-state nil) - - -(cond - ((featurep 'xemacs) - ;; XEmacs - (defvar current-mouse-event nil) ; to avoid compilation gripes - (defun pr-menu-position (entry index horizontal) - (pr-x-make-event - 'button-release - (list 'button 1 - 'x (- (pr-x-event-x-pixel current-mouse-event) ; X - (* horizontal pr-menu-char-width)) - 'y (- (pr-x-event-y-pixel current-mouse-event) ; Y - (* (pr-menu-index entry index) pr-menu-char-height))))) - ) - (ps-windows-system - ;; GNU Emacs for Windows 9x/NT - (defun pr-menu-position (entry index horizontal) - (let ((pos (cdr (pr-e-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 (pr-e-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 - )) - -(cond - ((featurep 'xemacs) - ;; XEmacs - (defvar current-menubar nil) ; to avoid compilation gripes - (defun pr-menu-lookup (path) - (car (pr-x-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 (pr-x-get-popup-menu-response menu pr-menu-position))) - (and (pr-x-misc-user-event-p result) - (funcall (pr-x-event-function result) - (pr-x-event-object result)))) - (setq pr-menu-position nil)))) - - - (t - ;; 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))) - - ;; 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))))) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Printer & Utility Selection @@ -4991,237 +5243,6 @@ alist))) -(cond - ((featurep 'xemacs) - ;; 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 - (pr-x-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 - (pr-x-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))) - (pr-x-relabel-menu-item - (list "Printing" "PostScript Print" "File" pr-ps-utility-old) - newname) - (pr-x-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 - (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)) - - ;; 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))))) - - ;; GNU Emacs - (defvar pr-temp-menu nil) - - ;; 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 - - ;; 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))))) - - (defun pr-ps-set-utility (value) (let ((item (cdr (assq value pr-ps-utility-alist)))) (or item @@ -5997,9 +6018,10 @@ ;; Printing Interface (inspired on 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)