-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathPRINTERMENU
114 lines (83 loc) · 13.4 KB
/
PRINTERMENU
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Oct-88 18:01:30" |{EG:PARC:XEROX}<JELLINEK>LISPUSERS>PRINTERMENU.;3| 13173
changes to%: (VARS PRINTERMENUCOMS) (FNS PRINTERMENU PRINTERMENU.ADDMENUTOWINDOW PRINTERMENU.ADDORDELETE? PRINTERMENU.INFOHOOK PRINTERMENU.SELECTPRINTER PRINTERMENU.WATCH PRINTERMENU.WHENSELECTEDFN PRINTERMENU.CLOSEFN PRINTERMENU.GETNAME PRINTERMENU.CREATEMENU PRINTERMENU.CREATEPROMPTWINDOW PRINTERMENU.TOFRONTOFLIST)
previous date%: "13-Feb-87 09:11:46" {PHYLUM}<LISPUSERS>MEDLEY>PRINTERMENU.;1)
(* "
Copyright (c) 1985, 1987, 1988 by Robert Ridder. All rights reserved.
")
(PRETTYCOMPRINT PRINTERMENUCOMS)
(RPAQQ PRINTERMENUCOMS ((FNS PRINTERMENU PRINTERMENU.ADDMENUTOWINDOW PRINTERMENU.ADDORDELETE? PRINTERMENU.AFTERMOVEFN PRINTERMENU.CLOSEFN PRINTERMENU.CREATEMENU PRINTERMENU.CREATEPROMPTWINDOW PRINTERMENU.GETNAME PRINTERMENU.INFOHOOK PRINTERMENU.SELECTPRINTER PRINTERMENU.TOFRONTOFLIST PRINTERMENU.WATCH PRINTERMENU.WHENHELDFN PRINTERMENU.WHENSELECTEDFN) (INITVARS (PRINTERMENU.POSITION NIL) (PRINTERMENU.SHADE1 9345) (PRINTERMENU.WATCH.WAIT 5) (PRINTERMENU.WINDOW NIL)) (VARS PRINTERMENU.PRINTERSHADE) (GLOBALVARS PRINTERMENU.POSITION PRINTERMENU.SHADE1 PRINTERMENU.WATCH.WAIT PRINTERMENU.WINDOW PROMPTWINDOW) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (if (POSITIONP PRINTERMENU.POSITION) then (PRINTERMENU))))))
(DEFINEQ
(PRINTERMENU
(LAMBDA NIL (* ; "Edited 30-Sep-88 18:38 by hdj") (* ;;; "Creates a menu window which can be used to alter the value of DEFAULTPRINTINGHOST such that one can add printers, delete printers, and rearrange the order of printers on the list.") (LET* ((PROCESS (FIND.PROCESS "PrinterMenu")) (MENU (PRINTERMENU.CREATEMENU)) (WIDTH (XCL:RECORD-FETCH :MENU :IMAGEWIDTH MENU)) (HEIGHT (XCL:RECORD-FETCH :MENU :IMAGEHEIGHT MENU)) LEFT BOTTOM) (* ;; "Find out where to put it") (COND ((NOT (POSITIONP PRINTERMENU.POSITION)) (SETQ PRINTERMENU.POSITION (GETBOXPOSITION WIDTH HEIGHT)))) (SETQ LEFT (fetch (POSITION XCOORD) of PRINTERMENU.POSITION)) (SETQ BOTTOM (fetch (POSITION YCOORD) of PRINTERMENU.POSITION)) (* ;; "Zap PRINTERMENU.WATCH if it's running") (COND (PROCESS (SUSPEND.PROCESS PROCESS))) (* ;; "Only one window allowed. Close any old one.") (COND ((WINDOWP PRINTERMENU.WINDOW) (WINDOWPROP PRINTERMENU.WINDOW (QUOTE CLOSEFN) NIL) (CLOSEW PRINTERMENU.WINDOW))) (* ;; "Create a new window") (SETQ PRINTERMENU.WINDOW (CREATEW (CREATEREGION LEFT BOTTOM WIDTH HEIGHT) NIL 0 T)) (WINDOWPROP PRINTERMENU.WINDOW (QUOTE AFTERMOVEFN) (FUNCTION PRINTERMENU.AFTERMOVEFN)) (WINDOWPROP PRINTERMENU.WINDOW (QUOTE RESHAPEFN) (QUOTE DON'T)) (WINDOWPROP PRINTERMENU.WINDOW (QUOTE DEFAULTPRINTINGHOST) (COPYALL DEFAULTPRINTINGHOST)) (WINDOWPROP PRINTERMENU.WINDOW (QUOTE CLOSEFN) (FUNCTION PRINTERMENU.CLOSEFN)) (* ;; "Add the menu to PRINTERMENU.WINDOW") (PRINTERMENU.ADDMENUTOWINDOW MENU) (* ;; "Start the process to monitor the value of DEFAULTPRINTINGHOST") (if PROCESS then (WAKE.PROCESS PROCESS) else (ADD.PROCESS (QUOTE (PRINTERMENU.WATCH)) (QUOTE NAME) "PrinterMenu" (QUOTE INFOHOOK) (FUNCTION PRINTERMENU.INFOHOOK) (QUOTE RESTARTABLE) T)) (* ;; "Open the menu window and return it") (OPENW PRINTERMENU.WINDOW) PRINTERMENU.WINDOW))
)
(PRINTERMENU.ADDMENUTOWINDOW
(LAMBDA (MENU) (* ; "Edited 30-Sep-88 13:30 by hdj") (* ;; "Place Menu in PRINTERMENU.WINDOW and shade first two items of menu") (LET ((MENU-ITEMS (fetch (MENU ITEMS) of MENU))) (ADDMENU MENU PRINTERMENU.WINDOW) (SHADEITEM (CAR MENU-ITEMS) MENU BLACKSHADE PRINTERMENU.WINDOW) (COND ((CADR MENU-ITEMS) (SHADEITEM (CADR MENU-ITEMS) MENU PRINTERMENU.PRINTERSHADE PRINTERMENU.WINDOW)))))
)
(PRINTERMENU.ADDORDELETE?
(LAMBDA NIL (* ; "Edited 30-Sep-88 11:01 by hdj") (* ;;; "Add or Delete from DEFAULTPRINTINGHOST") (LET ((ITEM (MENU (create MENU ITEMS _ (QUOTE (("Add printer" (QUOTE Add) "Allows you to add a printer to DEFAULTPRINTINGHOST") ("Delete printer" (QUOTE Delete) "Allows you to delete a printer from DEFAULTPRINTINGHOST"))) CENTERFLG _ T MENUBORDERSIZE _ 1))) PRINTER-NAME) (* ;; "Pop up a menu to find out if add or delete wanted") (if ITEM then (* ;; "Since we'll be requiring the use of the mouse for a while, spawn a new mouse so things can't get locked up.") (SPAWN.MOUSE) (* ;; "Find out what to Add or Delete") (SETQ PRINTER-NAME (PRINTERMENU.GETNAME ITEM)) (* ;; "If nothing selected, do nothing") (if PRINTER-NAME then (* ;; "If Add or Delete, then do it") (SELECTQ ITEM (Add (COND ((NOT (MEMBER PRINTER-NAME DEFAULTPRINTINGHOST)) (SETQ DEFAULTPRINTINGHOST (CONS PRINTER-NAME DEFAULTPRINTINGHOST)) ITEM))) (Delete (COND ((SETQ PRINTER-NAME (for PRINTER-DESCR in DEFAULTPRINTINGHOST do (COND ((OR (AND (LISTP PRINTER-DESCR) (STRING-EQUAL PRINTER-NAME (OR (CADR PRINTER-DESCR) (CAR PRINTER-DESCR)))) (AND (NLISTP PRINTER-NAME) (NLISTP PRINTER-DESCR) (STRING-EQUAL PRINTER-NAME PRINTER-DESCR))) (RETURN PRINTER-DESCR))))) (COND ((NOT (CDR DEFAULTPRINTINGHOST)) (SETQ DEFAULTPRINTINGHOST NIL)) (T (SETQ DEFAULTPRINTINGHOST (REMOVE PRINTER-NAME DEFAULTPRINTINGHOST)))) ITEM))) NIL)))))
)
(PRINTERMENU.AFTERMOVEFN
(LAMBDA (Window) (* RAR " 8-Oct-85 08:43")
(* * Update the value of PRINTERMENU.POSITION)
(PROG ((Region (WINDOWPROP Window 'REGION)))
(SETQ PRINTERMENU.POSITION (create POSITION
XCOORD _ (fetch (REGION LEFT) of Region)
YCOORD _ (fetch (REGION BOTTOM) of Region))))))
(PRINTERMENU.CLOSEFN
(LAMBDA NIL (* ; "Edited 30-Sep-88 18:27 by hdj") (* ;; "Set the globalvar for the printermenu window to NIL") (SETQ PRINTERMENU.WINDOW NIL) (* ;; "If PRINTERMENU.WINDOW closed, then shut down process to monitor DEFAULTPRINTINGHOST") (LET ((PROCESS (FIND.PROCESS "PrinterMenu"))) (if PROCESS then (DEL.PROCESS PROCESS))))
)
(PRINTERMENU.CREATEMENU
(LAMBDA NIL (* ; "Edited 29-Sep-88 18:19 by hdj") (* ;;; "Create and return the menu to be used by PRINTERMENU") (create MENU ITEMS _ (CONS "-- Default Printer --" (for PRINTER-DESCR in DEFAULTPRINTINGHOST collect (COND ((LISTP PRINTER-DESCR) (OR (CADR PRINTER-DESCR) (CAR PRINTER-DESCR))) (T PRINTER-DESCR)))) WHENSELECTEDFN _ (FUNCTION PRINTERMENU.WHENSELECTEDFN) WHENHELDFN _ (FUNCTION PRINTERMENU.WHENHELDFN) CENTERFLG _ T MENUBORDERSIZE _ 1))
)
(PRINTERMENU.CREATEPROMPTWINDOW
(LAMBDA NIL (* ; "Edited 29-Sep-88 17:34 by hdj") (* ;;; "Return a window to be used to ask for the name of a printer to add to the menu") (PROG (Bottom Font Height Left MouseX MouseY Width) (SETQ Font (DEFAULTFONT (QUOTE DISPLAY))) (SETQ Width (WIDTHIFWINDOW (ITIMES 60 (CHARWIDTH (CHCON1 "X") Font)))) (SETQ Height (HEIGHTIFWINDOW (ITIMES 2 (FONTPROP Font (QUOTE HEIGHT))) T)) (SETQ Left (COND ((IGEQ (IDIFFERENCE SCREENWIDTH (SETQ MouseX LASTMOUSEX)) Width) MouseX) (T (IMAX 0 (IDIFFERENCE MouseX Width))))) (SETQ Bottom (COND ((IGEQ (IDIFFERENCE SCREENHEIGHT (SETQ MouseY LASTMOUSEY)) Height) MouseY) (T (IMAX 0 (IDIFFERENCE MouseY Height))))) (RETURN (CREATEW (CREATEREGION Left Bottom Width Height) "Question from PRINTERMENU:" NIL T))))
)
(PRINTERMENU.GETNAME
(LAMBDA (ITEM) (* ; "Edited 30-Sep-88 18:29 by hdj") (* ;;; "Return name of printer to add or delete.") (COND ((EQ ITEM (QUOTE Add)) (* ;; "Add") (LET ((WINDOW (PRINTERMENU.CREATEPROMPTWINDOW))) (PROG1 (PROMPTFORWORD "Enter name of printer to add: " NIL NIL WINDOW NIL (QUOTE TTY) (CHARCODE (EOL ESCAPE LF))) (CLOSEW WINDOW)))) (T (* ;; "Delete") (CL:FORMAT PROMPTWINDOW "~&Select a printer to delete") (PROG1 (PRINTERMENU.SELECTPRINTER) (CLEARW PROMPTWINDOW)))))
)
(PRINTERMENU.INFOHOOK
(LAMBDA (PROCESS BUTTON) (* ; "Edited 30-Sep-88 10:35 by hdj") (CL:FORMAT PROMPTWINDOW "~&Monitors the value of DEFAULTPRINTINGHOST for PRINTERMENU.~%%"))
)
(PRINTERMENU.SELECTPRINTER
(LAMBDA NIL (* ; "Edited 30-Sep-88 10:58 by hdj") (* ;;; "Return the printer selected with the mouse from the PRINTERMENU menu, or return NIL if none chosen") (LET ((MENU (WINDOWPROP PRINTERMENU.WINDOW (QUOTE MENU))) LIST-OF-PRINTERS MENU-POSITION PRINTER SCREEN-POSITION (WINDOW-REGION (WINDOWPROP PRINTERMENU.WINDOW (QUOTE REGION)))) (* ;; "Get the menu in the PRINTERMENU.WINDOW") (COND ((LISTP MENU) (SETQ MENU (CAR MENU)))) (* ;; "Get the list of printers") (SETQ LIST-OF-PRINTERS (CDR (fetch (MENU ITEMS) of MENU))) (* ;; "Wait until mouse button down") (until (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do (for ITEM in LIST-OF-PRINTERS do (SHADEITEM ITEM MENU WHITESHADE PRINTERMENU.WINDOW))) (* ;; "I didn't use the function UNTILMOUSESTATE because I want to keep control of the mouse until the user clicks it somewhere.") (* ;; "While mouse button down, if cursor in menu-item region, grayout region") (while (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do (COND ((INSIDEP WINDOW-REGION LASTMOUSEX LASTMOUSEY) (for ITEM in LIST-OF-PRINTERS do (COND ((INSIDEP (MENUITEMREGION ITEM MENU) (LASTMOUSEX PRINTERMENU.WINDOW) (LASTMOUSEY PRINTERMENU.WINDOW)) (SHADEITEM ITEM MENU GRAYSHADE PRINTERMENU.WINDOW)) (T (SHADEITEM ITEM MENU WHITESHADE PRINTERMENU.WINDOW))))) (T (for ITEM in LIST-OF-PRINTERS do (SHADEITEM ITEM MENU WHITESHADE PRINTERMENU.WINDOW)))) finally (for ITEM in LIST-OF-PRINTERS do (SHADEITEM ITEM MENU (COND ((EQ ITEM (CAR LIST-OF-PRINTERS)) BLACKSHADE) (T WHITESHADE)) PRINTERMENU.WINDOW))) (* ;; "Get the position of the mouse following the click in the coordinates of the PRINTERMENU.WINDOW") (* ;; "If not in the PRINTERMENU.WINDOW, we're done") (COND ((INSIDEP WINDOW-REGION (create POSITION XCOORD _ LASTMOUSEX YCOORD _ LASTMOUSEY)) (* ;; "See if the position of the mouse cursor is inside the menu-item-region for a printer on the menu") (for ITEM in (CDR (fetch (MENU ITEMS) of MENU)) do (COND ((INSIDEP (MENUITEMREGION ITEM MENU) (LASTMOUSEX PRINTERMENU.WINDOW) (LASTMOUSEY PRINTERMENU.WINDOW)) (SETQ PRINTER ITEM)))) PRINTER))))
)
(PRINTERMENU.TOFRONTOFLIST
(LAMBDA (PRINTER-NAME) (* ; "Edited 29-Sep-88 18:17 by hdj") (* ;;; "Move Item to front of DEFAULTPRINTINGHOST") (LET ((THING-TO-MOVE NIL)) (* ;; "First find the element of DEFAULTPRINTINGHOST to be moved to first place") (for PRINTER-DESCR in DEFAULTPRINTINGHOST do (COND ((OR (AND (LISTP PRINTER-DESCR) (STRING-EQUAL PRINTER-NAME (OR (CADR PRINTER-DESCR) (CAR PRINTER-DESCR)))) (AND (NLISTP PRINTER-NAME) (NLISTP PRINTER-DESCR) (STRING-EQUAL PRINTER-NAME PRINTER-DESCR))) (SETQ THING-TO-MOVE PRINTER-DESCR))) repeatuntil THING-TO-MOVE) (* ;;; "Now place the element in first place") (SETQ DEFAULTPRINTINGHOST (CONS THING-TO-MOVE (REMOVE THING-TO-MOVE DEFAULTPRINTINGHOST)))))
)
(PRINTERMENU.WATCH
(LAMBDA NIL (* ; "Edited 30-Sep-88 18:37 by hdj") (* ;;; "Every PRINTERMENU.WATCH.WAIT seconds check to see if DEFAULTPRINTINGHOST has changed. If it has, then update the printer menu.") (do (* ; "forever") (COND ((NOT (EQUAL DEFAULTPRINTINGHOST (WINDOWPROP PRINTERMENU.WINDOW (QUOTE DEFAULTPRINTINGHOST)))) (PRINTERMENU))) (BLOCK (ITIMES PRINTERMENU.WATCH.WAIT 1000))))
)
(PRINTERMENU.WHENHELDFN
(LAMBDA (Item Menu Button) (* Ridder%: " 2-Aug-85 13:30")
(* * Print an appropriate message in PROMPTWINDOW.)
(PROG ((Menuitems (fetch (MENU ITEMS) of Menu)))
(COND
((EQ Item (CAR Menuitems))
(printout PROMPTWINDOW "This item allows you to add or delete printers" T))
(T (printout PROMPTWINDOW "Will make " Item " the first element of DEFAULTPRINTINGHOST"
T))))))
(PRINTERMENU.WHENSELECTEDFN
(LAMBDA (ITEM MENU BUTTON) (* ; "Edited 30-Sep-88 18:27 by hdj") (* ;; "Respond to item selected in menu") (PROG ((MENU-ITEMS (fetch (MENU ITEMS) of MENU))) (* ;; "If the value of DEFAULTPRINTINGHOST has been changed outside of PRINTERMENU, or if the monitor process has been killed, then update the menu and return") (COND ((OR (NOT (EQUAL DEFAULTPRINTINGHOST (WINDOWPROP PRINTERMENU.WINDOW (QUOTE DEFAULTPRINTINGHOST)))) (NOT (FIND.PROCESS "PrinterMenu"))) (PRINTERMENU) (RETURN NIL))) (* ;; "If selecting the 'title bar' , then popup the add-or-delete menu and add or delete a printer") (if (EQ ITEM (CAR MENU-ITEMS)) then (if (PRINTERMENU.ADDORDELETE?) then (PRINTERMENU)) (RETURN NIL)) (* ;; "If a printer was selected, move it to the top of the menu and the front of DEFAULTPRINTINGHOST") (PRINTERMENU.TOFRONTOFLIST ITEM) (DELETEMENU MENU NIL PRINTERMENU.WINDOW) (PRINTERMENU.ADDMENUTOWINDOW (PRINTERMENU.CREATEMENU)) (WINDOWPROP PRINTERMENU.WINDOW (QUOTE DEFAULTPRINTINGHOST) (COPYALL DEFAULTPRINTINGHOST))))
)
)
(RPAQ? PRINTERMENU.POSITION NIL)
(RPAQ? PRINTERMENU.SHADE1 9345)
(RPAQ? PRINTERMENU.WATCH.WAIT 5)
(RPAQ? PRINTERMENU.WINDOW NIL)
(RPAQQ PRINTERMENU.PRINTERSHADE 33825)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PRINTERMENU.POSITION PRINTERMENU.SHADE1 PRINTERMENU.WATCH.WAIT PRINTERMENU.WINDOW PROMPTWINDOW)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(if (POSITIONP PRINTERMENU.POSITION) then (PRINTERMENU))
)
(PUTPROPS PRINTERMENU COPYRIGHT ("Robert Ridder" 1985 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1407 12672 (PRINTERMENU 1417 . 3257) (PRINTERMENU.ADDMENUTOWINDOW 3259 . 3677) (
PRINTERMENU.ADDORDELETE? 3679 . 5097) (PRINTERMENU.AFTERMOVEFN 5099 . 5595) (PRINTERMENU.CLOSEFN 5597
. 5945) (PRINTERMENU.CREATEMENU 5947 . 6424) (PRINTERMENU.CREATEPROMPTWINDOW 6426 . 7207) (
PRINTERMENU.GETNAME 7209 . 7699) (PRINTERMENU.INFOHOOK 7701 . 7883) (PRINTERMENU.SELECTPRINTER 7885 .
9962) (PRINTERMENU.TOFRONTOFLIST 9964 . 10674) (PRINTERMENU.WATCH 10676 . 11072) (
PRINTERMENU.WHENHELDFN 11074 . 11619) (PRINTERMENU.WHENSELECTEDFN 11621 . 12670)))))
STOP