aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-04-09 16:28:42 -0400
committerStefan Monnier2019-04-09 16:28:42 -0400
commit4f19bbb125a706f9657a299df1c5f03c81ed4a71 (patch)
treeaec3d9027713f40dcd3d8c397ce127a54d13870e
parent8a5ecdaa2faa550b4f3553beeda91c3c99c9bc05 (diff)
downloademacs-4f19bbb125a706f9657a299df1c5f03c81ed4a71.tar.gz
emacs-4f19bbb125a706f9657a299df1c5f03c81ed4a71.zip
* lisp/printing.el: Use lexical-binding
Require easy-menu instead of adding declarations. Remove backward compatiblity. Remove redundant ':group' args. (pr-region-active-p): Use use-region-p. (pr-set-keymap-name): Delete function and callers. (pr-set-keymap-parents): Delete function; use set-keymap-parent instead. (pr-read-string): Delete function; use read-string instead. (pr-menu-char-height): Delete function; use frame-char-height instead. (pr-menu-char-width): Delete function; use frame-char-width instead. (pr-menu-position): Merge the two definitions. (pr-get-symbol): Delete function; use easy-menu-intern instead. (pr-update-mode-line): Delete function; use force-mode-line-update instead. (pr-do-update-menus): Turn local save-var into dynbound pr--save-var. (pr-menu-alist): Use setf. Simplify since we don't keep key-bindings in the menus any more. (pr-dosify-file-name): Remove interactive spec. (pr-filename-style): Rename from pr-path-style. (pr-unixify-file-name): Delete function. (pr-standard-file-name): Don't turn \ into / under POSIX. (pr-temp-dir): Don't dosify. Use temporary-file-directory unconditionally. (pr-save-file-modes): Delete macro. (pr-ps-directory-using-ghostscript, pr-ps-directory-print) (pr-ps-directory-ps-print, pr-ps-mode-using-ghostscript, pr-ps-print) (pr-ps-mode-preview, pr-ps-mode-print, pr-printify-directory) (pr-txt-directory, pr-ps-file-up-preview, pr-ps-directory-preview) (pr-ps-file-up-ps-print, pr-ps-preview, pr-ps-using-ghostscript): Use properly prefixed, declared, and explicitly let-bound dynamically bound variables around calls to pr-ps-utility-args and pr-set-dir-args. (pr-ps-file-using-ghostscript): Only dosify when passing to suprocess. (pr-expand-file-name): Delete function; use expand-file-name instead. (pr-ps-file-print): Properly dosify. (pr-menu-create): Use backquotes. (pr-eval-alist, pr-eval-local-alist): Use dolist. (pr-ps-utility-args): Don't dosify here. (pr-ps-utility-process): Dosify here instead. (pr-ps-file, pr-command): Don't dosify here either. (pr-interface-map): Move initialization into declaration. (pr-insert-section-1): Use 'push'. (pr-insert-toggle): Use closure instead of backquoted lambda. (pr-insert-menu): Use apply i.s.o eval. (pr-insert-radio-button): Avoid 'eval'.
-rw-r--r--lisp/printing.el1758
1 files changed, 656 insertions, 1102 deletions
diff --git a/lisp/printing.el b/lisp/printing.el
index 27856eb09fc..f2495ecda38 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1,4 +1,4 @@
1;;; printing.el --- printing utilities 1;;; printing.el --- printing utilities -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2000-2001, 2003-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2001, 2003-2019 Free Software Foundation, Inc.
4 4
@@ -460,7 +460,7 @@ Please send all bug fixes and enhancements to
460;; subjects shows up at the printer. With major mode printing you don't need 460;; subjects shows up at the printer. With major mode printing you don't need
461;; to switch from gnus *Summary* buffer first. 461;; to switch from gnus *Summary* buffer first.
462;; 462;;
463;; Current global keyboard mapping for GNU Emacs is: 463;; Current global keyboard mapping is:
464;; 464;;
465;; (global-set-key [print] 'pr-ps-fast-fire) 465;; (global-set-key [print] 'pr-ps-fast-fire)
466;; (global-set-key [M-print] 'pr-ps-mode-using-ghostscript) 466;; (global-set-key [M-print] 'pr-ps-mode-using-ghostscript)
@@ -468,14 +468,6 @@ Please send all bug fixes and enhancements to
468;; (global-set-key [C-print] 'pr-txt-fast-fire) 468;; (global-set-key [C-print] 'pr-txt-fast-fire)
469;; (global-set-key [C-M-print] 'pr-txt-fast-fire) 469;; (global-set-key [C-M-print] 'pr-txt-fast-fire)
470;; 470;;
471;; And for XEmacs is:
472;;
473;; (global-set-key 'f22 'pr-ps-fast-fire)
474;; (global-set-key '(meta f22) 'pr-ps-mode-using-ghostscript)
475;; (global-set-key '(shift f22) 'pr-ps-mode-using-ghostscript)
476;; (global-set-key '(control f22) 'pr-txt-fast-fire)
477;; (global-set-key '(control meta f22) 'pr-txt-fast-fire)
478;;
479;; As a suggestion of global keyboard mapping for some `printing' commands: 471;; As a suggestion of global keyboard mapping for some `printing' commands:
480;; 472;;
481;; (global-set-key "\C-ci" 'pr-interface) 473;; (global-set-key "\C-ci" 'pr-interface)
@@ -493,7 +485,7 @@ Please send all bug fixes and enhancements to
493;; Below it's shown a brief description of `printing' options, please, see the 485;; Below it's shown a brief description of `printing' options, please, see the
494;; options declaration in the code for a long documentation. 486;; options declaration in the code for a long documentation.
495;; 487;;
496;; `pr-path-style' Specify which path style to use for external 488;; `pr-filename-style' Specify which filename style to use for external
497;; commands. 489;; commands.
498;; 490;;
499;; `pr-path-alist' Specify an alist for command paths. 491;; `pr-path-alist' Specify an alist for command paths.
@@ -999,7 +991,7 @@ Please send all bug fixes and enhancements to
999;; - automagic region detection. 991;; - automagic region detection.
1000;; - menu entry hiding. 992;; - menu entry hiding.
1001;; - fast fire PostScript printing command. 993;; - fast fire PostScript printing command.
1002;; - `pr-path-style' variable. 994;; - `pr-filename-style' variable.
1003;; 995;;
1004;; Thanks to Kim F. Storm <storm@filanet.dk> for beta-test and for suggestions: 996;; Thanks to Kim F. Storm <storm@filanet.dk> for beta-test and for suggestions:
1005;; - PostScript Print and PostScript Print Preview merge. 997;; - PostScript Print and PostScript Print Preview merge.
@@ -1023,7 +1015,7 @@ Please send all bug fixes and enhancements to
1023 1015
1024(require 'lpr) 1016(require 'lpr)
1025(require 'ps-print) 1017(require 'ps-print)
1026 1018(require 'easymenu)
1027 1019
1028(and (string< ps-print-version "6.6.4") 1020(and (string< ps-print-version "6.6.4")
1029 (error "`printing' requires `ps-print' package version 6.6.4 or later")) 1021 (error "`printing' requires `ps-print' package version 6.6.4 or later"))
@@ -1038,93 +1030,16 @@ Please send all bug fixes and enhancements to
1038;; To avoid compilation gripes 1030;; To avoid compilation gripes
1039 1031
1040 1032
1041;; Emacs has this since at least 21.1. 1033;; User Interface --- declared here to avoid compiler warnings
1042(when (featurep 'xemacs) 1034(define-obsolete-variable-alias 'pr-path-style 'pr-filename-style "27.1")
1043 (or (fboundp 'subst-char-in-string) ; hacked from subr.el 1035(defvar pr-filename-style)
1044 (defun subst-char-in-string (fromchar tochar string &optional inplace) 1036(defvar pr-auto-region)
1045 "Replace FROMCHAR with TOCHAR in STRING each time it occurs. 1037(defvar pr-menu-char-height)
1046Unless optional argument INPLACE is non-nil, return a new string." 1038(defvar pr-menu-char-width)
1047 (let ((i (length string)) 1039(defvar pr-menu-lock)
1048 (newstr (if inplace string (copy-sequence string)))) 1040(defvar pr-ps-printer-alist)
1049 (while (> (setq i (1- i)) 0) 1041(defvar pr-txt-printer-alist)
1050 (if (eq (aref newstr i) fromchar) 1042(defvar pr-ps-utility-alist)
1051 (aset newstr i tochar)))
1052 newstr))))
1053
1054
1055;; Emacs has this since at least 21.1, but the SUFFIX argument
1056;; (which this file uses) only since 22.1. So the fboundp test
1057;; wasn't even correct/adequate. Whatever, no-one is using
1058;; this file on older Emacs version, so it's irrelevant.
1059(when (featurep 'xemacs)
1060 (or (fboundp 'make-temp-file) ; hacked from subr.el
1061 (defun make-temp-file (prefix &optional dir-flag suffix)
1062 "Create a temporary file.
1063The returned file name (created by appending some random characters at the end
1064of PREFIX, and expanding against `temporary-file-directory' if necessary),
1065is guaranteed to point to a newly created empty file.
1066You can then use `write-region' to write new data into the file.
1067
1068If DIR-FLAG is non-nil, create a new empty directory instead of a file.
1069
1070If SUFFIX is non-nil, add that at the end of the file name."
1071 (let ((umask (default-file-modes))
1072 file)
1073 (unwind-protect
1074 (progn
1075 ;; Create temp files with strict access rights. It's easy to
1076 ;; loosen them later, whereas it's impossible to close the
1077 ;; time-window of loose permissions otherwise.
1078 (set-default-file-modes ?\700)
1079 (while (condition-case ()
1080 (progn
1081 (setq file
1082 (make-temp-name
1083 (expand-file-name prefix temporary-file-directory)))
1084 (if suffix
1085 (setq file (concat file suffix)))
1086 (if dir-flag
1087 (make-directory file)
1088 (write-region "" nil file nil 'silent nil 'excl))
1089 nil)
1090 (file-already-exists t))
1091 ;; the file was somehow created by someone else between
1092 ;; `make-temp-name' and `write-region', let's try again.
1093 nil)
1094 file)
1095 ;; Reset the umask.
1096 (set-default-file-modes umask))))))
1097
1098
1099(eval-when-compile
1100 ;; User Interface --- declared here to avoid compiler warnings
1101 (defvar pr-path-style)
1102 (defvar pr-auto-region)
1103 (defvar pr-menu-char-height)
1104 (defvar pr-menu-char-width)
1105 (defvar pr-menu-lock)
1106 (defvar pr-ps-printer-alist)
1107 (defvar pr-txt-printer-alist)
1108 (defvar pr-ps-utility-alist)
1109
1110
1111 ;; Internal fun alias to avoid compilation gripes
1112 (defalias 'pr-menu-lookup 'ignore)
1113 (defalias 'pr-menu-lock 'ignore)
1114 (defalias 'pr-menu-alist 'ignore)
1115 (defalias 'pr-even-or-odd-pages 'ignore)
1116 (defalias 'pr-menu-get-item 'ignore)
1117 (defalias 'pr-menu-set-item-name 'ignore)
1118 (defalias 'pr-menu-set-utility-title 'ignore)
1119 (defalias 'pr-menu-set-ps-title 'ignore)
1120 (defalias 'pr-menu-set-txt-title 'ignore)
1121 (defalias 'pr-region-active-p 'ignore)
1122 (defalias 'pr-do-update-menus 'ignore)
1123 (defalias 'pr-update-mode-line 'ignore)
1124 (defalias 'pr-read-string 'ignore)
1125 (defalias 'pr-set-keymap-parents 'ignore)
1126 (defalias 'pr-keep-region-active 'ignore))
1127
1128 1043
1129;; Internal Vars --- defined here to avoid compiler warnings 1044;; Internal Vars --- defined here to avoid compiler warnings
1130(defvar pr-menu-print-item "print" 1045(defvar pr-menu-print-item "print"
@@ -1151,480 +1066,206 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
1151 1066
1152;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1067;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1153;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1068;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1154;; XEmacs Definitions 1069;; GNU Emacs Definitions
1155
1156
1157(cond
1158 ((featurep 'xemacs) ; XEmacs
1159 ;; XEmacs
1160 (defalias 'pr-set-keymap-parents 'set-keymap-parents)
1161 (defalias 'pr-set-keymap-name 'set-keymap-name)
1162
1163 ;; XEmacs
1164 (defun pr-read-string (prompt initial history default)
1165 (let ((str (read-string prompt initial)))
1166 (if (and str (not (string= str "")))
1167 str
1168 default)))
1169
1170 ;; XEmacs
1171 (defvar zmacs-region-stays nil)
1172
1173 ;; XEmacs
1174 (defun pr-keep-region-active ()
1175 (setq zmacs-region-stays t))
1176
1177 ;; XEmacs
1178 (defun pr-region-active-p ()
1179 (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p)))
1180
1181 ;; XEmacs
1182 (defun pr-menu-char-height ()
1183 (font-height (face-font 'default)))
1184
1185 ;; XEmacs
1186 (defun pr-menu-char-width ()
1187 (font-width (face-font 'default)))
1188
1189 ;; XEmacs
1190 (defmacro pr-xemacs-global-menubar (&rest body)
1191 `(save-excursion
1192 (let ((temp (get-buffer-create (make-temp-name " *Temp"))))
1193 ;; be sure to access global menubar
1194 (set-buffer temp)
1195 ,@body
1196 (kill-buffer temp))))
1197
1198 ;; XEmacs
1199 (defun pr-global-menubar (pr-menu-spec)
1200 ;; Menu binding
1201 (pr-xemacs-global-menubar
1202 (add-submenu nil (cons "Printing" pr-menu-spec) "Apps"))
1203 (setq pr-menu-print-item nil))
1204
1205 ;; XEmacs
1206 (defvar current-mouse-event nil)
1207 (defun pr-menu-position (entry index horizontal)
1208 (make-event
1209 'button-release
1210 (list 'button 1
1211 'x (- (event-x-pixel current-mouse-event) ; X
1212 (* horizontal pr-menu-char-width))
1213 'y (- (event-y-pixel current-mouse-event) ; Y
1214 (* (pr-menu-index entry index) pr-menu-char-height)))))
1215
1216 (defvar pr-menu-position nil)
1217 (defvar pr-menu-state nil)
1218
1219 ;; XEmacs
1220 (defvar current-menubar nil) ; to avoid compilation gripes
1221 (defun pr-menu-lookup (path)
1222 (car (find-menu-item current-menubar (cons "Printing" path))))
1223
1224 ;; XEmacs
1225 (defun pr-menu-lock (entry index horizontal state path)
1226 (when pr-menu-lock
1227 (or (and pr-menu-position (eq state pr-menu-state))
1228 (setq pr-menu-position (pr-menu-position entry index horizontal)
1229 pr-menu-state state))
1230 (let* ((menu (pr-menu-lookup path))
1231 (result (get-popup-menu-response menu pr-menu-position)))
1232 (and (misc-user-event-p result)
1233 (funcall (event-function result)
1234 (event-object result))))
1235 (setq pr-menu-position nil)))
1236
1237 ;; XEmacs
1238 (defalias 'pr-update-mode-line 'set-menubar-dirty-flag)
1239
1240 ;; XEmacs
1241 (defvar pr-ps-name-old "PostScript Printers")
1242 (defvar pr-txt-name-old "Text Printers")
1243 (defvar pr-ps-utility-old "PostScript Utility")
1244 (defvar pr-even-or-odd-old "Print All Pages")
1245
1246 ;; XEmacs
1247 (defun pr-do-update-menus (&optional force)
1248 (pr-menu-alist pr-ps-printer-alist
1249 'pr-ps-name
1250 'pr-menu-set-ps-title
1251 '("Printing")
1252 'pr-ps-printer-menu-modified
1253 force
1254 pr-ps-name-old
1255 'postscript 2)
1256 (pr-menu-alist pr-txt-printer-alist
1257 'pr-txt-name
1258 'pr-menu-set-txt-title
1259 '("Printing")
1260 'pr-txt-printer-menu-modified
1261 force
1262 pr-txt-name-old
1263 'text 2)
1264 (let ((save-var pr-ps-utility-menu-modified))
1265 (pr-menu-alist pr-ps-utility-alist
1266 'pr-ps-utility
1267 'pr-menu-set-utility-title
1268 '("Printing" "PostScript Print" "File")
1269 'save-var
1270 force
1271 pr-ps-utility-old
1272 nil 1))
1273 (pr-menu-alist pr-ps-utility-alist
1274 'pr-ps-utility
1275 'pr-menu-set-utility-title
1276 '("Printing" "PostScript Preview" "File")
1277 'pr-ps-utility-menu-modified
1278 force
1279 pr-ps-utility-old
1280 nil 1)
1281 (pr-even-or-odd-pages ps-even-or-odd-pages force))
1282
1283 ;; XEmacs
1284 (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
1285 entry index)
1286 (when (and alist (or force (symbol-value modified-sym)))
1287 (pr-xemacs-global-menubar
1288 (add-submenu menu-path
1289 (pr-menu-create name alist var-sym
1290 fun entry index)))
1291 (funcall fun (symbol-value var-sym))
1292 (set modified-sym nil)))
1293
1294 ;; XEmacs
1295 (defun pr-relabel-menu-item (newname var-sym)
1296 (pr-xemacs-global-menubar
1297 (relabel-menu-item
1298 (list "Printing" (symbol-value var-sym))
1299 newname)
1300 (set var-sym newname)))
1301
1302 ;; XEmacs
1303 (defun pr-menu-set-ps-title (value &optional item entry index)
1304 (pr-relabel-menu-item (format "PostScript Printer: %s" value)
1305 'pr-ps-name-old)
1306 (pr-ps-set-printer value)
1307 (and index
1308 (pr-menu-lock entry index 12 'toggle nil)))
1309
1310 ;; XEmacs
1311 (defun pr-menu-set-txt-title (value &optional item entry index)
1312 (pr-relabel-menu-item (format "Text Printer: %s" value)
1313 'pr-txt-name-old)
1314 (pr-txt-set-printer value)
1315 (and index
1316 (pr-menu-lock entry index 12 'toggle nil)))
1317
1318 ;; XEmacs
1319 (defun pr-menu-set-utility-title (value &optional item entry index)
1320 (pr-xemacs-global-menubar
1321 (let ((newname (format "%s" value)))
1322 (relabel-menu-item
1323 (list "Printing" "PostScript Print" "File" pr-ps-utility-old)
1324 newname)
1325 (relabel-menu-item
1326 (list "Printing" "PostScript Preview" "File" pr-ps-utility-old)
1327 newname)
1328 (setq pr-ps-utility-old newname)))
1329 (pr-ps-set-utility value)
1330 (and index
1331 (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
1332
1333 ;; XEmacs
1334 (defun pr-even-or-odd-pages (value &optional no-lock)
1335 (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist))
1336 'pr-even-or-odd-old)
1337 (setq ps-even-or-odd-pages value)
1338 (or no-lock
1339 (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
1340
1341 )
1342 (t ; GNU Emacs
1343 ;; Do nothing
1344 )) ; end cond featurep
1345 1070
1071(defun pr-keep-region-active ()
1072 (setq deactivate-mark nil))
1346 1073
1347 1074(defun pr-region-active-p ()
1348;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1075 (and pr-auto-region (use-region-p)))
1349;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1350;; GNU Emacs Definitions
1351 1076
1352(eval-and-compile 1077;; Menu binding
1353 (unless (featurep 'xemacs) 1078;; Replace existing "print" item by "Printing" item.
1354 (defvar pr-menu-bar nil 1079;; If you're changing this file, you'll load it a second,
1355 "Specify Printing menu-bar entry."))) 1080;; third... time, but "print" item exists only in the first load.
1356 1081
1357(cond 1082(defvar pr-menu-bar nil
1358 ((featurep 'xemacs) ; XEmacs 1083 "Specify Printing menu-bar entry.")
1359 ;; Do nothing 1084
1360 ) 1085(defun pr-global-menubar (menu-spec)
1361 (t ; GNU Emacs 1086 (let ((menu-file '("menu-bar" "file")))
1362 ;; GNU Emacs
1363 (defalias 'pr-set-keymap-parents 'set-keymap-parent)
1364 (defalias 'pr-set-keymap-name 'ignore)
1365 (defalias 'pr-read-string 'read-string)
1366
1367 ;; GNU Emacs
1368 (defvar deactivate-mark)
1369
1370 ;; GNU Emacs
1371 (defun pr-keep-region-active ()
1372 (setq deactivate-mark nil))
1373
1374 ;; GNU Emacs
1375 (defun pr-region-active-p ()
1376 (and pr-auto-region transient-mark-mode mark-active))
1377
1378 ;; GNU Emacs
1379 (defun pr-menu-char-height ()
1380 (frame-char-height))
1381
1382 ;; GNU Emacs
1383 (defun pr-menu-char-width ()
1384 (frame-char-width))
1385
1386 ;; GNU Emacs
1387 ;; Menu binding
1388 ;; Replace existing "print" item by "Printing" item.
1389 ;; If you're changing this file, you'll load it a second,
1390 ;; third... time, but "print" item exists only in the first load.
1391 (eval-when-compile
1392 (require 'easymenu)) ; to avoid compilation gripes
1393
1394 (declare-function easy-menu-add-item "easymenu"
1395 (map path item &optional before))
1396 (declare-function easy-menu-remove-item "easymenu" (map path name))
1397
1398 (eval-and-compile
1399 (defun pr-global-menubar (pr-menu-spec)
1400 (require 'easymenu)
1401 (let ((menu-file (if (= emacs-major-version 21)
1402 '("menu-bar" "files") ; GNU Emacs 21
1403 '("menu-bar" "file")))) ; GNU Emacs 22 or higher
1404 (cond
1405 (pr-menu-print-item
1406 (easy-menu-add-item global-map menu-file
1407 (easy-menu-create-menu "Print" pr-menu-spec)
1408 "print-buffer")
1409 (dolist (item '("print-buffer" "print-region"
1410 "ps-print-buffer-faces" "ps-print-region-faces"
1411 "ps-print-buffer" "ps-print-region"))
1412 (easy-menu-remove-item global-map menu-file item))
1413 (setq pr-menu-print-item nil
1414 pr-menu-bar (vector 'menu-bar
1415 (pr-get-symbol (nth 1 menu-file))
1416 (pr-get-symbol "Print"))))
1417 (t
1418 (easy-menu-add-item global-map menu-file
1419 (easy-menu-create-menu "Print" pr-menu-spec)))
1420 ))))
1421
1422 (eval-and-compile
1423 (cond 1087 (cond
1424 (lpr-windows-system 1088 (pr-menu-print-item
1425 ;; GNU Emacs for Windows 9x/NT 1089 (easy-menu-add-item global-map menu-file
1426 (defun pr-menu-position (entry index horizontal) 1090 (easy-menu-create-menu "Print" menu-spec)
1427 (let ((pos (cdr (mouse-pixel-position)))) 1091 "print-buffer")
1428 (list 1092 (dolist (item '("print-buffer" "print-region"
1429 (list (or (car pos) 0) ; X 1093 "ps-print-buffer-faces" "ps-print-region-faces"
1430 (- (or (cdr pos) 0) ; Y 1094 "ps-print-buffer" "ps-print-region"))
1431 (* (pr-menu-index entry index) pr-menu-char-height))) 1095 (easy-menu-remove-item global-map menu-file item))
1432 (selected-frame)))) ; frame 1096 (setq pr-menu-print-item nil
1433 ) 1097 pr-menu-bar (vector 'menu-bar
1098 (easy-menu-intern (nth 1 menu-file))
1099 (easy-menu-intern "Print"))))
1434 (t 1100 (t
1435 ;; GNU Emacs 1101 (easy-menu-add-item global-map menu-file
1436 (defun pr-menu-position (entry index horizontal) 1102 (easy-menu-create-menu "Print" menu-spec)))
1437 (let ((pos (cdr (mouse-pixel-position)))) 1103 )))
1438 (list 1104
1439 (list (- (or (car pos) 0) ; X 1105(defun pr-menu-position (entry index horizontal)
1440 (* horizontal pr-menu-char-width)) 1106 (let ((pos (cdr (mouse-pixel-position))))
1441 (- (or (cdr pos) 0) ; Y 1107 (list
1442 (* (pr-menu-index entry index) pr-menu-char-height))) 1108 (list (- (or (car pos) 0) ; X
1443 (selected-frame)))) ; frame 1109 (if lpr-windows-system
1444 ))) 1110 0 ;; GNU Emacs for Windows 9x/NT
1445 1111 (* horizontal pr-menu-char-width)))
1446 (defvar pr-menu-position nil) 1112 (- (or (cdr pos) 0) ; Y
1447 (defvar pr-menu-state nil) 1113 (* (pr-menu-index entry index) pr-menu-char-height)))
1448 1114 (selected-frame)))) ; frame
1449 ;; GNU Emacs 1115
1450 (defun pr-menu-lookup (path) 1116(defvar pr-menu-position nil)
1451 (lookup-key global-map 1117(defvar pr-menu-state nil)
1452 (if path 1118
1453 (vconcat pr-menu-bar 1119(defun pr-menu-lookup (path)
1454 (mapcar 'pr-get-symbol 1120 (lookup-key global-map
1455 (if (listp path) 1121 (if path
1456 path 1122 (vconcat pr-menu-bar
1457 (list path)))) 1123 (mapcar #'easy-menu-intern
1458 pr-menu-bar))) 1124 (if (listp path)
1459 1125 path
1460 ;; GNU Emacs 1126 (list path))))
1461 (defun pr-menu-lock (entry index horizontal state path) 1127 pr-menu-bar)))
1462 (when pr-menu-lock 1128
1463 (or (and pr-menu-position (eq state pr-menu-state)) 1129(defun pr-menu-lock (entry index horizontal state path)
1464 (setq pr-menu-position (pr-menu-position entry index horizontal) 1130 (when pr-menu-lock
1465 pr-menu-state state)) 1131 (or (and pr-menu-position (eq state pr-menu-state))
1466 (let* ((menu (pr-menu-lookup path)) 1132 (setq pr-menu-position (pr-menu-position entry index horizontal)
1467 (result (x-popup-menu pr-menu-position menu))) 1133 pr-menu-state state))
1468 (and result 1134 (let* ((menu (pr-menu-lookup path))
1469 (let ((command (lookup-key menu (vconcat result)))) 1135 (result (x-popup-menu pr-menu-position menu)))
1470 (if (fboundp command) 1136 (and result
1471 (funcall command) 1137 (let ((command (lookup-key menu (vconcat result))))
1472 (eval command))))) 1138 (if (fboundp command)
1473 (setq pr-menu-position nil))) 1139 (funcall command)
1474 1140 (eval command)))))
1475 ;; GNU Emacs 1141 (setq pr-menu-position nil)))
1476 (defalias 'pr-update-mode-line 'force-mode-line-update) 1142
1477 1143(defun pr-do-update-menus (&optional force)
1478 ;; GNU Emacs 1144 (pr-menu-alist pr-ps-printer-alist
1479 (defun pr-do-update-menus (&optional force) 1145 'pr-ps-name
1480 (pr-menu-alist pr-ps-printer-alist 1146 #'pr-menu-set-ps-title
1481 'pr-ps-name 1147 "PostScript Printers"
1482 'pr-menu-set-ps-title 1148 'pr-ps-printer-menu-modified
1483 "PostScript Printers" 1149 force
1484 'pr-ps-printer-menu-modified 1150 "PostScript Printers"
1485 force 1151 'postscript 2)
1486 "PostScript Printers" 1152 (pr-menu-alist pr-txt-printer-alist
1487 'postscript 2) 1153 'pr-txt-name
1488 (pr-menu-alist pr-txt-printer-alist 1154 #'pr-menu-set-txt-title
1489 'pr-txt-name 1155 "Text Printers"
1490 'pr-menu-set-txt-title 1156 'pr-txt-printer-menu-modified
1491 "Text Printers" 1157 force
1492 'pr-txt-printer-menu-modified 1158 "Text Printers"
1493 force 1159 'text 2)
1494 "Text Printers" 1160 (defvar pr--save-var)
1495 'text 2) 1161 (let ((pr--save-var pr-ps-utility-menu-modified))
1496 (let ((save-var pr-ps-utility-menu-modified))
1497 (pr-menu-alist pr-ps-utility-alist
1498 'pr-ps-utility
1499 'pr-menu-set-utility-title
1500 '("PostScript Print" "File" "PostScript Utility")
1501 'save-var
1502 force
1503 "PostScript Utility"
1504 nil 1))
1505 (pr-menu-alist pr-ps-utility-alist 1162 (pr-menu-alist pr-ps-utility-alist
1506 'pr-ps-utility 1163 'pr-ps-utility
1507 'pr-menu-set-utility-title 1164 #'pr-menu-set-utility-title
1508 '("PostScript Preview" "File" "PostScript Utility") 1165 '("PostScript Print" "File" "PostScript Utility")
1509 'pr-ps-utility-menu-modified 1166 'pr--save-var
1510 force 1167 force
1511 "PostScript Utility" 1168 "PostScript Utility"
1512 nil 1) 1169 nil 1))
1513 (pr-even-or-odd-pages ps-even-or-odd-pages force)) 1170 (pr-menu-alist pr-ps-utility-alist
1514 1171 'pr-ps-utility
1515 ;; GNU Emacs 1172 #'pr-menu-set-utility-title
1516 (defun pr-menu-get-item (name-list) 1173 '("PostScript Preview" "File" "PostScript Utility")
1517 ;; NAME-LIST is a string or a list of strings. 1174 'pr-ps-utility-menu-modified
1518 (or (listp name-list) 1175 force
1519 (setq name-list (list name-list))) 1176 "PostScript Utility"
1520 (and name-list 1177 nil 1)
1521 (let* ((reversed (reverse name-list)) 1178 (pr-even-or-odd-pages ps-even-or-odd-pages force))
1522 (name (pr-get-symbol (car reversed))) 1179
1523 (path (nreverse (cdr reversed))) 1180(defun pr-menu-get-item (name-list)
1524 (menu (lookup-key 1181 ;; NAME-LIST is a string or a list of strings.
1525 global-map 1182 (or (listp name-list)
1526 (vconcat pr-menu-bar 1183 (setq name-list (list name-list)))
1527 (mapcar 'pr-get-symbol path))))) 1184 (and name-list
1528 (assq name (nthcdr 2 menu))))) 1185 (let* ((reversed (reverse name-list))
1529 1186 (name (easy-menu-intern (car reversed)))
1530 ;; GNU Emacs 1187 (path (nreverse (cdr reversed)))
1531 (defvar pr-temp-menu nil) 1188 (menu (lookup-key
1532 1189 global-map
1533 ;; GNU Emacs 1190 (vconcat pr-menu-bar
1534 (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name 1191 (mapcar #'easy-menu-intern path)))))
1535 entry index) 1192 (assq name (nthcdr 2 menu)))))
1536 (when (and alist (or force (symbol-value modified-sym))) 1193
1537 (easy-menu-define pr-temp-menu nil "" 1194(defvar pr-temp-menu nil)
1538 (pr-menu-create name alist var-sym fun entry index)) 1195
1539 (let ((item (pr-menu-get-item menu-path))) 1196(defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
1540 (and item 1197 entry index)
1541 (let* ((binding (nthcdr 3 item)) 1198 (when (and alist (or force (symbol-value modified-sym)))
1542 (key-binding (cdr binding))) 1199 (easy-menu-define pr-temp-menu nil ""
1543 (setcar binding pr-temp-menu) 1200 (pr-menu-create name alist var-sym fun entry index))
1544 (and key-binding (listp (car key-binding)) 1201 (let ((item (pr-menu-get-item menu-path)))
1545 (setcdr binding (cdr key-binding))) ; skip KEY-BINDING 1202 (and item
1546 (funcall fun (symbol-value var-sym) item)))) 1203 (progn
1547 (set modified-sym nil))) 1204 (setf (nth 3 item) pr-temp-menu)
1548 1205 (funcall fun (symbol-value var-sym) item))))
1549 ;; GNU Emacs 1206 (set modified-sym nil)))
1550 (defun pr-menu-set-item-name (item name) 1207
1551 (and item 1208(defun pr-menu-set-item-name (item name)
1552 (setcar (nthcdr 2 item) name))) ; ITEM-NAME 1209 (and item
1553 1210 (setcar (nthcdr 2 item) name))) ; ITEM-NAME
1554 ;; GNU Emacs 1211
1555 (defun pr-menu-set-ps-title (value &optional item entry index) 1212(defun pr-menu-set-ps-title (value &optional item entry index)
1556 (pr-menu-set-item-name (or item 1213 (pr-menu-set-item-name (or item
1557 (pr-menu-get-item "PostScript Printers")) 1214 (pr-menu-get-item "PostScript Printers"))
1558 (format "PostScript Printer: %s" value)) 1215 (format "PostScript Printer: %s" value))
1559 (pr-ps-set-printer value) 1216 (pr-ps-set-printer value)
1560 (and index 1217 (and index
1561 (pr-menu-lock entry index 12 'toggle nil))) 1218 (pr-menu-lock entry index 12 'toggle nil)))
1562 1219
1563 ;; GNU Emacs 1220(defun pr-menu-set-txt-title (value &optional item entry index)
1564 (defun pr-menu-set-txt-title (value &optional item entry index) 1221 (pr-menu-set-item-name (or item
1565 (pr-menu-set-item-name (or item 1222 (pr-menu-get-item "Text Printers"))
1566 (pr-menu-get-item "Text Printers")) 1223 (format "Text Printer: %s" value))
1567 (format "Text Printer: %s" value)) 1224 (pr-txt-set-printer value)
1568 (pr-txt-set-printer value) 1225 (and index
1569 (and index 1226 (pr-menu-lock entry index 12 'toggle nil)))
1570 (pr-menu-lock entry index 12 'toggle nil))) 1227
1571 1228(defun pr-menu-set-utility-title (value &optional item entry index)
1572 ;; GNU Emacs 1229 (let ((name (symbol-name value)))
1573 (defun pr-menu-set-utility-title (value &optional item entry index) 1230 (if item
1574 (let ((name (symbol-name value))) 1231 (pr-menu-set-item-name item name)
1575 (if item 1232 (pr-menu-set-item-name
1576 (pr-menu-set-item-name item name) 1233 (pr-menu-get-item
1577 (pr-menu-set-item-name 1234 '("PostScript Print" "File" "PostScript Utility"))
1578 (pr-menu-get-item 1235 name)
1579 '("PostScript Print" "File" "PostScript Utility")) 1236 (pr-menu-set-item-name
1580 name) 1237 (pr-menu-get-item
1581 (pr-menu-set-item-name 1238 '("PostScript Preview" "File" "PostScript Utility"))
1582 (pr-menu-get-item 1239 name)))
1583 '("PostScript Preview" "File" "PostScript Utility")) 1240 (pr-ps-set-utility value)
1584 name))) 1241 (and index
1585 (pr-ps-set-utility value) 1242 (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
1586 (and index 1243
1587 (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) 1244(defun pr-even-or-odd-pages (value &optional no-lock)
1588 1245 (pr-menu-set-item-name (pr-menu-get-item "Print All Pages")
1589 ;; GNU Emacs 1246 (cdr (assq value pr-even-or-odd-alist)))
1590 (defun pr-even-or-odd-pages (value &optional no-lock) 1247 (setq ps-even-or-odd-pages value)
1591 (pr-menu-set-item-name (pr-menu-get-item "Print All Pages") 1248 (or no-lock
1592 (cdr (assq value pr-even-or-odd-alist))) 1249 (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
1593 (setq ps-even-or-odd-pages value)
1594 (or no-lock
1595 (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
1596
1597 )) ; end cond featurep
1598
1599 1250
1600;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1251;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1601;; Internal Functions (I) 1252;; Internal Functions (I)
1602 1253
1603 1254
1604(defun pr-dosify-file-name (path) 1255(defun pr-dosify-file-name (filename)
1605 "Replace unix-style directory separator character with dos/windows one." 1256 "Replace unix-style directory separator character with dos/windows one."
1606 (interactive "sPath: ") 1257 (if (eq pr-filename-style 'windows)
1607 (if (eq pr-path-style 'windows) 1258 (subst-char-in-string ?/ ?\\ filename)
1608 (subst-char-in-string ?/ ?\\ path) 1259 filename))
1609 path))
1610
1611 1260
1612(defun pr-unixify-file-name (path) 1261(defun pr-standard-file-name (filename)
1613 "Replace dos/windows-style directory separator character with unix one."
1614 (interactive "sPath: ")
1615 (if (eq pr-path-style 'windows)
1616 (subst-char-in-string ?\\ ?/ path)
1617 path))
1618
1619
1620(defun pr-standard-file-name (path)
1621 "Ensure the proper directory separator depending on the OS. 1262 "Ensure the proper directory separator depending on the OS.
1622That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory 1263That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory
1623separator; otherwise, ensure unix-style directory separator." 1264separator; otherwise, ensure unix-style directory separator."
1265 ;; FIXME: Why not use pr-dosify-file-name?
1624 (if (or pr-cygwin-system lpr-windows-system) 1266 (if (or pr-cygwin-system lpr-windows-system)
1625 (subst-char-in-string ?/ ?\\ path) 1267 (subst-char-in-string ?/ ?\\ filename)
1626 (subst-char-in-string ?\\ ?/ path))) 1268 filename))
1627
1628 1269
1629;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1270;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1630;; Customization Functions 1271;; Customization Functions
@@ -1672,22 +1313,21 @@ separator; otherwise, ensure unix-style directory separator."
1672 :group 'postscript) 1313 :group 'postscript)
1673 1314
1674 1315
1675(defcustom pr-path-style 1316(defcustom pr-filename-style
1676 (if (and (not pr-cygwin-system) 1317 (if (and (not pr-cygwin-system)
1677 lpr-windows-system) 1318 lpr-windows-system)
1678 'windows 1319 'windows
1679 'unix) 1320 'unix)
1680 "Specify which path style to use for external commands. 1321 "Specify which filename style to use for external commands.
1681 1322
1682Valid values are: 1323Valid values are:
1683 1324
1684 windows Windows 9x/NT style (\\) 1325 windows Windows 9x/NT style (\\)
1685 1326
1686 unix Unix style (/)" 1327 unix Unix style (/)"
1687 :type '(choice :tag "Path style" 1328 :type '(choice :tag "Filename style"
1688 (const :tag "Windows 9x/NT Style (\\)" :value windows) 1329 (const :tag "Windows 9x/NT Style (\\)" :value windows)
1689 (const :tag "Unix Style (/)" :value unix)) 1330 (const :tag "Unix Style (/)" :value unix)))
1690 :group 'printing)
1691 1331
1692 1332
1693(defcustom pr-path-alist 1333(defcustom pr-path-alist
@@ -1708,13 +1348,13 @@ Where:
1708ENTRY It's a symbol, used to identify this entry. 1348ENTRY It's a symbol, used to identify this entry.
1709 There must exist at least one of the following entries: 1349 There must exist at least one of the following entries:
1710 1350
1711 unix this entry is used when Emacs is running on GNU or 1351 `unix' this entry is used when Emacs is running on GNU or
1712 Unix system. 1352 Unix system.
1713 1353
1714 cygwin this entry is used when Emacs is running on Windows 1354 `cygwin' this entry is used when Emacs is running on Windows
1715 95/98/NT/2000 with Cygwin. 1355 95/98/NT/2000 with Cygwin.
1716 1356
1717 windows this entry is used when Emacs is running on Windows 1357 `windows' this entry is used when Emacs is running on Windows
1718 95/98/NT/2000. 1358 95/98/NT/2000.
1719 1359
1720DIRECTORY It should be a string or a symbol. If it's a symbol, it should 1360DIRECTORY It should be a string or a symbol. If it's a symbol, it should
@@ -1764,8 +1404,7 @@ Examples:
1764 (choice :menu-tag "Directory" 1404 (choice :menu-tag "Directory"
1765 :tag "Directory" 1405 :tag "Directory"
1766 (string :value "") 1406 (string :value "")
1767 (symbol :value symbol))))) 1407 (symbol :value symbol))))))
1768 :group 'printing)
1769 1408
1770 1409
1771(defcustom pr-txt-name 'default 1410(defcustom pr-txt-name 'default
@@ -1778,8 +1417,7 @@ This variable should be modified by customization engine. If this variable is
1778modified by other means (for example, a lisp function), use `pr-update-menus' 1417modified by other means (for example, a lisp function), use `pr-update-menus'
1779function (see it for documentation) to update text printer menu." 1418function (see it for documentation) to update text printer menu."
1780 :type 'symbol 1419 :type 'symbol
1781 :set 'pr-txt-name-custom-set 1420 :set 'pr-txt-name-custom-set)
1782 :group 'printing)
1783 1421
1784 1422
1785(defcustom pr-txt-printer-alist 1423(defcustom pr-txt-printer-alist
@@ -1910,8 +1548,7 @@ Useful links:
1910 :tag "Printer Name" 1548 :tag "Printer Name"
1911 (const :tag "None" nil) 1549 (const :tag "None" nil)
1912 string))) 1550 string)))
1913 :set 'pr-alist-custom-set 1551 :set 'pr-alist-custom-set)
1914 :group 'printing)
1915 1552
1916 1553
1917(defcustom pr-ps-name 'default 1554(defcustom pr-ps-name 'default
@@ -1924,8 +1561,7 @@ This variable should be modified by customization engine. If this variable is
1924modified by other means (for example, a lisp function), use `pr-update-menus' 1561modified by other means (for example, a lisp function), use `pr-update-menus'
1925function (see it for documentation) to update PostScript printer menu." 1562function (see it for documentation) to update PostScript printer menu."
1926 :type 'symbol 1563 :type 'symbol
1927 :set 'pr-ps-name-custom-set 1564 :set 'pr-ps-name-custom-set)
1928 :group 'printing)
1929 1565
1930 1566
1931(defcustom pr-ps-printer-alist 1567(defcustom pr-ps-printer-alist
@@ -2196,33 +1832,21 @@ Useful links:
2196 (variable :tag "Other")) 1832 (variable :tag "Other"))
2197 (sexp :tag "Value"))) 1833 (sexp :tag "Value")))
2198 )) 1834 ))
2199 :set 'pr-alist-custom-set 1835 :set 'pr-alist-custom-set)
2200 :group 'printing) 1836
2201 1837
2202 1838(defcustom pr-temp-dir temporary-file-directory
2203(defcustom pr-temp-dir
2204 (pr-dosify-file-name
2205 (if (boundp 'temporary-file-directory)
2206 (symbol-value 'temporary-file-directory)
2207 ;; hacked from `temporary-file-directory' variable in files.el
2208 (file-name-as-directory
2209 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
2210 (cond (lpr-windows-system "c:/temp")
2211 (t "/tmp")
2212 )))))
2213 "Specify a directory for temporary files during printing. 1839 "Specify a directory for temporary files during printing.
2214 1840
2215See also `pr-ps-temp-file' and `pr-file-modes'." 1841See also `pr-ps-temp-file' and `pr-file-modes'."
2216 :type '(directory :tag "Temporary Directory") 1842 :type '(directory :tag "Temporary Directory"))
2217 :group 'printing)
2218 1843
2219 1844
2220(defcustom pr-ps-temp-file "prspool-" 1845(defcustom pr-ps-temp-file "prspool-"
2221 "Specify PostScript temporary file name prefix. 1846 "Specify PostScript temporary file name prefix.
2222 1847
2223See also `pr-temp-dir' and `pr-file-modes'." 1848See also `pr-temp-dir' and `pr-file-modes'."
2224 :type '(file :tag "PostScript Temporary File Name") 1849 :type '(file :tag "PostScript Temporary File Name"))
2225 :group 'printing)
2226 1850
2227 1851
2228;; It uses 0600 as default instead of (default-file-modes). 1852;; It uses 0600 as default instead of (default-file-modes).
@@ -2234,8 +1858,7 @@ See also `pr-temp-dir' and `pr-file-modes'."
2234It should be an integer; only the low 9 bits are used. 1858It should be an integer; only the low 9 bits are used.
2235 1859
2236See also `pr-temp-dir' and `pr-ps-temp-file'." 1860See also `pr-temp-dir' and `pr-ps-temp-file'."
2237 :type '(integer :tag "File Permission Bits") 1861 :type '(integer :tag "File Permission Bits"))
2238 :group 'printing)
2239 1862
2240 1863
2241(defcustom pr-gv-command 1864(defcustom pr-gv-command
@@ -2275,8 +1898,7 @@ Useful links:
2275* MacGSView (Mac OS) 1898* MacGSView (Mac OS)
2276 `http://www.cs.wisc.edu/~ghost/macos/index.htm' 1899 `http://www.cs.wisc.edu/~ghost/macos/index.htm'
2277" 1900"
2278 :type '(string :tag "Ghostview Utility") 1901 :type '(string :tag "Ghostview Utility"))
2279 :group 'printing)
2280 1902
2281 1903
2282(defcustom pr-gs-command 1904(defcustom pr-gs-command
@@ -2301,8 +1923,7 @@ Useful links:
2301* Printer compatibility 1923* Printer compatibility
2302 `http://www.cs.wisc.edu/~ghost/doc/printer.htm' 1924 `http://www.cs.wisc.edu/~ghost/doc/printer.htm'
2303" 1925"
2304 :type '(string :tag "Ghostscript Utility") 1926 :type '(string :tag "Ghostscript Utility"))
2305 :group 'printing)
2306 1927
2307 1928
2308(defcustom pr-gs-switches 1929(defcustom pr-gs-switches
@@ -2343,8 +1964,7 @@ Useful links:
2343* Printer compatibility 1964* Printer compatibility
2344 `http://www.cs.wisc.edu/~ghost/doc/printer.htm' 1965 `http://www.cs.wisc.edu/~ghost/doc/printer.htm'
2345" 1966"
2346 :type '(repeat (string :tag "Ghostscript Switch")) 1967 :type '(repeat (string :tag "Ghostscript Switch")))
2347 :group 'printing)
2348 1968
2349 1969
2350(defcustom pr-gs-device 1970(defcustom pr-gs-device
@@ -2359,8 +1979,7 @@ A note on the gs switches:
2359 1979
2360See `pr-gs-switches' for documentation. 1980See `pr-gs-switches' for documentation.
2361See also `pr-ps-printer-alist'." 1981See also `pr-ps-printer-alist'."
2362 :type '(string :tag "Ghostscript Device") 1982 :type '(string :tag "Ghostscript Device"))
2363 :group 'printing)
2364 1983
2365 1984
2366(defcustom pr-gs-resolution 300 1985(defcustom pr-gs-resolution 300
@@ -2372,8 +1991,7 @@ A note on the gs switches:
2372 1991
2373See `pr-gs-switches' for documentation. 1992See `pr-gs-switches' for documentation.
2374See also `pr-ps-printer-alist'." 1993See also `pr-ps-printer-alist'."
2375 :type '(integer :tag "Ghostscript Resolution") 1994 :type '(integer :tag "Ghostscript Resolution"))
2376 :group 'printing)
2377 1995
2378 1996
2379(defcustom pr-print-using-ghostscript nil 1997(defcustom pr-print-using-ghostscript nil
@@ -2384,32 +2002,27 @@ ghostscript to print a PostScript file.
2384 2002
2385In GNU or Unix system, if ghostscript is set as a PostScript filter, this 2003In GNU or Unix system, if ghostscript is set as a PostScript filter, this
2386variable should be nil." 2004variable should be nil."
2387 :type 'boolean 2005 :type 'boolean)
2388 :group 'printing)
2389 2006
2390 2007
2391(defcustom pr-faces-p nil 2008(defcustom pr-faces-p nil
2392 "Non-nil means print with face attributes." 2009 "Non-nil means print with face attributes."
2393 :type 'boolean 2010 :type 'boolean)
2394 :group 'printing)
2395 2011
2396 2012
2397(defcustom pr-spool-p nil 2013(defcustom pr-spool-p nil
2398 "Non-nil means spool printing in a buffer." 2014 "Non-nil means spool printing in a buffer."
2399 :type 'boolean 2015 :type 'boolean)
2400 :group 'printing)
2401 2016
2402 2017
2403(defcustom pr-file-landscape nil 2018(defcustom pr-file-landscape nil
2404 "Non-nil means print PostScript file in landscape orientation." 2019 "Non-nil means print PostScript file in landscape orientation."
2405 :type 'boolean 2020 :type 'boolean)
2406 :group 'printing)
2407 2021
2408 2022
2409(defcustom pr-file-duplex nil 2023(defcustom pr-file-duplex nil
2410 "Non-nil means print PostScript file in duplex mode." 2024 "Non-nil means print PostScript file in duplex mode."
2411 :type 'boolean 2025 :type 'boolean)
2412 :group 'printing)
2413 2026
2414 2027
2415(defcustom pr-file-tumble nil 2028(defcustom pr-file-tumble nil
@@ -2419,8 +2032,7 @@ If tumble is off, produces a printing suitable for binding on the left or
2419right. 2032right.
2420If tumble is on, produces a printing suitable for binding at the top or 2033If tumble is on, produces a printing suitable for binding at the top or
2421bottom." 2034bottom."
2422 :type 'boolean 2035 :type 'boolean)
2423 :group 'printing)
2424 2036
2425 2037
2426(defcustom pr-auto-region t 2038(defcustom pr-auto-region t
@@ -2431,8 +2043,7 @@ Note that this will only work if you're using transient mark mode.
2431When this variable is non-nil, the `*-buffer*' commands will behave like 2043When this variable is non-nil, the `*-buffer*' commands will behave like
2432`*-region*' commands, that is, `*-buffer*' commands will print only the region 2044`*-region*' commands, that is, `*-buffer*' commands will print only the region
2433marked instead of all buffer." 2045marked instead of all buffer."
2434 :type 'boolean 2046 :type 'boolean)
2435 :group 'printing)
2436 2047
2437 2048
2438(defcustom pr-auto-mode t 2049(defcustom pr-auto-mode t
@@ -2442,8 +2053,7 @@ That is, if current major-mode is declared in `pr-mode-alist', the `*-buffer*'
2442and `*-region*' commands will behave like `*-mode*' commands; otherwise, 2053and `*-region*' commands will behave like `*-mode*' commands; otherwise,
2443`*-buffer*' commands will print the current buffer and `*-region*' commands 2054`*-buffer*' commands will print the current buffer and `*-region*' commands
2444will print the current region." 2055will print the current region."
2445 :type 'boolean 2056 :type 'boolean)
2446 :group 'printing)
2447 2057
2448 2058
2449(defcustom pr-mode-alist 2059(defcustom pr-mode-alist
@@ -2642,8 +2252,7 @@ DEFAULT It's a way to set default values when this entry is selected.
2642 (const :tag "inherits-from:" inherits-from:) 2252 (const :tag "inherits-from:" inherits-from:)
2643 (variable :tag "Other")) 2253 (variable :tag "Other"))
2644 (sexp :tag "Value"))) 2254 (sexp :tag "Value")))
2645 )) 2255 )))
2646 :group 'printing)
2647 2256
2648 2257
2649(defcustom pr-ps-utility 'mpage 2258(defcustom pr-ps-utility 'mpage
@@ -2659,8 +2268,7 @@ function (see it for documentation) to update PostScript utility menu.
2659NOTE: Don't forget to download and install the utilities declared on 2268NOTE: Don't forget to download and install the utilities declared on
2660 `pr-ps-utility-alist'." 2269 `pr-ps-utility-alist'."
2661 :type '(symbol :tag "PS File Utility") 2270 :type '(symbol :tag "PS File Utility")
2662 :set 'pr-ps-utility-custom-set 2271 :set 'pr-ps-utility-custom-set)
2663 :group 'printing)
2664 2272
2665 2273
2666(defcustom pr-ps-utility-alist 2274(defcustom pr-ps-utility-alist
@@ -2871,38 +2479,34 @@ Useful links:
2871 (variable :tag "Other")) 2479 (variable :tag "Other"))
2872 (sexp :tag "Value"))) 2480 (sexp :tag "Value")))
2873 )) 2481 ))
2874 :set 'pr-alist-custom-set 2482 :set 'pr-alist-custom-set)
2875 :group 'printing)
2876 2483
2877 2484
2878(defcustom pr-menu-lock t 2485(defcustom pr-menu-lock t
2879 "Non-nil means menu is locked while selecting toggle options. 2486 "Non-nil means menu is locked while selecting toggle options.
2880 2487
2881See also `pr-menu-char-height' and `pr-menu-char-width'." 2488See also `pr-menu-char-height' and `pr-menu-char-width'."
2882 :type 'boolean 2489 :type 'boolean)
2883 :group 'printing)
2884 2490
2885 2491
2886(defcustom pr-menu-char-height (pr-menu-char-height) 2492(defcustom pr-menu-char-height (frame-char-height)
2887 "Specify menu char height in pixels. 2493 "Specify menu char height in pixels.
2888 2494
2889This variable is used to guess which vertical position should be locked the 2495This variable is used to guess which vertical position should be locked the
2890menu, so don't forget to adjust it if menu position is not ok. 2496menu, so don't forget to adjust it if menu position is not ok.
2891 2497
2892See also `pr-menu-lock' and `pr-menu-char-width'." 2498See also `pr-menu-lock' and `pr-menu-char-width'."
2893 :type 'integer 2499 :type 'integer)
2894 :group 'printing)
2895 2500
2896 2501
2897(defcustom pr-menu-char-width (pr-menu-char-width) 2502(defcustom pr-menu-char-width (frame-char-width)
2898 "Specify menu char width in pixels. 2503 "Specify menu char width in pixels.
2899 2504
2900This variable is used to guess which horizontal position should be locked the 2505This variable is used to guess which horizontal position should be locked the
2901menu, so don't forget to adjust it if menu position is not ok. 2506menu, so don't forget to adjust it if menu position is not ok.
2902 2507
2903See also `pr-menu-lock' and `pr-menu-char-height'." 2508See also `pr-menu-lock' and `pr-menu-char-height'."
2904 :type 'integer 2509 :type 'integer)
2905 :group 'printing)
2906 2510
2907 2511
2908(defcustom pr-setting-database 2512(defcustom pr-setting-database
@@ -3017,8 +2621,7 @@ SETTING It's a cons like:
3017 (const :tag "Ghostscript Resolution" pr-gs-resolution) 2621 (const :tag "Ghostscript Resolution" pr-gs-resolution)
3018 (variable :tag "Other")) 2622 (variable :tag "Other"))
3019 (sexp :tag "Value"))) 2623 (sexp :tag "Value")))
3020 )) 2624 )))
3021 :group 'printing)
3022 2625
3023 2626
3024(defcustom pr-visible-entry-list 2627(defcustom pr-visible-entry-list
@@ -3070,8 +2673,7 @@ Any other value is ignored."
3070 (const postscript-options) 2673 (const postscript-options)
3071 (const postscript-process) 2674 (const postscript-process)
3072 (const printing) 2675 (const printing)
3073 (const help))) 2676 (const help))))
3074 :group 'printing)
3075 2677
3076 2678
3077(defcustom pr-delete-temp-file t 2679(defcustom pr-delete-temp-file t
@@ -3081,8 +2683,7 @@ Set `pr-delete-temp-file' to nil, if the following message (or a similar)
3081happens when printing: 2683happens when printing:
3082 2684
3083 Error: could not open \"c:\\temp\\prspool.ps\" for reading." 2685 Error: could not open \"c:\\temp\\prspool.ps\" for reading."
3084 :type 'boolean 2686 :type 'boolean)
3085 :group 'printing)
3086 2687
3087 2688
3088(defcustom pr-list-directory nil 2689(defcustom pr-list-directory nil
@@ -3094,16 +2695,14 @@ argument of functions below) are also printed (as dired-mode listings).
3094It's used by `pr-ps-directory-preview', `pr-ps-directory-using-ghostscript', 2695It's used by `pr-ps-directory-preview', `pr-ps-directory-using-ghostscript',
3095`pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory' 2696`pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory'
3096and `pr-txt-directory'." 2697and `pr-txt-directory'."
3097 :type 'boolean 2698 :type 'boolean)
3098 :group 'printing)
3099 2699
3100 2700
3101(defcustom pr-buffer-name "*Printing Interface*" 2701(defcustom pr-buffer-name "*Printing Interface*"
3102 "Specify the name of the buffer interface for printing package. 2702 "Specify the name of the buffer interface for printing package.
3103 2703
3104It's used by `pr-interface'." 2704It's used by `pr-interface'."
3105 :type 'string 2705 :type 'string)
3106 :group 'printing)
3107 2706
3108 2707
3109(defcustom pr-buffer-name-ignore 2708(defcustom pr-buffer-name-ignore
@@ -3115,16 +2714,14 @@ NOTE: Case is important for matching, that is, `case-fold-search' is always
3115 nil. 2714 nil.
3116 2715
3117It's used by `pr-interface'." 2716It's used by `pr-interface'."
3118 :type '(repeat (regexp :tag "Buffer Name Regexp")) 2717 :type '(repeat (regexp :tag "Buffer Name Regexp")))
3119 :group 'printing)
3120 2718
3121 2719
3122(defcustom pr-buffer-verbose t 2720(defcustom pr-buffer-verbose t
3123 "Non-nil means to be verbose when editing a field in interface buffer. 2721 "Non-nil means to be verbose when editing a field in interface buffer.
3124 2722
3125It's used by `pr-interface'." 2723It's used by `pr-interface'."
3126 :type 'boolean 2724 :type 'boolean)
3127 :group 'printing)
3128 2725
3129 2726
3130;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2727;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3167,15 +2764,6 @@ See `pr-ps-printer-alist'.")
3167 2764
3168 2765
3169;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2766;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3170;; Macros
3171
3172
3173(defmacro pr-save-file-modes (&rest body)
3174 "Execute BODY with file permissions temporarily set to `pr-file-modes'."
3175 (declare (obsolete with-file-modes "25.1"))
3176 `(with-file-modes pr-file-modes ,@body))
3177
3178;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3179;; Keys & Menus 2767;; Keys & Menus
3180 2768
3181 2769
@@ -3195,252 +2783,211 @@ See `pr-ps-printer-alist'.")
3195 (and pr-print-using-ghostscript (not pr-spool-p))) 2783 (and pr-print-using-ghostscript (not pr-spool-p)))
3196 2784
3197 2785
3198(defalias 'pr-get-symbol
3199 (if (featurep 'emacs) 'easy-menu-intern ; since 22.1
3200 (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el
3201 'easy-menu-intern
3202 (lambda (s) (if (stringp s) (intern s) s)))))
3203
3204
3205(defconst pr-menu-spec 2786(defconst pr-menu-spec
3206 ;; Menu mapping: 2787 '(
3207 ;; unfortunately XEmacs doesn't support :active for submenus, 2788 ["Printing Interface" pr-interface
3208 ;; only for items. 2789 :help "Use buffer interface instead of menu interface"]
3209 ;; So, it uses :included instead of :active. 2790 "--"
3210 ;; Also, XEmacs doesn't support :help tag. 2791 ("PostScript Preview" :included (pr-visible-p 'postscript)
3211 (let ((pr-:active (if (featurep 'xemacs) 2792 :help "Preview PostScript instead of sending to printer"
3212 :included ; XEmacs 2793 ("Directory" :active (not pr-spool-p)
3213 :active)) ; GNU Emacs 2794 ["1-up" (pr-ps-directory-preview 1 nil nil t) t]
3214 (pr-:help (if (featurep 'xemacs) 2795 ["2-up" (pr-ps-directory-preview 2 nil nil t) t]
3215 'ignore ; XEmacs 2796 ["4-up" (pr-ps-directory-preview 4 nil nil t) t]
3216 #'(lambda (text) (list :help text))))) ; GNU Emacs 2797 ["Other..." (pr-ps-directory-preview nil nil nil t)
3217 `( 2798 :keys "\\[pr-ps-buffer-preview]"])
3218 ["Printing Interface" pr-interface 2799 ("Buffer" :active (not pr-spool-p)
3219 ,@(funcall 2800 ["1-up" (pr-ps-buffer-preview 1 t) t]
3220 pr-:help "Use buffer interface instead of menu interface")] 2801 ["2-up" (pr-ps-buffer-preview 2 t) t]
2802 ["4-up" (pr-ps-buffer-preview 4 t) t]
2803 ["Other..." (pr-ps-buffer-preview nil t)
2804 :keys "\\[pr-ps-buffer-preview]"])
2805 ("Region" :active (and (not pr-spool-p) (ps-mark-active-p))
2806 ["1-up" (pr-ps-region-preview 1 t) t]
2807 ["2-up" (pr-ps-region-preview 2 t) t]
2808 ["4-up" (pr-ps-region-preview 4 t) t]
2809 ["Other..." (pr-ps-region-preview nil t)
2810 :keys "\\[pr-ps-region-preview]"])
2811 ("Mode" :active (and (not pr-spool-p) (pr-mode-alist-p))
2812 ["1-up" (pr-ps-mode-preview 1 t) t]
2813 ["2-up" (pr-ps-mode-preview 2 t) t]
2814 ["4-up" (pr-ps-mode-preview 4 t) t]
2815 ["Other..." (pr-ps-mode-preview nil t)
2816 :keys "\\[pr-ps-mode-preview]"])
2817 ("File"
2818 ["No Preprocessing..." (call-interactively 'pr-ps-file-preview)
2819 :keys "\\[pr-ps-file-preview]"
2820 :help "Preview PostScript file"]
3221 "--" 2821 "--"
3222 ("PostScript Preview" :included (pr-visible-p 'postscript) 2822 ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
3223 ,@(funcall 2823 :help "Select PostScript utility"]
3224 pr-:help "Preview PostScript instead of sending to printer")
3225 ("Directory" ,pr-:active (not pr-spool-p)
3226 ["1-up" (pr-ps-directory-preview 1 nil nil t) t]
3227 ["2-up" (pr-ps-directory-preview 2 nil nil t) t]
3228 ["4-up" (pr-ps-directory-preview 4 nil nil t) t]
3229 ["Other..." (pr-ps-directory-preview nil nil nil t)
3230 :keys "\\[pr-ps-buffer-preview]"])
3231 ("Buffer" ,pr-:active (not pr-spool-p)
3232 ["1-up" (pr-ps-buffer-preview 1 t) t]
3233 ["2-up" (pr-ps-buffer-preview 2 t) t]
3234 ["4-up" (pr-ps-buffer-preview 4 t) t]
3235 ["Other..." (pr-ps-buffer-preview nil t)
3236 :keys "\\[pr-ps-buffer-preview]"])
3237 ("Region" ,pr-:active (and (not pr-spool-p) (ps-mark-active-p))
3238 ["1-up" (pr-ps-region-preview 1 t) t]
3239 ["2-up" (pr-ps-region-preview 2 t) t]
3240 ["4-up" (pr-ps-region-preview 4 t) t]
3241 ["Other..." (pr-ps-region-preview nil t)
3242 :keys "\\[pr-ps-region-preview]"])
3243 ("Mode" ,pr-:active (and (not pr-spool-p) (pr-mode-alist-p))
3244 ["1-up" (pr-ps-mode-preview 1 t) t]
3245 ["2-up" (pr-ps-mode-preview 2 t) t]
3246 ["4-up" (pr-ps-mode-preview 4 t) t]
3247 ["Other..." (pr-ps-mode-preview nil t)
3248 :keys "\\[pr-ps-mode-preview]"])
3249 ("File"
3250 ["No Preprocessing..." (call-interactively 'pr-ps-file-preview)
3251 :keys "\\[pr-ps-file-preview]"
3252 ,@(funcall
3253 pr-:help "Preview PostScript file")]
3254 "--"
3255 ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
3256 ,@(funcall
3257 pr-:help "Select PostScript utility")]
3258 "--"
3259 ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist]
3260 ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist]
3261 ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist]
3262 ["Other..." (pr-ps-file-up-preview nil t t)
3263 :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist]
3264 "--"
3265 ["Landscape" pr-toggle-file-landscape-menu
3266 :style toggle :selected pr-file-landscape
3267 ,@(funcall
3268 pr-:help "Toggle landscape for PostScript file")
3269 :active pr-ps-utility-alist]
3270 ["Duplex" pr-toggle-file-duplex-menu
3271 :style toggle :selected pr-file-duplex
3272 ,@(funcall
3273 pr-:help "Toggle duplex for PostScript file")
3274 :active pr-ps-utility-alist]
3275 ["Tumble" pr-toggle-file-tumble-menu
3276 :style toggle :selected pr-file-tumble
3277 ,@(funcall
3278 pr-:help "Toggle tumble for PostScript file")
3279 :active (and pr-file-duplex pr-ps-utility-alist)])
3280 ["Despool..." (call-interactively 'pr-despool-preview)
3281 :active pr-spool-p :keys "\\[pr-despool-preview]"
3282 ,@(funcall
3283 pr-:help "Despool PostScript buffer to printer or file (C-u)")])
3284 ("PostScript Print" :included (pr-visible-p 'postscript)
3285 ,@(funcall
3286 pr-:help "Send PostScript to printer or file (C-u)")
3287 ("Directory"
3288 ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t]
3289 ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t]
3290 ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t]
3291 ["Other..." (pr-ps-directory-ps-print nil nil nil t)
3292 :keys "\\[pr-ps-buffer-ps-print]"])
3293 ("Buffer"
3294 ["1-up" (pr-ps-buffer-ps-print 1 t) t]
3295 ["2-up" (pr-ps-buffer-ps-print 2 t) t]
3296 ["4-up" (pr-ps-buffer-ps-print 4 t) t]
3297 ["Other..." (pr-ps-buffer-ps-print nil t)
3298 :keys "\\[pr-ps-buffer-ps-print]"])
3299 ("Region" ,pr-:active (ps-mark-active-p)
3300 ["1-up" (pr-ps-region-ps-print 1 t) t]
3301 ["2-up" (pr-ps-region-ps-print 2 t) t]
3302 ["4-up" (pr-ps-region-ps-print 4 t) t]
3303 ["Other..." (pr-ps-region-ps-print nil t)
3304 :keys "\\[pr-ps-region-ps-print]"])
3305 ("Mode" ,pr-:active (pr-mode-alist-p)
3306 ["1-up" (pr-ps-mode-ps-print 1 t) t]
3307 ["2-up" (pr-ps-mode-ps-print 2 t) t]
3308 ["4-up" (pr-ps-mode-ps-print 4 t) t]
3309 ["Other..." (pr-ps-mode-ps-print nil t)
3310 :keys "\\[pr-ps-mode-ps-print]"])
3311 ("File"
3312 ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print)
3313 :keys "\\[pr-ps-file-ps-print]"
3314 ,@(funcall
3315 pr-:help "Send PostScript file to printer")]
3316 "--"
3317 ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
3318 ,@(funcall
3319 pr-:help "Select PostScript utility")]
3320 "--"
3321 ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist]
3322 ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist]
3323 ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist]
3324 ["Other..." (pr-ps-file-up-ps-print nil t t)
3325 :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist]
3326 "--"
3327 ["Landscape" pr-toggle-file-landscape-menu
3328 :style toggle :selected pr-file-landscape
3329 ,@(funcall
3330 pr-:help "Toggle landscape for PostScript file")
3331 :active pr-ps-utility-alist]
3332 ["Duplex" pr-toggle-file-duplex-menu
3333 :style toggle :selected pr-file-duplex
3334 ,@(funcall
3335 pr-:help "Toggle duplex for PostScript file")
3336 :active pr-ps-utility-alist]
3337 ["Tumble" pr-toggle-file-tumble-menu
3338 :style toggle :selected pr-file-tumble
3339 ,@(funcall
3340 pr-:help "Toggle tumble for PostScript file")
3341 :active (and pr-file-duplex pr-ps-utility-alist)])
3342 ["Despool..." (call-interactively 'pr-despool-ps-print)
3343 :active pr-spool-p :keys "\\[pr-despool-ps-print]"
3344 ,@(funcall
3345 pr-:help "Despool PostScript buffer to printer or file (C-u)")])
3346 ["PostScript Printers" pr-update-menus
3347 :active pr-ps-printer-alist :included (pr-visible-p 'postscript)
3348 ,@(funcall
3349 pr-:help "Select PostScript printer")]
3350 "--" 2824 "--"
3351 ("Printify" :included (pr-visible-p 'text) 2825 ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist]
3352 ,@(funcall 2826 ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist]
3353 pr-:help 2827 ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist]
3354 "Replace non-printing chars with printable representations.") 2828 ["Other..." (pr-ps-file-up-preview nil t t)
3355 ["Directory" pr-printify-directory t] 2829 :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist]
3356 ["Buffer" pr-printify-buffer t]
3357 ["Region" pr-printify-region (ps-mark-active-p)])
3358 ("Print" :included (pr-visible-p 'text)
3359 ,@(funcall
3360 pr-:help "Send text to printer")
3361 ["Directory" pr-txt-directory t]
3362 ["Buffer" pr-txt-buffer t]
3363 ["Region" pr-txt-region (ps-mark-active-p)]
3364 ["Mode" pr-txt-mode (pr-mode-alist-p)])
3365 ["Text Printers" pr-update-menus
3366 :active pr-txt-printer-alist :included (pr-visible-p 'text)
3367 ,@(funcall
3368 pr-:help "Select text printer")]
3369 "--" 2830 "--"
3370 ["Landscape" pr-toggle-landscape-menu 2831 ["Landscape" pr-toggle-file-landscape-menu
3371 :style toggle :selected ps-landscape-mode 2832 :style toggle :selected pr-file-landscape
3372 :included (pr-visible-p 'postscript-options)] 2833 :help "Toggle landscape for PostScript file"
3373 ["Print Header" pr-toggle-header-menu 2834 :active pr-ps-utility-alist]
3374 :style toggle :selected ps-print-header 2835 ["Duplex" pr-toggle-file-duplex-menu
3375 :included (pr-visible-p 'postscript-options)] 2836 :style toggle :selected pr-file-duplex
3376 ["Print Header Frame" pr-toggle-header-frame-menu 2837 :help "Toggle duplex for PostScript file"
3377 :style toggle :selected ps-print-header-frame :active ps-print-header 2838 :active pr-ps-utility-alist]
3378 :included (pr-visible-p 'postscript-options)] 2839 ["Tumble" pr-toggle-file-tumble-menu
3379 ["Line Number" pr-toggle-line-menu 2840 :style toggle :selected pr-file-tumble
3380 :style toggle :selected ps-line-number 2841 :help "Toggle tumble for PostScript file"
3381 :included (pr-visible-p 'postscript-options)] 2842 :active (and pr-file-duplex pr-ps-utility-alist)])
3382 ["Zebra Stripes" pr-toggle-zebra-menu 2843 ["Despool..." (call-interactively 'pr-despool-preview)
3383 :style toggle :selected ps-zebra-stripes 2844 :active pr-spool-p :keys "\\[pr-despool-preview]"
3384 :included (pr-visible-p 'postscript-options)] 2845 :help "Despool PostScript buffer to printer or file (C-u)"])
3385 ["Duplex" pr-toggle-duplex-menu 2846 ("PostScript Print" :included (pr-visible-p 'postscript)
3386 :style toggle :selected ps-spool-duplex 2847 :help "Send PostScript to printer or file (C-u)"
3387 :included (pr-visible-p 'postscript-options)] 2848 ("Directory"
3388 ["Tumble" pr-toggle-tumble-menu 2849 ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t]
3389 :style toggle :selected ps-spool-tumble :active ps-spool-duplex 2850 ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t]
3390 :included (pr-visible-p 'postscript-options)] 2851 ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t]
3391 ["Upside-Down" pr-toggle-upside-down-menu 2852 ["Other..." (pr-ps-directory-ps-print nil nil nil t)
3392 :style toggle :selected ps-print-upside-down 2853 :keys "\\[pr-ps-buffer-ps-print]"])
3393 :included (pr-visible-p 'postscript-options)] 2854 ("Buffer"
3394 ("Print All Pages" :included (pr-visible-p 'postscript-options) 2855 ["1-up" (pr-ps-buffer-ps-print 1 t) t]
3395 ,@(funcall 2856 ["2-up" (pr-ps-buffer-ps-print 2 t) t]
3396 pr-:help "Select odd/even pages/sheets to print") 2857 ["4-up" (pr-ps-buffer-ps-print 4 t) t]
3397 ["All Pages" (pr-even-or-odd-pages nil) 2858 ["Other..." (pr-ps-buffer-ps-print nil t)
3398 :style radio :selected (eq ps-even-or-odd-pages nil)] 2859 :keys "\\[pr-ps-buffer-ps-print]"])
3399 ["Even Pages" (pr-even-or-odd-pages 'even-page) 2860 ("Region" :active (ps-mark-active-p)
3400 :style radio :selected (eq ps-even-or-odd-pages 'even-page)] 2861 ["1-up" (pr-ps-region-ps-print 1 t) t]
3401 ["Odd Pages" (pr-even-or-odd-pages 'odd-page) 2862 ["2-up" (pr-ps-region-ps-print 2 t) t]
3402 :style radio :selected (eq ps-even-or-odd-pages 'odd-page)] 2863 ["4-up" (pr-ps-region-ps-print 4 t) t]
3403 ["Even Sheets" (pr-even-or-odd-pages 'even-sheet) 2864 ["Other..." (pr-ps-region-ps-print nil t)
3404 :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)] 2865 :keys "\\[pr-ps-region-ps-print]"])
3405 ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet) 2866 ("Mode" :active (pr-mode-alist-p)
3406 :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)]) 2867 ["1-up" (pr-ps-mode-ps-print 1 t) t]
2868 ["2-up" (pr-ps-mode-ps-print 2 t) t]
2869 ["4-up" (pr-ps-mode-ps-print 4 t) t]
2870 ["Other..." (pr-ps-mode-ps-print nil t)
2871 :keys "\\[pr-ps-mode-ps-print]"])
2872 ("File"
2873 ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print)
2874 :keys "\\[pr-ps-file-ps-print]"
2875 :help "Send PostScript file to printer"]
3407 "--" 2876 "--"
3408 ["Spool Buffer" pr-toggle-spool-menu 2877 ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
3409 :style toggle :selected pr-spool-p 2878 :help "Select PostScript utility"]
3410 :included (pr-visible-p 'postscript-process)
3411 ,@(funcall
3412 pr-:help "Toggle PostScript spooling")]
3413 ["Print with faces" pr-toggle-faces-menu
3414 :style toggle :selected pr-faces-p
3415 :included (pr-visible-p 'postscript-process)
3416 ,@(funcall
3417 pr-:help "Toggle PostScript printing with faces")]
3418 ["Print via Ghostscript" pr-toggle-ghostscript-menu
3419 :style toggle :selected pr-print-using-ghostscript
3420 :included (pr-visible-p 'postscript-process)
3421 ,@(funcall
3422 pr-:help "Toggle PostScript generation using ghostscript")]
3423 "--" 2879 "--"
3424 ["Auto Region" pr-toggle-region-menu 2880 ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist]
3425 :style toggle :selected pr-auto-region 2881 ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist]
3426 :included (pr-visible-p 'printing)] 2882 ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist]
3427 ["Auto Mode" pr-toggle-mode-menu 2883 ["Other..." (pr-ps-file-up-ps-print nil t t)
3428 :style toggle :selected pr-auto-mode 2884 :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist]
3429 :included (pr-visible-p 'printing)]
3430 ["Menu Lock" pr-toggle-lock-menu
3431 :style toggle :selected pr-menu-lock
3432 :included (pr-visible-p 'printing)]
3433 "--" 2885 "--"
3434 ("Customize" :included (pr-visible-p 'help) 2886 ["Landscape" pr-toggle-file-landscape-menu
3435 ["printing" pr-customize t] 2887 :style toggle :selected pr-file-landscape
3436 ["ps-print" ps-print-customize t] 2888 :help "Toggle landscape for PostScript file"
3437 ["lpr" lpr-customize t]) 2889 :active pr-ps-utility-alist]
3438 ("Show Settings" :included (pr-visible-p 'help) 2890 ["Duplex" pr-toggle-file-duplex-menu
3439 ["printing" pr-show-pr-setup t] 2891 :style toggle :selected pr-file-duplex
3440 ["ps-print" pr-show-ps-setup t] 2892 :help "Toggle duplex for PostScript file"
3441 ["lpr" pr-show-lpr-setup t]) 2893 :active pr-ps-utility-alist]
3442 ["Help" pr-help :active t :included (pr-visible-p 'help)] 2894 ["Tumble" pr-toggle-file-tumble-menu
3443 ))) 2895 :style toggle :selected pr-file-tumble
2896 :help "Toggle tumble for PostScript file"
2897 :active (and pr-file-duplex pr-ps-utility-alist)])
2898 ["Despool..." (call-interactively 'pr-despool-ps-print)
2899 :active pr-spool-p :keys "\\[pr-despool-ps-print]"
2900 :help "Despool PostScript buffer to printer or file (C-u)"])
2901 ["PostScript Printers" pr-update-menus
2902 :active pr-ps-printer-alist :included (pr-visible-p 'postscript)
2903 :help "Select PostScript printer"]
2904 "--"
2905 ("Printify" :included (pr-visible-p 'text)
2906 :help
2907 "Replace non-printing chars with printable representations."
2908 ["Directory" pr-printify-directory t]
2909 ["Buffer" pr-printify-buffer t]
2910 ["Region" pr-printify-region (ps-mark-active-p)])
2911 ("Print" :included (pr-visible-p 'text)
2912 :help "Send text to printer"
2913 ["Directory" pr-txt-directory t]
2914 ["Buffer" pr-txt-buffer t]
2915 ["Region" pr-txt-region (ps-mark-active-p)]
2916 ["Mode" pr-txt-mode (pr-mode-alist-p)])
2917 ["Text Printers" pr-update-menus
2918 :active pr-txt-printer-alist :included (pr-visible-p 'text)
2919 :help "Select text printer"]
2920 "--"
2921 ["Landscape" pr-toggle-landscape-menu
2922 :style toggle :selected ps-landscape-mode
2923 :included (pr-visible-p 'postscript-options)]
2924 ["Print Header" pr-toggle-header-menu
2925 :style toggle :selected ps-print-header
2926 :included (pr-visible-p 'postscript-options)]
2927 ["Print Header Frame" pr-toggle-header-frame-menu
2928 :style toggle :selected ps-print-header-frame :active ps-print-header
2929 :included (pr-visible-p 'postscript-options)]
2930 ["Line Number" pr-toggle-line-menu
2931 :style toggle :selected ps-line-number
2932 :included (pr-visible-p 'postscript-options)]
2933 ["Zebra Stripes" pr-toggle-zebra-menu
2934 :style toggle :selected ps-zebra-stripes
2935 :included (pr-visible-p 'postscript-options)]
2936 ["Duplex" pr-toggle-duplex-menu
2937 :style toggle :selected ps-spool-duplex
2938 :included (pr-visible-p 'postscript-options)]
2939 ["Tumble" pr-toggle-tumble-menu
2940 :style toggle :selected ps-spool-tumble :active ps-spool-duplex
2941 :included (pr-visible-p 'postscript-options)]
2942 ["Upside-Down" pr-toggle-upside-down-menu
2943 :style toggle :selected ps-print-upside-down
2944 :included (pr-visible-p 'postscript-options)]
2945 ("Print All Pages" :included (pr-visible-p 'postscript-options)
2946 :help "Select odd/even pages/sheets to print"
2947 ["All Pages" (pr-even-or-odd-pages nil)
2948 :style radio :selected (eq ps-even-or-odd-pages nil)]
2949 ["Even Pages" (pr-even-or-odd-pages 'even-page)
2950 :style radio :selected (eq ps-even-or-odd-pages 'even-page)]
2951 ["Odd Pages" (pr-even-or-odd-pages 'odd-page)
2952 :style radio :selected (eq ps-even-or-odd-pages 'odd-page)]
2953 ["Even Sheets" (pr-even-or-odd-pages 'even-sheet)
2954 :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)]
2955 ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet)
2956 :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)])
2957 "--"
2958 ["Spool Buffer" pr-toggle-spool-menu
2959 :style toggle :selected pr-spool-p
2960 :included (pr-visible-p 'postscript-process)
2961 :help "Toggle PostScript spooling"]
2962 ["Print with faces" pr-toggle-faces-menu
2963 :style toggle :selected pr-faces-p
2964 :included (pr-visible-p 'postscript-process)
2965 :help "Toggle PostScript printing with faces"]
2966 ["Print via Ghostscript" pr-toggle-ghostscript-menu
2967 :style toggle :selected pr-print-using-ghostscript
2968 :included (pr-visible-p 'postscript-process)
2969 :help "Toggle PostScript generation using ghostscript"]
2970 "--"
2971 ["Auto Region" pr-toggle-region-menu
2972 :style toggle :selected pr-auto-region
2973 :included (pr-visible-p 'printing)]
2974 ["Auto Mode" pr-toggle-mode-menu
2975 :style toggle :selected pr-auto-mode
2976 :included (pr-visible-p 'printing)]
2977 ["Menu Lock" pr-toggle-lock-menu
2978 :style toggle :selected pr-menu-lock
2979 :included (pr-visible-p 'printing)]
2980 "--"
2981 ("Customize" :included (pr-visible-p 'help)
2982 ["printing" pr-customize t]
2983 ["ps-print" ps-print-customize t]
2984 ["lpr" lpr-customize t])
2985 ("Show Settings" :included (pr-visible-p 'help)
2986 ["printing" pr-show-pr-setup t]
2987 ["ps-print" pr-show-ps-setup t]
2988 ["lpr" pr-show-lpr-setup t])
2989 ["Help" pr-help :active t :included (pr-visible-p 'help)]
2990 ))
3444 2991
3445 2992
3446(defun pr-menu-bind () 2993(defun pr-menu-bind ()
@@ -3453,19 +3000,17 @@ Calls `pr-update-menus' to adjust menus."
3453 3000
3454 3001
3455;; Key binding 3002;; Key binding
3456(let ((pr-print-key (if (featurep 'xemacs) 3003;; FIXME: These should be moved to a function so that just loading the file
3457 'f22 ; XEmacs 3004;; doesn't affect the global keymap!
3458 'print))) ; GNU Emacs 3005(global-set-key [print] 'pr-ps-fast-fire)
3459 (global-set-key `[,pr-print-key] 'pr-ps-fast-fire) 3006;; Well, M-print and S-print are used because on my keyboard S-print works
3460 ;; Well, M-print and S-print are used because in my keyboard S-print works 3007;; and M-print doesn't. But M-print can work on other keyboards.
3461 ;; and M-print doesn't. But M-print can work in other keyboard. 3008(global-set-key [(meta print)] 'pr-ps-mode-using-ghostscript)
3462 (global-set-key `[(meta ,pr-print-key)] 'pr-ps-mode-using-ghostscript) 3009(global-set-key [(shift print)] 'pr-ps-mode-using-ghostscript)
3463 (global-set-key `[(shift ,pr-print-key)] 'pr-ps-mode-using-ghostscript) 3010;; Well, C-print and C-M-print are used because in my keyboard C-M-print works
3464 ;; Well, C-print and C-M-print are used because in my keyboard C-M-print works 3011;; and C-print doesn't. But C-print can work in other keyboard.
3465 ;; and C-print doesn't. But C-print can work in other keyboard. 3012(global-set-key [(control print)] 'pr-txt-fast-fire)
3466 (global-set-key `[(control ,pr-print-key)] 'pr-txt-fast-fire) 3013(global-set-key [(control meta print)] 'pr-txt-fast-fire)
3467 (global-set-key `[(control meta ,pr-print-key)] 'pr-txt-fast-fire))
3468
3469 3014
3470;;; You can also use something like: 3015;;; You can also use something like:
3471;;;(global-set-key "\C-ci" 'pr-interface) 3016;;;(global-set-key "\C-ci" 'pr-interface)
@@ -3962,13 +3507,16 @@ file name.
3962 3507
3963See also documentation for `pr-list-directory'." 3508See also documentation for `pr-list-directory'."
3964 (interactive (pr-interactive-ps-dir-args (pr-prompt "PS preview dir"))) 3509 (interactive (pr-interactive-ps-dir-args (pr-prompt "PS preview dir")))
3965 (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename 3510 (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
3966 (pr-prompt "PS preview dir")) 3511 (defvar pr--filename)
3967 (setq filename (pr-ps-file filename)) 3512 (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
3968 (pr-ps-file-list n-up dir file-regexp filename) 3513 (pr--filename filename))
3969 (or pr-spool-p 3514 (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
3970 (pr-ps-file-preview filename))) 3515 (pr-prompt "PS preview dir"))
3971 3516 (setq pr--filename (pr-ps-file pr--filename))
3517 (pr-ps-file-list pr--n-up pr--dir pr--file-regexp pr--filename)
3518 (or pr-spool-p
3519 (pr-ps-file-preview pr--filename))))
3972 3520
3973;;;###autoload 3521;;;###autoload
3974(defun pr-ps-directory-using-ghostscript (n-up dir file-regexp &optional filename) 3522(defun pr-ps-directory-using-ghostscript (n-up dir file-regexp &optional filename)
@@ -3988,12 +3536,16 @@ file name.
3988 3536
3989See also documentation for `pr-list-directory'." 3537See also documentation for `pr-list-directory'."
3990 (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir GS"))) 3538 (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir GS")))
3991 (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename 3539 (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
3992 (pr-prompt "PS print dir GS")) 3540 (defvar pr--filename)
3993 (let ((file (pr-ps-file filename))) 3541 (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
3994 (pr-ps-file-list n-up dir file-regexp file) 3542 (pr--filename filename))
3995 (pr-ps-file-using-ghostscript file) 3543 (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
3996 (or filename (pr-delete-file file)))) 3544 (pr-prompt "PS print dir GS"))
3545 (let ((file (pr-ps-file pr--filename)))
3546 (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file)
3547 (pr-ps-file-using-ghostscript file)
3548 (or pr--filename (pr-delete-file file)))))
3997 3549
3998 3550
3999;;;###autoload 3551;;;###autoload
@@ -4014,12 +3566,16 @@ file name.
4014 3566
4015See also documentation for `pr-list-directory'." 3567See also documentation for `pr-list-directory'."
4016 (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir"))) 3568 (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir")))
4017 (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename 3569 (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
4018 (pr-prompt "PS print dir")) 3570 (defvar pr--filename)
4019 (let ((file (pr-ps-file filename))) 3571 (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
4020 (pr-ps-file-list n-up dir file-regexp file) 3572 (pr--filename filename))
4021 (pr-ps-file-print file) 3573 (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
4022 (or filename (pr-delete-file file)))) 3574 (pr-prompt "PS print dir"))
3575 (let ((file (pr-ps-file pr--filename)))
3576 (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file)
3577 (pr-ps-file-print file)
3578 (or pr--filename (pr-delete-file file)))))
4023 3579
4024 3580
4025;;;###autoload 3581;;;###autoload
@@ -4043,11 +3599,16 @@ file name.
4043See also documentation for `pr-list-directory'." 3599See also documentation for `pr-list-directory'."
4044 (interactive (pr-interactive-ps-dir-args 3600 (interactive (pr-interactive-ps-dir-args
4045 (pr-prompt (pr-prompt-gs "PS print dir")))) 3601 (pr-prompt (pr-prompt-gs "PS print dir"))))
4046 (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename 3602 (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
4047 (pr-prompt (pr-prompt-gs "PS print dir"))) 3603 (defvar pr--filename)
4048 (if (pr-using-ghostscript-p) 3604 (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
4049 (pr-ps-directory-using-ghostscript n-up dir file-regexp filename) 3605 (pr--filename filename))
4050 (pr-ps-directory-print n-up dir file-regexp filename))) 3606 (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
3607 (pr-prompt (pr-prompt-gs "PS print dir")))
3608 (funcall (if (pr-using-ghostscript-p)
3609 #'pr-ps-directory-using-ghostscript
3610 #'pr-ps-directory-print)
3611 pr--n-up pr--dir pr--file-regexp pr--filename)))
4051 3612
4052 3613
4053;;;###autoload 3614;;;###autoload
@@ -4191,11 +3752,13 @@ See also `pr-ps-buffer-ps-print'."
4191 3752
4192See also `pr-ps-buffer-preview'." 3753See also `pr-ps-buffer-preview'."
4193 (interactive (pr-interactive-n-up-file "PS preview mode")) 3754 (interactive (pr-interactive-n-up-file "PS preview mode"))
4194 (pr-set-n-up-and-filename 'n-up 'filename "PS preview mode") 3755 (defvar pr--n-up) (defvar pr--filename)
4195 (let ((file (pr-ps-file filename))) 3756 (let ((pr--n-up n-up) (pr--filename filename))
4196 (and (pr-ps-mode n-up file) 3757 (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS preview mode")
4197 (not pr-spool-p) 3758 (let ((file (pr-ps-file pr--filename)))
4198 (pr-ps-file-preview file)))) 3759 (and (pr-ps-mode pr--n-up file)
3760 (not pr-spool-p)
3761 (pr-ps-file-preview file)))))
4199 3762
4200 3763
4201;;;###autoload 3764;;;###autoload
@@ -4204,12 +3767,14 @@ See also `pr-ps-buffer-preview'."
4204 3767
4205See also `pr-ps-buffer-using-ghostscript'." 3768See also `pr-ps-buffer-using-ghostscript'."
4206 (interactive (pr-interactive-n-up-file "PS print GS mode")) 3769 (interactive (pr-interactive-n-up-file "PS print GS mode"))
4207 (pr-set-n-up-and-filename 'n-up 'filename "PS print GS mode") 3770 (defvar pr--n-up) (defvar pr--filename)
4208 (let ((file (pr-ps-file filename))) 3771 (let ((pr--n-up n-up) (pr--filename filename))
4209 (when (and (pr-ps-mode n-up file) 3772 (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print GS mode")
4210 (not pr-spool-p)) 3773 (let ((file (pr-ps-file pr--filename)))
4211 (pr-ps-file-using-ghostscript file) 3774 (when (and (pr-ps-mode pr--n-up file)
4212 (or filename (pr-delete-file file))))) 3775 (not pr-spool-p))
3776 (pr-ps-file-using-ghostscript file)
3777 (or pr--filename (pr-delete-file file))))))
4213 3778
4214 3779
4215;;;###autoload 3780;;;###autoload
@@ -4218,8 +3783,10 @@ See also `pr-ps-buffer-using-ghostscript'."
4218 3783
4219See also `pr-ps-buffer-print'." 3784See also `pr-ps-buffer-print'."
4220 (interactive (pr-interactive-n-up-file "PS print mode")) 3785 (interactive (pr-interactive-n-up-file "PS print mode"))
4221 (pr-set-n-up-and-filename 'n-up 'filename "PS print mode") 3786 (defvar pr--n-up) (defvar pr--filename)
4222 (pr-ps-mode n-up filename)) 3787 (let ((pr--n-up n-up) (pr--filename filename))
3788 (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print mode")
3789 (pr-ps-mode pr--n-up pr--filename)))
4223 3790
4224 3791
4225;;;###autoload 3792;;;###autoload
@@ -4247,8 +3814,10 @@ prompts for FILE(name)-REGEXP.
4247 3814
4248See also documentation for `pr-list-directory'." 3815See also documentation for `pr-list-directory'."
4249 (interactive (pr-interactive-dir-args "Printify dir")) 3816 (interactive (pr-interactive-dir-args "Printify dir"))
4250 (pr-set-dir-args 'dir 'file-regexp "Printify dir") 3817 (defvar pr--dir) (defvar pr--file-regexp)
4251 (pr-file-list dir file-regexp 'pr-printify-buffer)) 3818 (let ((pr--dir dir) (pr--file-regexp file-regexp))
3819 (pr-set-dir-args 'pr--dir 'pr--file-regexp "Printify dir")
3820 (pr-file-list pr--dir pr--file-regexp 'pr-printify-buffer)))
4252 3821
4253 3822
4254;;;###autoload 3823;;;###autoload
@@ -4283,8 +3852,10 @@ prompts for FILE(name)-REGEXP.
4283 3852
4284See also documentation for `pr-list-directory'." 3853See also documentation for `pr-list-directory'."
4285 (interactive (pr-interactive-dir-args "Print dir")) 3854 (interactive (pr-interactive-dir-args "Print dir"))
4286 (pr-set-dir-args 'dir 'file-regexp "Print dir") 3855 (defvar pr--dir) (defvar pr--file-regexp)
4287 (pr-file-list dir file-regexp 'pr-txt-buffer)) 3856 (let ((pr--dir dir) (pr--file-regexp file-regexp))
3857 (pr-set-dir-args 'pr--dir 'pr--file-regexp "Print dir")
3858 (pr-file-list pr--dir pr--file-regexp 'pr-txt-buffer)))
4288 3859
4289 3860
4290;;;###autoload 3861;;;###autoload
@@ -4406,10 +3977,12 @@ image in a file with that name."
4406(defun pr-ps-file-up-preview (n-up ifilename &optional ofilename) 3977(defun pr-ps-file-up-preview (n-up ifilename &optional ofilename)
4407 "Preview PostScript file FILENAME." 3978 "Preview PostScript file FILENAME."
4408 (interactive (pr-interactive-n-up-inout "PS preview")) 3979 (interactive (pr-interactive-n-up-inout "PS preview"))
4409 (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename 3980 (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename)
4410 "PS preview "))) 3981 (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename))
4411 (pr-ps-utility-process n-up ifilename outfile) 3982 (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename
4412 (pr-ps-file-preview outfile))) 3983 "PS preview ")))
3984 (pr-ps-utility-process pr--n-up pr--ifilename outfile)
3985 (pr-ps-file-preview outfile))))
4413 3986
4414 3987
4415;;;###autoload 3988;;;###autoload
@@ -4417,15 +3990,18 @@ image in a file with that name."
4417 "Print PostScript file FILENAME using ghostscript." 3990 "Print PostScript file FILENAME using ghostscript."
4418 (interactive (list (pr-ps-infile-preprint "Print preview "))) 3991 (interactive (list (pr-ps-infile-preprint "Print preview ")))
4419 (and (stringp filename) (file-exists-p filename) 3992 (and (stringp filename) (file-exists-p filename)
4420 (let* ((file (pr-expand-file-name filename)) 3993 (let* ((file (expand-file-name filename))
4421 (tempfile (pr-dosify-file-name (make-temp-file file)))) 3994 (tempfile (make-temp-file file)))
4422 ;; gs use 3995 ;; gs use
4423 (pr-call-process pr-gs-command 3996 (pr-call-process pr-gs-command
4424 (format "-sDEVICE=%s" pr-gs-device) 3997 (format "-sDEVICE=%s" pr-gs-device)
4425 (format "-r%d" pr-gs-resolution) 3998 (format "-r%d" pr-gs-resolution)
4426 (pr-switches-string pr-gs-switches "pr-gs-switches") 3999 (pr-switches-string pr-gs-switches "pr-gs-switches")
4427 (format "-sOutputFile=\"%s\"" tempfile) 4000 (format "-sOutputFile=\"%s\""
4428 file 4001 ;; FIXME: Do we need to dosify here really?
4002 (pr-dosify-file-name tempfile))
4003 ;; FIXME: Do we need to dosify here really?
4004 (pr-dosify-file-name file)
4429 "-c quit") 4005 "-c quit")
4430 ;; printing 4006 ;; printing
4431 (pr-ps-file-print tempfile) 4007 (pr-ps-file-print tempfile)
@@ -4439,7 +4015,7 @@ image in a file with that name."
4439 (interactive (list (pr-ps-infile-preprint "Print "))) 4015 (interactive (list (pr-ps-infile-preprint "Print ")))
4440 (and (stringp filename) (file-exists-p filename) 4016 (and (stringp filename) (file-exists-p filename)
4441 ;; printing 4017 ;; printing
4442 (let ((file (pr-expand-file-name filename))) 4018 (let ((file (expand-file-name filename)))
4443 (if (string= pr-ps-command "") 4019 (if (string= pr-ps-command "")
4444 ;; default action 4020 ;; default action
4445 (let ((ps-spool-buffer (get-buffer-create ps-spool-buffer-name))) 4021 (let ((ps-spool-buffer (get-buffer-create ps-spool-buffer-name)))
@@ -4448,16 +4024,16 @@ image in a file with that name."
4448 (insert-file-contents-literally file)) 4024 (insert-file-contents-literally file))
4449 (pr-despool-print)) 4025 (pr-despool-print))
4450 ;; use `pr-ps-command' to print 4026 ;; use `pr-ps-command' to print
4451 (apply 'pr-call-process 4027 (apply #'pr-call-process
4452 pr-ps-command 4028 pr-ps-command
4453 (pr-switches-string pr-ps-switches "pr-ps-switches") 4029 (pr-switches-string pr-ps-switches "pr-ps-switches")
4454 (if (string-match "cp" pr-ps-command) 4030 (if (string-match "cp" pr-ps-command)
4455 ;; for "cp" (cmd in out) 4031 ;; for "cp" (cmd in out)
4456 (list file 4032 (list (pr-dosify-file-name file)
4457 (concat pr-ps-printer-switch pr-ps-printer)) 4033 (concat pr-ps-printer-switch pr-ps-printer))
4458 ;; else, for others (cmd out in) 4034 ;; else, for others (cmd out in)
4459 (list (concat pr-ps-printer-switch pr-ps-printer) 4035 (list (concat pr-ps-printer-switch pr-ps-printer)
4460 file))))))) 4036 (pr-dosify-file-name file))))))))
4461 4037
4462 4038
4463;;;###autoload 4039;;;###autoload
@@ -4492,14 +4068,16 @@ file name."
4492 (if pr-print-using-ghostscript 4068 (if pr-print-using-ghostscript
4493 "PS print GS" 4069 "PS print GS"
4494 "PS print"))) 4070 "PS print")))
4495 (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename 4071 (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename)
4496 (if pr-print-using-ghostscript 4072 (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename))
4497 "PS print GS " 4073 (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename
4498 "PS print ")))) 4074 (if pr-print-using-ghostscript
4499 (pr-ps-utility-process n-up ifilename outfile) 4075 "PS print GS "
4500 (unless ofilename 4076 "PS print "))))
4501 (pr-ps-file-ps-print outfile) 4077 (pr-ps-utility-process pr--n-up pr--ifilename outfile)
4502 (pr-delete-file outfile)))) 4078 (unless pr--ofilename
4079 (pr-ps-file-ps-print outfile)
4080 (pr-delete-file outfile)))))
4503 4081
4504 4082
4505;;;###autoload 4083;;;###autoload
@@ -5210,9 +4788,9 @@ If menu binding was not done, calls `pr-menu-bind'."
5210 (let ((sym (car elt))) 4788 (let ((sym (car elt)))
5211 (vector 4789 (vector
5212 (symbol-name sym) 4790 (symbol-name sym)
5213 (list fun (list 'quote sym) nil (list 'quote entry) index) 4791 `(,fun ',sym nil ',entry ',index)
5214 :style 'radio 4792 :style 'radio
5215 :selected (list 'eq var-sym (list 'quote sym))))) 4793 :selected `(eq ,var-sym ',sym))))
5216 alist))) 4794 alist)))
5217 4795
5218 4796
@@ -5224,7 +4802,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5224 value)) 4802 value))
5225 (setq pr-ps-utility value) 4803 (setq pr-ps-utility value)
5226 (pr-eval-alist (nthcdr 9 item))) 4804 (pr-eval-alist (nthcdr 9 item)))
5227 (pr-update-mode-line)) 4805 (force-mode-line-update))
5228 4806
5229 4807
5230(defun pr-ps-set-printer (value) 4808(defun pr-ps-set-printer (value)
@@ -5234,7 +4812,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5234 "Invalid PostScript printer name `%s' for variable `pr-ps-name'" 4812 "Invalid PostScript printer name `%s' for variable `pr-ps-name'"
5235 value)) 4813 value))
5236 (setq pr-ps-name value 4814 (setq pr-ps-name value
5237 pr-ps-command (pr-dosify-file-name (nth 0 ps)) 4815 pr-ps-command (nth 0 ps)
5238 pr-ps-switches (nth 1 ps) 4816 pr-ps-switches (nth 1 ps)
5239 pr-ps-printer-switch (nth 2 ps) 4817 pr-ps-printer-switch (nth 2 ps)
5240 pr-ps-printer (nth 3 ps)) 4818 pr-ps-printer (nth 3 ps))
@@ -5251,7 +4829,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5251 (t "-P") 4829 (t "-P")
5252 ))) 4830 )))
5253 (pr-eval-alist (nthcdr 4 ps))) 4831 (pr-eval-alist (nthcdr 4 ps)))
5254 (pr-update-mode-line)) 4832 (force-mode-line-update))
5255 4833
5256 4834
5257(defun pr-txt-set-printer (value) 4835(defun pr-txt-set-printer (value)
@@ -5260,7 +4838,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5260 (error "Invalid text printer name `%s' for variable `pr-txt-name'" 4838 (error "Invalid text printer name `%s' for variable `pr-txt-name'"
5261 value)) 4839 value))
5262 (setq pr-txt-name value 4840 (setq pr-txt-name value
5263 pr-txt-command (pr-dosify-file-name (nth 0 txt)) 4841 pr-txt-command (nth 0 txt)
5264 pr-txt-switches (nth 1 txt) 4842 pr-txt-switches (nth 1 txt)
5265 pr-txt-printer (nth 2 txt))) 4843 pr-txt-printer (nth 2 txt)))
5266 (or (stringp pr-txt-command) 4844 (or (stringp pr-txt-command)
@@ -5269,30 +4847,28 @@ If menu binding was not done, calls `pr-menu-bind'."
5269 (lpr-lp-system "lp") 4847 (lpr-lp-system "lp")
5270 (t "lpr") 4848 (t "lpr")
5271 ))) 4849 )))
5272 (pr-update-mode-line)) 4850 (force-mode-line-update))
5273 4851
5274 4852
5275(defun pr-eval-alist (alist) 4853(defun pr-eval-alist (alist)
5276 (mapcar #'(lambda (option) 4854 (dolist (option alist)
5277 (let ((var-sym (car option)) 4855 (let ((var-sym (car option))
5278 (value (cdr option))) 4856 (value (cdr option)))
5279 (if (eq var-sym 'inherits-from:) 4857 (if (eq var-sym 'inherits-from:)
5280 (pr-eval-setting-alist value 'global) 4858 (pr-eval-setting-alist value 'global)
5281 (set var-sym (eval value))))) 4859 (set var-sym (eval value))))))
5282 alist))
5283 4860
5284 4861
5285(defun pr-eval-local-alist (alist) 4862(defun pr-eval-local-alist (alist)
5286 (let (local-list) 4863 (let (local-list)
5287 (mapc #'(lambda (option) 4864 (dolist (option alist)
5288 (let ((var-sym (car option)) 4865 (let ((var-sym (car option))
5289 (value (cdr option))) 4866 (value (cdr option)))
5290 (setq local-list 4867 (setq local-list
5291 (if (eq var-sym 'inherits-from:) 4868 (if (eq var-sym 'inherits-from:)
5292 (nconc (pr-eval-setting-alist value) local-list) 4869 (nconc (pr-eval-setting-alist value) local-list)
5293 (set (make-local-variable var-sym) (eval value)) 4870 (set (make-local-variable var-sym) (eval value))
5294 (cons var-sym local-list))))) 4871 (cons var-sym local-list)))))
5295 alist)
5296 local-list)) 4872 local-list))
5297 4873
5298 4874
@@ -5338,7 +4914,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5338 4914
5339 4915
5340(defun pr-kill-local-variable (local-var-list) 4916(defun pr-kill-local-variable (local-var-list)
5341 (mapcar 'kill-local-variable local-var-list)) 4917 (mapcar #'kill-local-variable local-var-list))
5342 4918
5343 4919
5344;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4920;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -5526,10 +5102,6 @@ If menu binding was not done, calls `pr-menu-bind'."
5526 (delete-file file))) 5102 (delete-file file)))
5527 5103
5528 5104
5529(defun pr-expand-file-name (filename)
5530 (pr-dosify-file-name (expand-file-name filename)))
5531
5532
5533(defun pr-ps-outfile-preprint (&optional mess) 5105(defun pr-ps-outfile-preprint (&optional mess)
5534 (let* ((prompt (format "%soutput PostScript file name: " (or mess ""))) 5106 (let* ((prompt (format "%soutput PostScript file name: " (or mess "")))
5535 (res (read-file-name prompt default-directory "" nil))) 5107 (res (read-file-name prompt default-directory "" nil)))
@@ -5549,7 +5121,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5549 (format "File %s; PostScript file: " prompt) 5121 (format "File %s; PostScript file: " prompt)
5550 (file-name-directory res) nil nil 5122 (file-name-directory res) nil nil
5551 (file-name-nondirectory res)))) 5123 (file-name-nondirectory res))))
5552 (pr-expand-file-name res))) 5124 (expand-file-name res)))
5553 5125
5554 5126
5555(defun pr-ps-infile-preprint (&optional mess) 5127(defun pr-ps-infile-preprint (&optional mess)
@@ -5569,7 +5141,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5569 (format "File %s; PostScript file: " prompt) 5141 (format "File %s; PostScript file: " prompt)
5570 (file-name-directory res) nil nil 5142 (file-name-directory res) nil nil
5571 (file-name-nondirectory res)))) 5143 (file-name-nondirectory res))))
5572 (pr-expand-file-name res))) 5144 (expand-file-name res)))
5573 5145
5574 5146
5575(defun pr-ps-utility-args (n-up-sym infile-sym outfile-sym prompt) 5147(defun pr-ps-utility-args (n-up-sym infile-sym outfile-sym prompt)
@@ -5582,13 +5154,10 @@ If menu binding was not done, calls `pr-menu-bind'."
5582 (set infile-sym (pr-ps-infile-preprint prompt))) 5154 (set infile-sym (pr-ps-infile-preprint prompt)))
5583 (or (symbol-value infile-sym) 5155 (or (symbol-value infile-sym)
5584 (error "%s: input PostScript file name is missing" prompt)) 5156 (error "%s: input PostScript file name is missing" prompt))
5585 (set infile-sym (pr-dosify-file-name (symbol-value infile-sym)))
5586 ;; output file 5157 ;; output file
5587 (and (eq (symbol-value outfile-sym) t) 5158 (and (eq (symbol-value outfile-sym) t)
5588 (set outfile-sym (and current-prefix-arg 5159 (set outfile-sym (and current-prefix-arg
5589 (pr-ps-outfile-preprint prompt)))) 5160 (pr-ps-outfile-preprint prompt))))
5590 (and (symbol-value outfile-sym)
5591 (set outfile-sym (pr-dosify-file-name (symbol-value outfile-sym))))
5592 (pr-ps-file (symbol-value outfile-sym))) 5161 (pr-ps-file (symbol-value outfile-sym)))
5593 5162
5594 5163
@@ -5608,9 +5177,9 @@ If menu binding was not done, calls `pr-menu-bind'."
5608 (and pr-file-landscape (nth 4 item)) 5177 (and pr-file-landscape (nth 4 item))
5609 (and pr-file-duplex (nth 5 item)) 5178 (and pr-file-duplex (nth 5 item))
5610 (and pr-file-tumble (nth 6 item)) 5179 (and pr-file-tumble (nth 6 item))
5611 (pr-expand-file-name infile) 5180 (pr-dosify-file-name (expand-file-name infile))
5612 (nth 7 item) 5181 (nth 7 item)
5613 (pr-expand-file-name outfile))))) 5182 (pr-dosify-file-name (expand-file-name outfile))))))
5614 5183
5615 5184
5616(defun pr-remove-nil-from-list (lst) 5185(defun pr-remove-nil-from-list (lst)
@@ -5640,7 +5209,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5640 (with-file-modes pr-file-modes 5209 (with-file-modes pr-file-modes
5641 (setq status 5210 (setq status
5642 (condition-case data 5211 (condition-case data
5643 (apply 'call-process cmd nil buffer nil args) 5212 (apply #'call-process cmd nil buffer nil args)
5644 ((quit error) 5213 ((quit error)
5645 (error-message-string data))))) 5214 (error-message-string data)))))
5646 ;; *Printing Command Output* == show exit status 5215 ;; *Printing Command Output* == show exit status
@@ -5666,7 +5235,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5666 ;; If SWITCHES is nil, return nil. 5235 ;; If SWITCHES is nil, return nil.
5667 ;; Otherwise, return the list of string in a string. 5236 ;; Otherwise, return the list of string in a string.
5668 (and switches 5237 (and switches
5669 (mapconcat 'identity (pr-switches switches mess) " "))) 5238 (mapconcat #'identity (pr-switches switches mess) " ")))
5670 5239
5671 5240
5672(defun pr-switches (switches mess) 5241(defun pr-switches (switches mess)
@@ -5677,36 +5246,42 @@ If menu binding was not done, calls `pr-menu-bind'."
5677 5246
5678 5247
5679(defun pr-ps-preview (kind n-up filename mess) 5248(defun pr-ps-preview (kind n-up filename mess)
5680 (pr-set-n-up-and-filename 'n-up 'filename mess) 5249 (defvar pr--n-up) (defvar pr--filename)
5681 (let ((file (pr-ps-file filename))) 5250 (let ((pr--n-up n-up) (pr--filename filename))
5682 (pr-text2ps kind n-up file) 5251 (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess)
5683 (or pr-spool-p (pr-ps-file-preview file)))) 5252 (let ((file (pr-ps-file pr--filename)))
5253 (pr-text2ps kind pr--n-up file)
5254 (or pr-spool-p (pr-ps-file-preview file)))))
5684 5255
5685 5256
5686(defun pr-ps-using-ghostscript (kind n-up filename mess) 5257(defun pr-ps-using-ghostscript (kind n-up filename mess)
5687 (pr-set-n-up-and-filename 'n-up 'filename mess) 5258 (defvar pr--n-up) (defvar pr--filename)
5688 (let ((file (pr-ps-file filename))) 5259 (let ((pr--n-up n-up) (pr--filename filename))
5689 (pr-text2ps kind n-up file) 5260 (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess)
5690 (unless (or pr-spool-p filename) 5261 (let ((file (pr-ps-file pr--filename)))
5691 (pr-ps-file-using-ghostscript file) 5262 (pr-text2ps kind pr--n-up file)
5692 (pr-delete-file file)))) 5263 (unless (or pr-spool-p pr--filename)
5264 (pr-ps-file-using-ghostscript file)
5265 (pr-delete-file file)))))
5693 5266
5694 5267
5695(defun pr-ps-print (kind n-up filename mess) 5268(defun pr-ps-print (kind n-up filename mess)
5696 (pr-set-n-up-and-filename 'n-up 'filename mess) 5269 (defvar pr--n-up) (defvar pr--filename)
5697 (let ((file (pr-ps-file filename))) 5270 (let ((pr--n-up n-up) (pr--filename filename))
5698 (pr-text2ps kind n-up file) 5271 (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess)
5699 (unless (or pr-spool-p filename) 5272 (let ((file (pr-ps-file pr--filename)))
5700 (pr-ps-file-print file) 5273 (pr-text2ps kind pr--n-up file)
5701 (pr-delete-file file)))) 5274 (unless (or pr-spool-p pr--filename)
5275 (pr-ps-file-print file)
5276 (pr-delete-file file)))))
5702 5277
5703 5278
5704(defun pr-ps-file (&optional filename) 5279(defun pr-ps-file (&optional filename)
5705 (pr-dosify-file-name (or filename 5280 (or filename
5706 (make-temp-file 5281 (make-temp-file
5707 (convert-standard-filename 5282 (convert-standard-filename
5708 (expand-file-name pr-ps-temp-file pr-temp-dir)) 5283 (expand-file-name pr-ps-temp-file pr-temp-dir))
5709 nil ".ps")))) 5284 nil ".ps")))
5710 5285
5711 5286
5712(defun pr-interactive-n-up (mess) 5287(defun pr-interactive-n-up (mess)
@@ -5714,7 +5289,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5714 (save-match-data 5289 (save-match-data
5715 (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ") 5290 (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ")
5716 (prompt "") 5291 (prompt "")
5717 (str (pr-read-string (format fmt-prompt prompt mess) "1" nil "1")) 5292 (str (read-string (format fmt-prompt prompt mess) nil nil "1"))
5718 int) 5293 int)
5719 (while (if (string-match "^\\s *[0-9]+$" str) 5294 (while (if (string-match "^\\s *[0-9]+$" str)
5720 (setq int (string-to-number str) 5295 (setq int (string-to-number str)
@@ -5724,7 +5299,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5724 (setq prompt "Invalid integer syntax; ")) 5299 (setq prompt "Invalid integer syntax; "))
5725 (ding) 5300 (ding)
5726 (setq str 5301 (setq str
5727 (pr-read-string (format fmt-prompt prompt mess) str nil "1"))) 5302 (read-string (format fmt-prompt prompt mess) str nil "1")))
5728 int))) 5303 int)))
5729 5304
5730 5305
@@ -5749,7 +5324,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5749 5324
5750 5325
5751(defun pr-interactive-regexp (mess) 5326(defun pr-interactive-regexp (mess)
5752 (pr-read-string (format "[%s] File regexp to print: " mess) "" nil "")) 5327 (read-string (format "[%s] File regexp to print: " mess) nil nil ""))
5753 5328
5754 5329
5755(defun pr-interactive-dir-args (mess) 5330(defun pr-interactive-dir-args (mess)
@@ -5796,9 +5371,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5796 (and (not pr-spool-p) 5371 (and (not pr-spool-p)
5797 (eq (symbol-value filename-sym) t) 5372 (eq (symbol-value filename-sym) t)
5798 (set filename-sym (and current-prefix-arg 5373 (set filename-sym (and current-prefix-arg
5799 (ps-print-preprint current-prefix-arg)))) 5374 (ps-print-preprint current-prefix-arg)))))
5800 (and (symbol-value filename-sym)
5801 (set filename-sym (pr-dosify-file-name (symbol-value filename-sym)))))
5802 5375
5803 5376
5804(defun pr-set-n-up-and-filename (n-up-sym filename-sym mess) 5377(defun pr-set-n-up-and-filename (n-up-sym filename-sym mess)
@@ -5875,7 +5448,7 @@ If menu binding was not done, calls `pr-menu-bind'."
5875 5448
5876 5449
5877(defun pr-ps-file-list (n-up dir file-regexp filename) 5450(defun pr-ps-file-list (n-up dir file-regexp filename)
5878 (pr-delete-file-if-exists (setq filename (pr-expand-file-name filename))) 5451 (pr-delete-file-if-exists (setq filename (expand-file-name filename)))
5879 (let ((pr-spool-p t)) 5452 (let ((pr-spool-p t))
5880 (pr-file-list dir file-regexp 5453 (pr-file-list dir file-regexp
5881 #'(lambda () 5454 #'(lambda ()
@@ -5941,15 +5514,14 @@ If Emacs is running on Windows 95/98/NT/2000, tries to find COMMAND,
5941COMMAND.exe, COMMAND.bat and COMMAND.com in this order." 5514COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
5942 (if (string= command "") 5515 (if (string= command "")
5943 command 5516 command
5944 (pr-dosify-file-name 5517 (or (pr-find-command command)
5945 (or (pr-find-command command) 5518 (pr-path-command (cond (pr-cygwin-system 'cygwin)
5946 (pr-path-command (cond (pr-cygwin-system 'cygwin) 5519 (lpr-windows-system 'windows)
5947 (lpr-windows-system 'windows) 5520 (t 'unix))
5948 (t 'unix)) 5521 (file-name-nondirectory command)
5949 (file-name-nondirectory command) 5522 nil)
5950 nil) 5523 (error "Command not found: %s"
5951 (error "Command not found: %s" 5524 (file-name-nondirectory command)))))
5952 (file-name-nondirectory command))))))
5953 5525
5954 5526
5955(defun pr-path-command (symbol command sym-list) 5527(defun pr-path-command (symbol command sym-list)
@@ -6004,12 +5576,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6004;; Printing Interface (inspired by ps-print-interface.el) 5576;; Printing Interface (inspired by ps-print-interface.el)
6005 5577
6006 5578
6007(eval-when-compile
6008 (require 'cus-edit)
6009 (require 'wid-edit)
6010 (require 'widget))
6011
6012
6013(defvar pr-i-window-configuration nil) 5579(defvar pr-i-window-configuration nil)
6014 5580
6015(defvar pr-i-buffer nil) 5581(defvar pr-i-buffer nil)
@@ -6027,20 +5593,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6027(defvar pr-i-ps-send 'printer) 5593(defvar pr-i-ps-send 'printer)
6028 5594
6029 5595
6030(defvar pr-interface-map nil 5596(defvar pr-interface-map
6031 "Keymap for pr-interface.")
6032
6033(unless pr-interface-map
6034 (let ((map (make-sparse-keymap))) 5597 (let ((map (make-sparse-keymap)))
6035 (cond ((featurep 'xemacs) ; XEmacs 5598 (set-keymap-parent map widget-keymap)
6036 (pr-set-keymap-parents map (list widget-keymap))
6037 (pr-set-keymap-name map 'pr-interface-map))
6038 (t ; GNU Emacs
6039 (pr-set-keymap-parents map widget-keymap)))
6040 (define-key map "q" 'pr-interface-quit) 5599 (define-key map "q" 'pr-interface-quit)
6041 (define-key map "?" 'pr-interface-help) 5600 (define-key map "?" 'pr-interface-help)
6042 (setq pr-interface-map map))) 5601 map)
6043 5602 "Keymap for pr-interface.")
6044 5603
6045(defmacro pr-interface-save (&rest body) 5604(defmacro pr-interface-save (&rest body)
6046 `(with-current-buffer pr-i-buffer 5605 `(with-current-buffer pr-i-buffer
@@ -6111,15 +5670,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6111 (setq found (string-match (car ignore) name) 5670 (setq found (string-match (car ignore) name)
6112 ignore (cdr ignore))) 5671 ignore (cdr ignore)))
6113 (or found 5672 (or found
6114 (setq choices 5673 (push (list 'choice-item
6115 (cons (list 'quote 5674 :format "%[%t%]"
6116 (list 'choice-item 5675 name)
6117 :format "%[%t%]" 5676 choices))))
6118 name))
6119 choices)))))
6120 (nreverse choices)) 5677 (nreverse choices))
6121 " Buffer : " nil 5678 " Buffer : " nil
6122 '(progn 5679 (lambda ()
6123 (pr-interface-save 5680 (pr-interface-save
6124 (setq pr-i-region (ps-mark-active-p) 5681 (setq pr-i-region (ps-mark-active-p)
6125 pr-i-mode (pr-mode-alist-p))) 5682 pr-i-mode (pr-mode-alist-p)))
@@ -6345,11 +5902,10 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6345 (pr-insert-italic "\n\nSelect Pages : " 2 14) 5902 (pr-insert-italic "\n\nSelect Pages : " 2 14)
6346 (pr-insert-menu "Page Parity" 'ps-even-or-odd-pages 5903 (pr-insert-menu "Page Parity" 'ps-even-or-odd-pages
6347 (mapcar #'(lambda (alist) 5904 (mapcar #'(lambda (alist)
6348 (list 'quote 5905 (list 'choice-item
6349 (list 'choice-item 5906 :format "%[%t%]"
6350 :format "%[%t%]" 5907 :tag (cdr alist)
6351 :tag (cdr alist) 5908 :value (car alist)))
6352 :value (car alist))))
6353 pr-even-or-odd-alist))) 5909 pr-even-or-odd-alist)))
6354 5910
6355 5911
@@ -6605,8 +6161,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6605 6161
6606(defun pr-insert-toggle (var-sym label) 6162(defun pr-insert-toggle (var-sym label)
6607 (widget-create 'checkbox 6163 (widget-create 'checkbox
6608 :notify `(lambda (&rest _ignore) 6164 :notify (lambda (&rest _ignore)
6609 (setq ,var-sym (not ,var-sym))) 6165 (set var-sym (not (symbol-value var-sym))))
6610 (symbol-value var-sym)) 6166 (symbol-value var-sym))
6611 (widget-insert label)) 6167 (widget-insert label))
6612 6168
@@ -6619,32 +6175,32 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6619 (widget-insert separator))) 6175 (widget-insert separator)))
6620 6176
6621 6177
6622(defun pr-insert-menu (tag var-sym choices &optional before after &rest body) 6178(defun pr-insert-menu (tag var-sym choices &optional before after body)
6623 (and before (widget-insert before)) 6179 (and before (widget-insert before))
6624 (eval `(widget-create 'menu-choice 6180 (apply #'widget-create 'menu-choice
6625 :tag ,tag 6181 :tag tag
6626 :format "%v" 6182 :format "%v"
6627 :inline t 6183 :inline t
6628 :value ,var-sym 6184 :value (symbol-value var-sym)
6629 :notify (lambda (widget &rest _ignore) 6185 :notify (lambda (widget &rest _ignore)
6630 (setq ,var-sym (widget-value widget)) 6186 (set var-sym (widget-value widget))
6631 ,@body) 6187 (when body (funcall body)))
6632 :void '(choice-item :format "%[%t%]" 6188 :void '(choice-item :format "%[%t%]"
6633 :tag "Can not display value!") 6189 :tag "Can not display value!")
6634 ,@choices)) 6190 choices)
6635 (and after (widget-insert after))) 6191 (and after (widget-insert after)))
6636 6192
6637 6193
6638(defun pr-insert-radio-button (var-sym sym) 6194(defun pr-insert-radio-button (var-sym sym)
6639 (widget-insert "\n") 6195 (widget-insert "\n")
6640 (let ((wid-list (get var-sym 'pr-widget-list)) 6196 (let ((wid-list (get var-sym 'pr-widget-list))
6641 (wid (eval `(widget-create 6197 (wid (widget-create
6642 'radio-button 6198 'radio-button
6643 :format " %[%v%]" 6199 :format " %[%v%]"
6644 :value (eq ,var-sym (quote ,sym)) 6200 :value (eq (symbol-value var-sym) sym)
6645 :notify (lambda (&rest _ignore) 6201 :notify (lambda (&rest _ignore)
6646 (setq ,var-sym (quote ,sym)) 6202 (set var-sym sym)
6647 (pr-update-radio-button (quote ,var-sym))))))) 6203 (pr-update-radio-button var-sym)))))
6648 (put var-sym 'pr-widget-list (cons (cons wid sym) wid-list)))) 6204 (put var-sym 'pr-widget-list (cons (cons wid sym) wid-list))))
6649 6205
6650 6206
@@ -6666,20 +6222,18 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6666 6222
6667 6223
6668(defun pr-choice-alist (alist) 6224(defun pr-choice-alist (alist)
6669 (let ((max (apply 'max (mapcar #'(lambda (alist) 6225 (let ((max (apply #'max (mapcar #'(lambda (alist)
6670 (length (symbol-name (car alist)))) 6226 (length (symbol-name (car alist))))
6671 alist)))) 6227 alist))))
6672 (mapcar #'(lambda (alist) 6228 (mapcar #'(lambda (alist)
6673 (let* ((sym (car alist)) 6229 (let* ((sym (car alist))
6674 (name (symbol-name sym))) 6230 (name (symbol-name sym)))
6675 (list 6231 (list
6676 'quote 6232 'choice-item
6677 (list 6233 :format "%[%t%]"
6678 'choice-item 6234 :tag (concat name
6679 :format "%[%t%]" 6235 (make-string (- max (length name)) ?_))
6680 :tag (concat name 6236 :value sym)))
6681 (make-string (- max (length name)) ?_))
6682 :value sym))))
6683 alist))) 6237 alist)))
6684 6238
6685 6239