Mercurial > emacs
comparison lisp/printing.el @ 90749:900f465c603a
Group together all XEmacs/Emacs definitions.
author | Vinicius Jose Latorre <viniciusjl@ig.com.br> |
---|---|
date | Mon, 12 Feb 2007 02:16:00 +0000 |
parents | 70100f060860 |
children | f8cc067aba62 |
comparison
equal
deleted
inserted
replaced
90748:70100f060860 | 90749:900f465c603a |
---|---|
4 ;; 2006, 2007 Free Software Foundation, Inc. | 4 ;; 2006, 2007 Free Software Foundation, Inc. |
5 | 5 |
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> | 6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> | 7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
8 ;; Keywords: wp, print, PostScript | 8 ;; Keywords: wp, print, PostScript |
9 ;; Version: 6.8.4 | 9 ;; Version: 6.9 |
10 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre | 10 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre |
11 | 11 |
12 (defconst pr-version "6.8.4" | 12 (defconst pr-version "6.9" |
13 "printing.el, v 6.8.4 <2005/06/11 vinicius> | 13 "printing.el, v 6.9 <2007/02/11 vinicius> |
14 | 14 |
15 Please send all bug fixes and enhancements to | 15 Please send all bug fixes and enhancements to |
16 Vinicius Jose Latorre <viniciusjl@ig.com.br> | 16 Vinicius Jose Latorre <viniciusjl@ig.com.br> |
17 ") | 17 ") |
18 | 18 |
1091 file) | 1091 file) |
1092 ;; Reset the umask. | 1092 ;; Reset the umask. |
1093 (set-default-file-modes umask))))) | 1093 (set-default-file-modes umask))))) |
1094 | 1094 |
1095 | 1095 |
1096 ;; GNU Emacs | 1096 |
1097 (defalias 'pr-e-frame-char-height 'frame-char-height) | 1097 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1098 (defalias 'pr-e-frame-char-width 'frame-char-width) | 1098 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1099 (defalias 'pr-e-mouse-pixel-position 'mouse-pixel-position) | 1099 ;; XEmacs Definitions |
1100 ;; XEmacs | 1100 |
1101 (defalias 'pr-x-add-submenu 'add-submenu) | |
1102 (defalias 'pr-x-event-function 'event-function) | |
1103 (defalias 'pr-x-event-object 'event-object) | |
1104 (defalias 'pr-x-find-menu-item 'find-menu-item) | |
1105 (defalias 'pr-x-font-height 'font-height) | |
1106 (defalias 'pr-x-font-width 'font-width) | |
1107 (defalias 'pr-x-get-popup-menu-response 'get-popup-menu-response) | |
1108 (defalias 'pr-x-make-event 'make-event) | |
1109 (defalias 'pr-x-misc-user-event-p 'misc-user-event-p) | |
1110 (defalias 'pr-x-relabel-menu-item 'relabel-menu-item) | |
1111 (defalias 'pr-x-event-x-pixel 'event-x-pixel) | |
1112 (defalias 'pr-x-event-y-pixel 'event-y-pixel) | |
1113 | 1101 |
1114 (cond | 1102 (cond |
1115 ((featurep 'xemacs) ; XEmacs | 1103 ((featurep 'xemacs) ; XEmacs |
1116 (defvar current-menubar nil) | 1104 ;; XEmacs |
1117 (defvar current-mouse-event nil) | |
1118 (defvar zmacs-region-stays nil) | |
1119 (defalias 'pr-f-set-keymap-parents 'set-keymap-parents) | 1105 (defalias 'pr-f-set-keymap-parents 'set-keymap-parents) |
1120 (defalias 'pr-f-set-keymap-name 'set-keymap-name) | 1106 (defalias 'pr-f-set-keymap-name 'set-keymap-name) |
1107 | |
1108 ;; XEmacs | |
1121 (defun pr-f-read-string (prompt initial history default) | 1109 (defun pr-f-read-string (prompt initial history default) |
1122 (let ((str (read-string prompt initial))) | 1110 (let ((str (read-string prompt initial))) |
1123 (if (and str (not (string= str ""))) | 1111 (if (and str (not (string= str ""))) |
1124 str | 1112 str |
1125 default))) | 1113 default))) |
1114 | |
1115 ;; XEmacs | |
1116 (defvar zmacs-region-stays nil) | |
1117 | |
1118 ;; XEmacs | |
1126 (defun pr-keep-region-active () | 1119 (defun pr-keep-region-active () |
1127 (setq zmacs-region-stays t))) | 1120 (setq zmacs-region-stays t)) |
1128 | 1121 |
1122 ;; XEmacs | |
1123 (defun pr-region-active-p () | |
1124 (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p))) | |
1125 | |
1126 ;; XEmacs | |
1127 (defun pr-menu-char-height () | |
1128 (font-height (face-font 'default))) | |
1129 | |
1130 ;; XEmacs | |
1131 (defun pr-menu-char-width () | |
1132 (font-width (face-font 'default))) | |
1133 | |
1134 ;; XEmacs | |
1135 (defmacro pr-xemacs-global-menubar (&rest body) | |
1136 `(save-excursion | |
1137 (let ((temp (get-buffer-create (make-temp-name " *Temp")))) | |
1138 ;; be sure to access global menubar | |
1139 (set-buffer temp) | |
1140 ,@body | |
1141 (kill-buffer temp)))) | |
1142 | |
1143 ;; XEmacs | |
1144 (defun pr-global-menubar (pr-menu-spec) | |
1145 ;; Menu binding | |
1146 (pr-xemacs-global-menubar | |
1147 (add-submenu nil (cons "Printing" pr-menu-spec) "Apps")) | |
1148 (setq pr-menu-print-item nil)) | |
1149 | |
1150 ;; XEmacs | |
1151 (defvar current-mouse-event nil) | |
1152 (defun pr-menu-position (entry index horizontal) | |
1153 (make-event | |
1154 'button-release | |
1155 (list 'button 1 | |
1156 'x (- (event-x-pixel current-mouse-event) ; X | |
1157 (* horizontal pr-menu-char-width)) | |
1158 'y (- (event-y-pixel current-mouse-event) ; Y | |
1159 (* (pr-menu-index entry index) pr-menu-char-height))))) | |
1160 | |
1161 (defvar pr-menu-position nil) | |
1162 (defvar pr-menu-state nil) | |
1163 | |
1164 ;; XEmacs | |
1165 (defvar current-menubar nil) ; to avoid compilation gripes | |
1166 (defun pr-menu-lookup (path) | |
1167 (car (find-menu-item current-menubar (cons "Printing" path)))) | |
1168 | |
1169 ;; XEmacs | |
1170 (defun pr-menu-lock (entry index horizontal state path) | |
1171 (when pr-menu-lock | |
1172 (or (and pr-menu-position (eq state pr-menu-state)) | |
1173 (setq pr-menu-position (pr-menu-position entry index horizontal) | |
1174 pr-menu-state state)) | |
1175 (let* ((menu (pr-menu-lookup path)) | |
1176 (result (get-popup-menu-response menu pr-menu-position))) | |
1177 (and (misc-user-event-p result) | |
1178 (funcall (event-function result) | |
1179 (event-object result)))) | |
1180 (setq pr-menu-position nil))) | |
1181 | |
1182 ;; XEmacs | |
1183 (defalias 'pr-update-mode-line 'set-menubar-dirty-flag) | |
1184 | |
1185 ;; XEmacs | |
1186 (defvar pr-ps-name-old "PostScript Printers") | |
1187 (defvar pr-txt-name-old "Text Printers") | |
1188 (defvar pr-ps-utility-old "PostScript Utility") | |
1189 (defvar pr-even-or-odd-old "Print All Pages") | |
1190 | |
1191 ;; XEmacs | |
1192 (defun pr-do-update-menus (&optional force) | |
1193 (pr-menu-alist pr-ps-printer-alist | |
1194 'pr-ps-name | |
1195 'pr-menu-set-ps-title | |
1196 '("Printing") | |
1197 'pr-ps-printer-menu-modified | |
1198 force | |
1199 pr-ps-name-old | |
1200 'postscript 2) | |
1201 (pr-menu-alist pr-txt-printer-alist | |
1202 'pr-txt-name | |
1203 'pr-menu-set-txt-title | |
1204 '("Printing") | |
1205 'pr-txt-printer-menu-modified | |
1206 force | |
1207 pr-txt-name-old | |
1208 'text 2) | |
1209 (let ((save-var pr-ps-utility-menu-modified)) | |
1210 (pr-menu-alist pr-ps-utility-alist | |
1211 'pr-ps-utility | |
1212 'pr-menu-set-utility-title | |
1213 '("Printing" "PostScript Print" "File") | |
1214 'save-var | |
1215 force | |
1216 pr-ps-utility-old | |
1217 nil 1)) | |
1218 (pr-menu-alist pr-ps-utility-alist | |
1219 'pr-ps-utility | |
1220 'pr-menu-set-utility-title | |
1221 '("Printing" "PostScript Preview" "File") | |
1222 'pr-ps-utility-menu-modified | |
1223 force | |
1224 pr-ps-utility-old | |
1225 nil 1) | |
1226 (pr-even-or-odd-pages ps-even-or-odd-pages force)) | |
1227 | |
1228 ;; XEmacs | |
1229 (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name | |
1230 entry index) | |
1231 (when (and alist (or force (symbol-value modified-sym))) | |
1232 (pr-xemacs-global-menubar | |
1233 (add-submenu menu-path | |
1234 (pr-menu-create name alist var-sym | |
1235 fun entry index))) | |
1236 (funcall fun (symbol-value var-sym)) | |
1237 (set modified-sym nil))) | |
1238 | |
1239 ;; XEmacs | |
1240 (defun pr-relabel-menu-item (newname var-sym) | |
1241 (pr-xemacs-global-menubar | |
1242 (relabel-menu-item | |
1243 (list "Printing" (symbol-value var-sym)) | |
1244 newname) | |
1245 (set var-sym newname))) | |
1246 | |
1247 ;; XEmacs | |
1248 (defun pr-menu-set-ps-title (value &optional item entry index) | |
1249 (pr-relabel-menu-item (format "PostScript Printer: %s" value) | |
1250 'pr-ps-name-old) | |
1251 (pr-ps-set-printer value) | |
1252 (and index | |
1253 (pr-menu-lock entry index 12 'toggle nil))) | |
1254 | |
1255 ;; XEmacs | |
1256 (defun pr-menu-set-txt-title (value &optional item entry index) | |
1257 (pr-relabel-menu-item (format "Text Printer: %s" value) | |
1258 'pr-txt-name-old) | |
1259 (pr-txt-set-printer value) | |
1260 (and index | |
1261 (pr-menu-lock entry index 12 'toggle nil))) | |
1262 | |
1263 ;; XEmacs | |
1264 (defun pr-menu-set-utility-title (value &optional item entry index) | |
1265 (pr-xemacs-global-menubar | |
1266 (let ((newname (format "%s" value))) | |
1267 (relabel-menu-item | |
1268 (list "Printing" "PostScript Print" "File" pr-ps-utility-old) | |
1269 newname) | |
1270 (relabel-menu-item | |
1271 (list "Printing" "PostScript Preview" "File" pr-ps-utility-old) | |
1272 newname) | |
1273 (setq pr-ps-utility-old newname))) | |
1274 (pr-ps-set-utility value) | |
1275 (and index | |
1276 (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) | |
1277 | |
1278 ;; XEmacs | |
1279 (defun pr-even-or-odd-pages (value &optional no-lock) | |
1280 (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist)) | |
1281 'pr-even-or-odd-old) | |
1282 (setq ps-even-or-odd-pages value) | |
1283 (or no-lock | |
1284 (pr-menu-lock 'postscript-options 8 12 'toggle nil))) | |
1285 | |
1286 ) | |
1287 (t ; emacs | |
1288 ;; Do nothing | |
1289 )) ; end cond featurep | |
1290 | |
1291 | |
1292 | |
1293 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1294 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1295 ;; Emacs Definitions | |
1296 | |
1297 | |
1298 (cond | |
1299 ((featurep 'xemacs) ; XEmacs | |
1300 ;; Do nothing | |
1301 ) | |
1129 (t ; GNU Emacs | 1302 (t ; GNU Emacs |
1130 (defvar deactivate-mark nil) | 1303 ;; GNU Emacs |
1131 (defalias 'pr-f-set-keymap-parents 'set-keymap-parent) | 1304 (defalias 'pr-f-set-keymap-parents 'set-keymap-parent) |
1132 (defalias 'pr-f-set-keymap-name 'ignore) | 1305 (defalias 'pr-f-set-keymap-name 'ignore) |
1133 (defalias 'pr-f-read-string 'read-string) | 1306 (defalias 'pr-f-read-string 'read-string) |
1307 | |
1308 ;; GNU Emacs | |
1309 (defvar deactivate-mark nil) | |
1310 | |
1311 ;; GNU Emacs | |
1134 (defun pr-keep-region-active () | 1312 (defun pr-keep-region-active () |
1135 (setq deactivate-mark nil)))) | 1313 (setq deactivate-mark nil)) |
1314 | |
1315 ;; GNU Emacs | |
1316 (defun pr-region-active-p () | |
1317 (and pr-auto-region transient-mark-mode mark-active)) | |
1318 | |
1319 ;; GNU Emacs | |
1320 (defun pr-menu-char-height () | |
1321 (frame-char-height)) | |
1322 | |
1323 ;; GNU Emacs | |
1324 (defun pr-menu-char-width () | |
1325 (frame-char-width)) | |
1326 | |
1327 ;; GNU Emacs | |
1328 ;; Menu binding | |
1329 (require 'easymenu) | |
1330 ;; Replace existing "print" item by "Printing" item. | |
1331 ;; If you're changing this file, you'll load it a second, | |
1332 ;; third... time, but "print" item exists only in the first load. | |
1333 (eval-and-compile | |
1334 (cond | |
1335 ;; Emacs 20 | |
1336 ((< emacs-major-version 21) | |
1337 (defun pr-global-menubar (pr-menu-spec) | |
1338 (easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item) | |
1339 (when pr-menu-print-item | |
1340 (easy-menu-remove-item nil '("tools") pr-menu-print-item) | |
1341 (setq pr-menu-print-item nil | |
1342 pr-menu-bar (vector 'menu-bar 'tools | |
1343 (pr-get-symbol "Printing"))))) | |
1344 ) | |
1345 ;; Emacs 21 & 22 | |
1346 (t | |
1347 (defun pr-global-menubar (pr-menu-spec) | |
1348 (let ((menu-file (if (= emacs-major-version 21) | |
1349 '("menu-bar" "files") ; Emacs 21 | |
1350 '("menu-bar" "file")))) ; Emacs 22 or higher | |
1351 (cond | |
1352 (pr-menu-print-item | |
1353 (easy-menu-add-item global-map menu-file | |
1354 (easy-menu-create-menu "Print" pr-menu-spec) | |
1355 "print-buffer") | |
1356 (dolist (item '("print-buffer" "print-region" | |
1357 "ps-print-buffer-faces" "ps-print-region-faces" | |
1358 "ps-print-buffer" "ps-print-region")) | |
1359 (easy-menu-remove-item global-map menu-file item)) | |
1360 (setq pr-menu-print-item nil | |
1361 pr-menu-bar (vector 'menu-bar | |
1362 (pr-get-symbol (nth 1 menu-file)) | |
1363 (pr-get-symbol "Print")))) | |
1364 (t | |
1365 (easy-menu-add-item global-map menu-file | |
1366 (easy-menu-create-menu "Print" pr-menu-spec))) | |
1367 ))) | |
1368 ))) | |
1369 | |
1370 (eval-and-compile | |
1371 (cond | |
1372 (ps-windows-system | |
1373 ;; GNU Emacs for Windows 9x/NT | |
1374 (defun pr-menu-position (entry index horizontal) | |
1375 (let ((pos (cdr (mouse-pixel-position)))) | |
1376 (list | |
1377 (list (or (car pos) 0) ; X | |
1378 (- (or (cdr pos) 0) ; Y | |
1379 (* (pr-menu-index entry index) pr-menu-char-height))) | |
1380 (selected-frame)))) ; frame | |
1381 ) | |
1382 (t | |
1383 ;; GNU Emacs | |
1384 (defun pr-menu-position (entry index horizontal) | |
1385 (let ((pos (cdr (mouse-pixel-position)))) | |
1386 (list | |
1387 (list (- (or (car pos) 0) ; X | |
1388 (* horizontal pr-menu-char-width)) | |
1389 (- (or (cdr pos) 0) ; Y | |
1390 (* (pr-menu-index entry index) pr-menu-char-height))) | |
1391 (selected-frame)))) ; frame | |
1392 ))) | |
1393 | |
1394 (defvar pr-menu-position nil) | |
1395 (defvar pr-menu-state nil) | |
1396 | |
1397 ;; GNU Emacs | |
1398 (defun pr-menu-lookup (path) | |
1399 (lookup-key global-map | |
1400 (if path | |
1401 (vconcat pr-menu-bar | |
1402 (mapcar 'pr-get-symbol | |
1403 (if (listp path) | |
1404 path | |
1405 (list path)))) | |
1406 pr-menu-bar))) | |
1407 | |
1408 ;; GNU Emacs | |
1409 (defun pr-menu-lock (entry index horizontal state path) | |
1410 (when pr-menu-lock | |
1411 (or (and pr-menu-position (eq state pr-menu-state)) | |
1412 (setq pr-menu-position (pr-menu-position entry index horizontal) | |
1413 pr-menu-state state)) | |
1414 (let* ((menu (pr-menu-lookup path)) | |
1415 (result (x-popup-menu pr-menu-position menu))) | |
1416 (and result | |
1417 (let ((command (lookup-key menu (vconcat result)))) | |
1418 (if (fboundp command) | |
1419 (funcall command) | |
1420 (eval command))))) | |
1421 (setq pr-menu-position nil))) | |
1422 | |
1423 ;; GNU Emacs | |
1424 (defalias 'pr-update-mode-line 'force-mode-line-update) | |
1425 | |
1426 ;; GNU Emacs | |
1427 (defun pr-do-update-menus (&optional force) | |
1428 (pr-menu-alist pr-ps-printer-alist | |
1429 'pr-ps-name | |
1430 'pr-menu-set-ps-title | |
1431 "PostScript Printers" | |
1432 'pr-ps-printer-menu-modified | |
1433 force | |
1434 "PostScript Printers" | |
1435 'postscript 2) | |
1436 (pr-menu-alist pr-txt-printer-alist | |
1437 'pr-txt-name | |
1438 'pr-menu-set-txt-title | |
1439 "Text Printers" | |
1440 'pr-txt-printer-menu-modified | |
1441 force | |
1442 "Text Printers" | |
1443 'text 2) | |
1444 (let ((save-var pr-ps-utility-menu-modified)) | |
1445 (pr-menu-alist pr-ps-utility-alist | |
1446 'pr-ps-utility | |
1447 'pr-menu-set-utility-title | |
1448 '("PostScript Print" "File" "PostScript Utility") | |
1449 'save-var | |
1450 force | |
1451 "PostScript Utility" | |
1452 nil 1)) | |
1453 (pr-menu-alist pr-ps-utility-alist | |
1454 'pr-ps-utility | |
1455 'pr-menu-set-utility-title | |
1456 '("PostScript Preview" "File" "PostScript Utility") | |
1457 'pr-ps-utility-menu-modified | |
1458 force | |
1459 "PostScript Utility" | |
1460 nil 1) | |
1461 (pr-even-or-odd-pages ps-even-or-odd-pages force)) | |
1462 | |
1463 ;; GNU Emacs | |
1464 (defun pr-menu-get-item (name-list) | |
1465 ;; NAME-LIST is a string or a list of strings. | |
1466 (or (listp name-list) | |
1467 (setq name-list (list name-list))) | |
1468 (and name-list | |
1469 (let* ((reversed (reverse name-list)) | |
1470 (name (pr-get-symbol (car reversed))) | |
1471 (path (nreverse (cdr reversed))) | |
1472 (menu (lookup-key | |
1473 global-map | |
1474 (vconcat pr-menu-bar | |
1475 (mapcar 'pr-get-symbol path))))) | |
1476 (assq name (nthcdr 2 menu))))) | |
1477 | |
1478 ;; GNU Emacs | |
1479 (defvar pr-temp-menu nil) | |
1480 | |
1481 ;; GNU Emacs | |
1482 (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name | |
1483 entry index) | |
1484 (when (and alist (or force (symbol-value modified-sym))) | |
1485 (easy-menu-define pr-temp-menu nil "" | |
1486 (pr-menu-create name alist var-sym fun entry index)) | |
1487 (let ((item (pr-menu-get-item menu-path))) | |
1488 (and item | |
1489 (let* ((binding (nthcdr 3 item)) | |
1490 (key-binding (cdr binding))) | |
1491 (setcar binding pr-temp-menu) | |
1492 (and key-binding (listp (car key-binding)) | |
1493 (setcdr binding (cdr key-binding))) ; skip KEY-BINDING | |
1494 (funcall fun (symbol-value var-sym) item)))) | |
1495 (set modified-sym nil))) | |
1496 | |
1497 ;; GNU Emacs | |
1498 (defun pr-menu-set-item-name (item name) | |
1499 (and item | |
1500 (setcar (nthcdr 2 item) name))) ; ITEM-NAME | |
1501 | |
1502 ;; GNU Emacs | |
1503 (defun pr-menu-set-ps-title (value &optional item entry index) | |
1504 (pr-menu-set-item-name (or item | |
1505 (pr-menu-get-item "PostScript Printers")) | |
1506 (format "PostScript Printer: %s" value)) | |
1507 (pr-ps-set-printer value) | |
1508 (and index | |
1509 (pr-menu-lock entry index 12 'toggle nil))) | |
1510 | |
1511 ;; GNU Emacs | |
1512 (defun pr-menu-set-txt-title (value &optional item entry index) | |
1513 (pr-menu-set-item-name (or item | |
1514 (pr-menu-get-item "Text Printers")) | |
1515 (format "Text Printer: %s" value)) | |
1516 (pr-txt-set-printer value) | |
1517 (and index | |
1518 (pr-menu-lock entry index 12 'toggle nil))) | |
1519 | |
1520 ;; GNU Emacs | |
1521 (defun pr-menu-set-utility-title (value &optional item entry index) | |
1522 (let ((name (symbol-name value))) | |
1523 (if item | |
1524 (pr-menu-set-item-name item name) | |
1525 (pr-menu-set-item-name | |
1526 (pr-menu-get-item | |
1527 '("PostScript Print" "File" "PostScript Utility")) | |
1528 name) | |
1529 (pr-menu-set-item-name | |
1530 (pr-menu-get-item | |
1531 '("PostScript Preview" "File" "PostScript Utility")) | |
1532 name))) | |
1533 (pr-ps-set-utility value) | |
1534 (and index | |
1535 (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) | |
1536 | |
1537 ;; GNU Emacs | |
1538 (defun pr-even-or-odd-pages (value &optional no-lock) | |
1539 (pr-menu-set-item-name (pr-menu-get-item "Print All Pages") | |
1540 (cdr (assq value pr-even-or-odd-alist))) | |
1541 (setq ps-even-or-odd-pages value) | |
1542 (or no-lock | |
1543 (pr-menu-lock 'postscript-options 8 12 'toggle nil))) | |
1544 | |
1545 )) ; end cond featurep | |
1136 | 1546 |
1137 | 1547 |
1138 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1548 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1139 ;; Customization Functions | 1549 ;; Customization Functions |
1140 | 1550 |
2450 :type 'boolean | 2860 :type 'boolean |
2451 :version "20" | 2861 :version "20" |
2452 :group 'printing) | 2862 :group 'printing) |
2453 | 2863 |
2454 | 2864 |
2455 (defcustom pr-menu-char-height | 2865 (defcustom pr-menu-char-height (pr-menu-char-height) |
2456 (cond ((featurep 'xemacs) ; XEmacs | |
2457 (pr-x-font-height (face-font 'default))) | |
2458 (t ; GNU Emacs | |
2459 (pr-e-frame-char-height))) | |
2460 "*Specify menu char height in pixels. | 2866 "*Specify menu char height in pixels. |
2461 | 2867 |
2462 This variable is used to guess which vertical position should be locked the | 2868 This variable is used to guess which vertical position should be locked the |
2463 menu, so don't forget to adjust it if menu position is not ok. | 2869 menu, so don't forget to adjust it if menu position is not ok. |
2464 | 2870 |
2466 :type 'integer | 2872 :type 'integer |
2467 :version "20" | 2873 :version "20" |
2468 :group 'printing) | 2874 :group 'printing) |
2469 | 2875 |
2470 | 2876 |
2471 (defcustom pr-menu-char-width | 2877 (defcustom pr-menu-char-width (pr-menu-char-width) |
2472 (cond ((featurep 'xemacs) ; XEmacs | |
2473 (pr-x-font-width (face-font 'default))) | |
2474 (t ; GNU Emacs | |
2475 (pr-e-frame-char-width))) | |
2476 "*Specify menu char width in pixels. | 2878 "*Specify menu char width in pixels. |
2477 | 2879 |
2478 This variable is used to guess which horizontal position should be locked the | 2880 This variable is used to guess which horizontal position should be locked the |
2479 menu, so don't forget to adjust it if menu position is not ok. | 2881 menu, so don't forget to adjust it if menu position is not ok. |
2480 | 2882 |
2770 | 3172 |
2771 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 3173 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
2772 ;; Keys & Menus | 3174 ;; Keys & Menus |
2773 | 3175 |
2774 | 3176 |
2775 (defmacro pr-xemacs-global-menubar (&rest body) | |
2776 `(save-excursion | |
2777 (let ((temp (get-buffer-create (make-temp-name " *Temp")))) | |
2778 ;; be sure to access global menubar | |
2779 (set-buffer temp) | |
2780 ,@body | |
2781 (kill-buffer temp)))) | |
2782 | |
2783 | |
2784 (defsubst pr-visible-p (key) | 3177 (defsubst pr-visible-p (key) |
2785 (memq key pr-visible-entry-list)) | 3178 (memq key pr-visible-entry-list)) |
2786 | 3179 |
2787 | 3180 |
2788 (defsubst pr-mode-alist-p () | 3181 (defsubst pr-mode-alist-p () |
2799 | 3192 |
2800 (defalias 'pr-get-symbol | 3193 (defalias 'pr-get-symbol |
2801 (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el | 3194 (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el |
2802 'easy-menu-intern | 3195 'easy-menu-intern |
2803 (lambda (s) (if (stringp s) (intern s) s)))) | 3196 (lambda (s) (if (stringp s) (intern s) s)))) |
2804 | |
2805 (cond | |
2806 ((featurep 'xemacs) ; XEmacs | |
2807 (defvar zmacs-region-stays nil) ; to avoid compilation gripes | |
2808 (defun pr-region-active-p () | |
2809 (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p)))) | |
2810 | |
2811 (t ; GNU Emacs | |
2812 (defun pr-region-active-p () | |
2813 (and pr-auto-region transient-mark-mode mark-active)))) | |
2814 | 3197 |
2815 | 3198 |
2816 (defconst pr-menu-spec | 3199 (defconst pr-menu-spec |
2817 ;; Menu mapping: | 3200 ;; Menu mapping: |
2818 ;; unfortunately XEmacs doesn't support :active for submenus, | 3201 ;; unfortunately XEmacs doesn't support :active for submenus, |
3068 On Emacs 21 and 22, it replaces the File/Print* menu entries by File/Print | 3451 On Emacs 21 and 22, it replaces the File/Print* menu entries by File/Print |
3069 menu. | 3452 menu. |
3070 | 3453 |
3071 Calls `pr-update-menus' to adjust menus." | 3454 Calls `pr-update-menus' to adjust menus." |
3072 (interactive) | 3455 (interactive) |
3073 (cond | 3456 (pr-global-menubar pr-menu-spec) |
3074 ((featurep 'xemacs) ; XEmacs | |
3075 ;; Menu binding | |
3076 (pr-xemacs-global-menubar | |
3077 (pr-x-add-submenu nil (cons "Printing" pr-menu-spec) "Apps")) | |
3078 (setq pr-menu-print-item nil)) | |
3079 | |
3080 | |
3081 (t ; GNU Emacs | |
3082 ;; Menu binding | |
3083 (require 'easymenu) | |
3084 ;; Replace existing "print" item by "Printing" item. | |
3085 ;; If you're changing this file, you'll load it a second, | |
3086 ;; third... time, but "print" item exists only in the first load. | |
3087 (cond | |
3088 ;; Emacs 20 | |
3089 ((< emacs-major-version 21) | |
3090 (easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item) | |
3091 (when pr-menu-print-item | |
3092 (easy-menu-remove-item nil '("tools") pr-menu-print-item) | |
3093 (setq pr-menu-print-item nil | |
3094 pr-menu-bar (vector 'menu-bar 'tools | |
3095 (pr-get-symbol "Printing"))))) | |
3096 ;; Emacs 21 & 22 | |
3097 (t | |
3098 (let ((menu-file (if (= emacs-major-version 21) | |
3099 '("menu-bar" "files") ; Emacs 21 | |
3100 '("menu-bar" "file")))) ; Emacs 22 or higher | |
3101 (cond | |
3102 (pr-menu-print-item | |
3103 (easy-menu-add-item global-map menu-file | |
3104 (easy-menu-create-menu "Print" pr-menu-spec) | |
3105 "print-buffer") | |
3106 (dolist (item '("print-buffer" "print-region" | |
3107 "ps-print-buffer-faces" "ps-print-region-faces" | |
3108 "ps-print-buffer" "ps-print-region")) | |
3109 (easy-menu-remove-item global-map menu-file item)) | |
3110 (setq pr-menu-print-item nil | |
3111 pr-menu-bar (vector 'menu-bar | |
3112 (pr-get-symbol (nth 1 menu-file)) | |
3113 (pr-get-symbol "Print")))) | |
3114 (t | |
3115 (easy-menu-add-item global-map menu-file | |
3116 (easy-menu-create-menu "Print" pr-menu-spec))) | |
3117 )))))) | |
3118 (pr-update-menus t)) | 3457 (pr-update-menus t)) |
3119 | 3458 |
3120 | 3459 |
3121 ;; Key binding | 3460 ;; Key binding |
3122 (let ((pr-print-key (if (featurep 'xemacs) | 3461 (let ((pr-print-key (if (featurep 'xemacs) |
4839 (setq index (+ index | 5178 (setq index (+ index |
4840 (cdr (assq key pr-menu-entry-alist))))))) | 5179 (cdr (assq key pr-menu-entry-alist))))))) |
4841 (+ index 2)) | 5180 (+ index 2)) |
4842 | 5181 |
4843 | 5182 |
4844 (defvar pr-menu-position nil) | |
4845 (defvar pr-menu-state nil) | |
4846 | |
4847 | |
4848 (cond | |
4849 ((featurep 'xemacs) | |
4850 ;; XEmacs | |
4851 (defvar current-mouse-event nil) ; to avoid compilation gripes | |
4852 (defun pr-menu-position (entry index horizontal) | |
4853 (pr-x-make-event | |
4854 'button-release | |
4855 (list 'button 1 | |
4856 'x (- (pr-x-event-x-pixel current-mouse-event) ; X | |
4857 (* horizontal pr-menu-char-width)) | |
4858 'y (- (pr-x-event-y-pixel current-mouse-event) ; Y | |
4859 (* (pr-menu-index entry index) pr-menu-char-height))))) | |
4860 ) | |
4861 (ps-windows-system | |
4862 ;; GNU Emacs for Windows 9x/NT | |
4863 (defun pr-menu-position (entry index horizontal) | |
4864 (let ((pos (cdr (pr-e-mouse-pixel-position)))) | |
4865 (list | |
4866 (list (or (car pos) 0) ; X | |
4867 (- (or (cdr pos) 0) ; Y | |
4868 (* (pr-menu-index entry index) pr-menu-char-height))) | |
4869 (selected-frame)))) ; frame | |
4870 ) | |
4871 (t | |
4872 ;; GNU Emacs | |
4873 (defun pr-menu-position (entry index horizontal) | |
4874 (let ((pos (cdr (pr-e-mouse-pixel-position)))) | |
4875 (list | |
4876 (list (- (or (car pos) 0) ; X | |
4877 (* horizontal pr-menu-char-width)) | |
4878 (- (or (cdr pos) 0) ; Y | |
4879 (* (pr-menu-index entry index) pr-menu-char-height))) | |
4880 (selected-frame)))) ; frame | |
4881 )) | |
4882 | |
4883 (cond | |
4884 ((featurep 'xemacs) | |
4885 ;; XEmacs | |
4886 (defvar current-menubar nil) ; to avoid compilation gripes | |
4887 (defun pr-menu-lookup (path) | |
4888 (car (pr-x-find-menu-item current-menubar (cons "Printing" path)))) | |
4889 | |
4890 ;; XEmacs | |
4891 (defun pr-menu-lock (entry index horizontal state path) | |
4892 (when pr-menu-lock | |
4893 (or (and pr-menu-position (eq state pr-menu-state)) | |
4894 (setq pr-menu-position (pr-menu-position entry index horizontal) | |
4895 pr-menu-state state)) | |
4896 (let* ((menu (pr-menu-lookup path)) | |
4897 (result (pr-x-get-popup-menu-response menu pr-menu-position))) | |
4898 (and (pr-x-misc-user-event-p result) | |
4899 (funcall (pr-x-event-function result) | |
4900 (pr-x-event-object result)))) | |
4901 (setq pr-menu-position nil)))) | |
4902 | |
4903 | |
4904 (t | |
4905 ;; GNU Emacs | |
4906 (defun pr-menu-lookup (path) | |
4907 (lookup-key global-map | |
4908 (if path | |
4909 (vconcat pr-menu-bar | |
4910 (mapcar 'pr-get-symbol | |
4911 (if (listp path) | |
4912 path | |
4913 (list path)))) | |
4914 pr-menu-bar))) | |
4915 | |
4916 ;; GNU Emacs | |
4917 (defun pr-menu-lock (entry index horizontal state path) | |
4918 (when pr-menu-lock | |
4919 (or (and pr-menu-position (eq state pr-menu-state)) | |
4920 (setq pr-menu-position (pr-menu-position entry index horizontal) | |
4921 pr-menu-state state)) | |
4922 (let* ((menu (pr-menu-lookup path)) | |
4923 (result (x-popup-menu pr-menu-position menu))) | |
4924 (and result | |
4925 (let ((command (lookup-key menu (vconcat result)))) | |
4926 (if (fboundp command) | |
4927 (funcall command) | |
4928 (eval command))))) | |
4929 (setq pr-menu-position nil))))) | |
4930 | |
4931 | |
4932 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 5183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
4933 ;; Printer & Utility Selection | 5184 ;; Printer & Utility Selection |
4934 | 5185 |
4935 | 5186 |
4936 (defun pr-update-var (var-sym alist) | 5187 (defun pr-update-var (var-sym alist) |
4987 (symbol-name sym) | 5238 (symbol-name sym) |
4988 (list fun (list 'quote sym) nil (list 'quote entry) index) | 5239 (list fun (list 'quote sym) nil (list 'quote entry) index) |
4989 :style 'radio | 5240 :style 'radio |
4990 :selected (list 'eq var-sym (list 'quote sym))))) | 5241 :selected (list 'eq var-sym (list 'quote sym))))) |
4991 alist))) | 5242 alist))) |
4992 | |
4993 | |
4994 (cond | |
4995 ((featurep 'xemacs) | |
4996 ;; XEmacs | |
4997 (defalias 'pr-update-mode-line 'set-menubar-dirty-flag) | |
4998 | |
4999 ;; XEmacs | |
5000 (defvar pr-ps-name-old "PostScript Printers") | |
5001 (defvar pr-txt-name-old "Text Printers") | |
5002 (defvar pr-ps-utility-old "PostScript Utility") | |
5003 (defvar pr-even-or-odd-old "Print All Pages") | |
5004 | |
5005 ;; XEmacs | |
5006 (defun pr-do-update-menus (&optional force) | |
5007 (pr-menu-alist pr-ps-printer-alist | |
5008 'pr-ps-name | |
5009 'pr-menu-set-ps-title | |
5010 '("Printing") | |
5011 'pr-ps-printer-menu-modified | |
5012 force | |
5013 pr-ps-name-old | |
5014 'postscript 2) | |
5015 (pr-menu-alist pr-txt-printer-alist | |
5016 'pr-txt-name | |
5017 'pr-menu-set-txt-title | |
5018 '("Printing") | |
5019 'pr-txt-printer-menu-modified | |
5020 force | |
5021 pr-txt-name-old | |
5022 'text 2) | |
5023 (let ((save-var pr-ps-utility-menu-modified)) | |
5024 (pr-menu-alist pr-ps-utility-alist | |
5025 'pr-ps-utility | |
5026 'pr-menu-set-utility-title | |
5027 '("Printing" "PostScript Print" "File") | |
5028 'save-var | |
5029 force | |
5030 pr-ps-utility-old | |
5031 nil 1)) | |
5032 (pr-menu-alist pr-ps-utility-alist | |
5033 'pr-ps-utility | |
5034 'pr-menu-set-utility-title | |
5035 '("Printing" "PostScript Preview" "File") | |
5036 'pr-ps-utility-menu-modified | |
5037 force | |
5038 pr-ps-utility-old | |
5039 nil 1) | |
5040 (pr-even-or-odd-pages ps-even-or-odd-pages force)) | |
5041 | |
5042 ;; XEmacs | |
5043 (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name | |
5044 entry index) | |
5045 (when (and alist (or force (symbol-value modified-sym))) | |
5046 (pr-xemacs-global-menubar | |
5047 (pr-x-add-submenu menu-path | |
5048 (pr-menu-create name alist var-sym | |
5049 fun entry index))) | |
5050 (funcall fun (symbol-value var-sym)) | |
5051 (set modified-sym nil))) | |
5052 | |
5053 ;; XEmacs | |
5054 (defun pr-relabel-menu-item (newname var-sym) | |
5055 (pr-xemacs-global-menubar | |
5056 (pr-x-relabel-menu-item | |
5057 (list "Printing" (symbol-value var-sym)) | |
5058 newname) | |
5059 (set var-sym newname))) | |
5060 | |
5061 ;; XEmacs | |
5062 (defun pr-menu-set-ps-title (value &optional item entry index) | |
5063 (pr-relabel-menu-item (format "PostScript Printer: %s" value) | |
5064 'pr-ps-name-old) | |
5065 (pr-ps-set-printer value) | |
5066 (and index | |
5067 (pr-menu-lock entry index 12 'toggle nil))) | |
5068 | |
5069 ;; XEmacs | |
5070 (defun pr-menu-set-txt-title (value &optional item entry index) | |
5071 (pr-relabel-menu-item (format "Text Printer: %s" value) | |
5072 'pr-txt-name-old) | |
5073 (pr-txt-set-printer value) | |
5074 (and index | |
5075 (pr-menu-lock entry index 12 'toggle nil))) | |
5076 | |
5077 ;; XEmacs | |
5078 (defun pr-menu-set-utility-title (value &optional item entry index) | |
5079 (pr-xemacs-global-menubar | |
5080 (let ((newname (format "%s" value))) | |
5081 (pr-x-relabel-menu-item | |
5082 (list "Printing" "PostScript Print" "File" pr-ps-utility-old) | |
5083 newname) | |
5084 (pr-x-relabel-menu-item | |
5085 (list "Printing" "PostScript Preview" "File" pr-ps-utility-old) | |
5086 newname) | |
5087 (setq pr-ps-utility-old newname))) | |
5088 (pr-ps-set-utility value) | |
5089 (and index | |
5090 (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) | |
5091 | |
5092 ;; XEmacs | |
5093 (defun pr-even-or-odd-pages (value &optional no-lock) | |
5094 (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist)) | |
5095 'pr-even-or-odd-old) | |
5096 (setq ps-even-or-odd-pages value) | |
5097 (or no-lock | |
5098 (pr-menu-lock 'postscript-options 8 12 'toggle nil)))) | |
5099 | |
5100 | |
5101 (t | |
5102 ;; GNU Emacs | |
5103 (defalias 'pr-update-mode-line 'force-mode-line-update) | |
5104 | |
5105 ;; GNU Emacs | |
5106 (defun pr-do-update-menus (&optional force) | |
5107 (pr-menu-alist pr-ps-printer-alist | |
5108 'pr-ps-name | |
5109 'pr-menu-set-ps-title | |
5110 "PostScript Printers" | |
5111 'pr-ps-printer-menu-modified | |
5112 force | |
5113 "PostScript Printers" | |
5114 'postscript 2) | |
5115 (pr-menu-alist pr-txt-printer-alist | |
5116 'pr-txt-name | |
5117 'pr-menu-set-txt-title | |
5118 "Text Printers" | |
5119 'pr-txt-printer-menu-modified | |
5120 force | |
5121 "Text Printers" | |
5122 'text 2) | |
5123 (let ((save-var pr-ps-utility-menu-modified)) | |
5124 (pr-menu-alist pr-ps-utility-alist | |
5125 'pr-ps-utility | |
5126 'pr-menu-set-utility-title | |
5127 '("PostScript Print" "File" "PostScript Utility") | |
5128 'save-var | |
5129 force | |
5130 "PostScript Utility" | |
5131 nil 1)) | |
5132 (pr-menu-alist pr-ps-utility-alist | |
5133 'pr-ps-utility | |
5134 'pr-menu-set-utility-title | |
5135 '("PostScript Preview" "File" "PostScript Utility") | |
5136 'pr-ps-utility-menu-modified | |
5137 force | |
5138 "PostScript Utility" | |
5139 nil 1) | |
5140 (pr-even-or-odd-pages ps-even-or-odd-pages force)) | |
5141 | |
5142 ;; GNU Emacs | |
5143 (defun pr-menu-get-item (name-list) | |
5144 ;; NAME-LIST is a string or a list of strings. | |
5145 (or (listp name-list) | |
5146 (setq name-list (list name-list))) | |
5147 (and name-list | |
5148 (let* ((reversed (reverse name-list)) | |
5149 (name (pr-get-symbol (car reversed))) | |
5150 (path (nreverse (cdr reversed))) | |
5151 (menu (lookup-key | |
5152 global-map | |
5153 (vconcat pr-menu-bar | |
5154 (mapcar 'pr-get-symbol path))))) | |
5155 (assq name (nthcdr 2 menu))))) | |
5156 | |
5157 ;; GNU Emacs | |
5158 (defvar pr-temp-menu nil) | |
5159 | |
5160 ;; GNU Emacs | |
5161 (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name | |
5162 entry index) | |
5163 (when (and alist (or force (symbol-value modified-sym))) | |
5164 (easy-menu-define pr-temp-menu nil "" | |
5165 (pr-menu-create name alist var-sym fun entry index)) | |
5166 (let ((item (pr-menu-get-item menu-path))) | |
5167 (and item | |
5168 (let* ((binding (nthcdr 3 item)) | |
5169 (key-binding (cdr binding))) | |
5170 (setcar binding pr-temp-menu) | |
5171 (and key-binding (listp (car key-binding)) | |
5172 (setcdr binding (cdr key-binding))) ; skip KEY-BINDING | |
5173 (funcall fun (symbol-value var-sym) item)))) | |
5174 (set modified-sym nil))) | |
5175 | |
5176 ;; GNU Emacs | |
5177 (defun pr-menu-set-item-name (item name) | |
5178 (and item | |
5179 (setcar (nthcdr 2 item) name))) ; ITEM-NAME | |
5180 | |
5181 ;; GNU Emacs | |
5182 (defun pr-menu-set-ps-title (value &optional item entry index) | |
5183 (pr-menu-set-item-name (or item | |
5184 (pr-menu-get-item "PostScript Printers")) | |
5185 (format "PostScript Printer: %s" value)) | |
5186 (pr-ps-set-printer value) | |
5187 (and index | |
5188 (pr-menu-lock entry index 12 'toggle nil))) | |
5189 | |
5190 ;; GNU Emacs | |
5191 (defun pr-menu-set-txt-title (value &optional item entry index) | |
5192 (pr-menu-set-item-name (or item | |
5193 (pr-menu-get-item "Text Printers")) | |
5194 (format "Text Printer: %s" value)) | |
5195 (pr-txt-set-printer value) | |
5196 (and index | |
5197 (pr-menu-lock entry index 12 'toggle nil))) | |
5198 | |
5199 ;; GNU Emacs | |
5200 (defun pr-menu-set-utility-title (value &optional item entry index) | |
5201 (let ((name (symbol-name value))) | |
5202 (if item | |
5203 (pr-menu-set-item-name item name) | |
5204 (pr-menu-set-item-name | |
5205 (pr-menu-get-item | |
5206 '("PostScript Print" "File" "PostScript Utility")) | |
5207 name) | |
5208 (pr-menu-set-item-name | |
5209 (pr-menu-get-item | |
5210 '("PostScript Preview" "File" "PostScript Utility")) | |
5211 name))) | |
5212 (pr-ps-set-utility value) | |
5213 (and index | |
5214 (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) | |
5215 | |
5216 ;; GNU Emacs | |
5217 (defun pr-even-or-odd-pages (value &optional no-lock) | |
5218 (pr-menu-set-item-name (pr-menu-get-item "Print All Pages") | |
5219 (cdr (assq value pr-even-or-odd-alist))) | |
5220 (setq ps-even-or-odd-pages value) | |
5221 (or no-lock | |
5222 (pr-menu-lock 'postscript-options 8 12 'toggle nil))))) | |
5223 | 5243 |
5224 | 5244 |
5225 (defun pr-ps-set-utility (value) | 5245 (defun pr-ps-set-utility (value) |
5226 (let ((item (cdr (assq value pr-ps-utility-alist)))) | 5246 (let ((item (cdr (assq value pr-ps-utility-alist)))) |
5227 (or item | 5247 (or item |