(FILECREATED " 6-Nov-85 13:18:56" {DSK}<LISPFILES>FUNCTIONS>UTILITIES>PRINTERMENU.;7 18637
changes to: (VARS PRINTERMENUCOMS)
(FNS PRINTERMENU PRINTERMENU.CREATEPROMPTWINDOW PRINTERMENU.GETNAME
PRINTERMENU.INFOHOOK PRINTERMENU.WATCH PRINTERMENU.CLOSEFN
PRINTERMENU.WHENSELECTEDFN)
previous date: " 9-Oct-85 14:23:10" {DSK}<LISPFILES>FUNCTIONS>UTILITIES>PRINTERMENU.;3)
(* Copyright (c) 1985 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))
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTTTYREGION PRINTERMENU.POSITION PRINTERMENU.SHADE1
PRINTERMENU.WATCH.WAIT PRINTERMENU.WINDOW PROMPTWINDOW)
(P (if (POSITIONP PRINTERMENU.POSITION)
then
(PRINTERMENU)))))
(DEFINEQ
(PRINTERMENU
(LAMBDA NIL (* RAR " 6-Nov-85 12:33")
(* * 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.)
(PROG (Bottom Height Left Menu Process Width)
(* * Make the menu)
(SETQ Menu (PRINTERMENU.CREATEMENU))
(SETQ Width (fetch (MENU IMAGEWIDTH) of Menu))
(SETQ Height (fetch (MENU IMAGEHEIGHT) of Menu))
(* * 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))
(* * Suspend PRINTERMENU.WATCH if it's running)
(COND
((SETQ Process (FIND.PROCESS (QUOTE PRINTERMENU.WATCH)))
(SUSPEND.PROCESS Process)))
(* * Only one window allowed. Close any old one.)
(COND
((WINDOWP PRINTERMENU.WINDOW)
(WINDOWPROP PRINTERMENU.WINDOW (QUOTE CLOSEFN)
(FUNCTION NILL))
(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)
(COND
((PROCESSP Process)
(WAKE.PROCESS Process))
(T (ADD.PROCESS (QUOTE (PRINTERMENU.WATCH))
(QUOTE NAME)
(QUOTE PRINTERMENU.WATCH)
(QUOTE INFOHOOK)
(FUNCTION PRINTERMENU.INFOHOOK))))
(* * Open the menu window and return it)
(OPENW PRINTERMENU.WINDOW)
(RETURN PRINTERMENU.WINDOW))))
(PRINTERMENU.ADDMENUTOWINDOW
(LAMBDA (Menu) (* Ridder: " 2-Aug-85 13:32")
(* * Place Menu in PRINTERMENU.WINDOW and shade first two items of menu)
(PROG ((Menuitems (fetch (MENU ITEMS) of Menu)))
(ADDMENU Menu PRINTERMENU.WINDOW)
(SHADEITEM (CAR Menuitems)
Menu BLACKSHADE PRINTERMENU.WINDOW)
(COND
((IGEQ (LENGTH Menuitems)
2)
(SHADEITEM (CADR Menuitems)
Menu BLACKSHADE PRINTERMENU.WINDOW))))))
(PRINTERMENU.ADDORDELETE?
(LAMBDA NIL (* RAR " 9-Oct-85 13:41")
(* * Add or Delete from DEFAULTPRINTINGHOST)
(PROG (Item Printer)
(* * Popup a little menu to find out if add or delete wanted)
(SETQ 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)))
(COND
((NOT (OR (EQ Item (QUOTE Add))
(EQ Item (QUOTE Delete))))
(RETURN NIL)))
(* * Since we'll be requiring the use of the mouse for awhile, spawn a new mouse so things can't get locked up.)
(SPAWN.MOUSE)
(* * Find out what to Add or Delete)
(SETQ Printer (PRINTERMENU.GETNAME Item))
(* * If nothing returned, we're done)
(COND
((NOT Printer)
(RETURN NIL)))
(* * If Add or Delete, then do it)
(COND
((EQ Item (QUOTE Add))
(COND
((NOT (MEMBER Printer DEFAULTPRINTINGHOST))
(SETQ DEFAULTPRINTINGHOST (ATTACH Printer DEFAULTPRINTINGHOST))
(RETURN Item))))
((EQ Item (QUOTE Delete))
(COND
((SETQ Printer
(for Element in DEFAULTPRINTINGHOST
do (COND
((OR (AND (LISTP Element)
(EQUAL Printer (MKATOM (OR (AND (IGEQ 2 (LENGTH Element))
(CADR Element))
(CAR Element)))))
(EQUAL Printer (MKATOM Element)))
(RETURN Element)))))
(COND
((EQLENGTH DEFAULTPRINTINGHOST 1)
(SETQ DEFAULTPRINTINGHOST NIL))
(T (SETQ DEFAULTPRINTINGHOST (REMOVE Printer DEFAULTPRINTINGHOST))))
(RETURN Item))))))))
(PRINTERMENU.AFTERMOVEFN
(LAMBDA (Window) (* RAR " 8-Oct-85 08:43")
(* * Update the value of PRINTERMENU.POSITION)
(PROG ((Region (WINDOWPROP Window (QUOTE REGION))))
(SETQ PRINTERMENU.POSITION (create POSITION
XCOORD ←(fetch (REGION LEFT) of Region)
YCOORD ←(fetch (REGION BOTTOM) of Region))))))
(PRINTERMENU.CLOSEFN
(LAMBDA NIL (* RAR " 4-Nov-85 10:45")
(* * Set the globalvar for the printermenu window to NIL)
(SETQ PRINTERMENU.WINDOW NIL)
(* * If PRINTERMENU.WINDOW closed, then shut down process to monitor DEFAULTPRINTINGHOST)
(PROG ((Process (FIND.PROCESS (QUOTE PRINTERMENU.WATCH))))
(if Process
then (DEL.PROCESS Process)))))
(PRINTERMENU.CREATEMENU
(LAMBDA NIL (* RAR " 8-Oct-85 10:32")
(* * Create and return the menu to be used by PRINTERMENU)
(create MENU
ITEMS ←(ATTACH (QUOTE DEFAULT% PRINTER)
(for Item in DEFAULTPRINTINGHOST collect
(COND
((LISTP Item)
(MKATOM (COND
((IGEQ 2 (LENGTH Item))
(CADR Item))
(T (CAR Item)))))
(T (MKATOM Item)))))
WHENSELECTEDFN ←(FUNCTION PRINTERMENU.WHENSELECTEDFN)
WHENHELDFN ←(FUNCTION PRINTERMENU.WHENHELDFN)
CENTERFLG ← T
MENUBORDERSIZE ← 1)))
(PRINTERMENU.CREATEPROMPTWINDOW
(LAMBDA NIL (* RAR " 6-Nov-85 13:14")
(* * 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)
(QUOTE Question% from% PRINTERMENU% :)
NIL T)))))
(PRINTERMENU.GETNAME
(LAMBDA (Item) (* RAR " 6-Nov-85 13:12")
(* * Return name of printer to add or delete.)
(COND
((EQ Item (QUOTE Add))
(* * Add)
(PROG (Returnval String Stringstream Window)
(COND
((SETQ String (PROMPTFORWORD "Enter name of printer to add :" NIL NIL (SETQ Window
(PRINTERMENU.CREATEPROMPTWINDOW))
NIL
(QUOTE TTY)
(CHARCODE (EOL ESCAPE LF))))
(SETQ Stringstream (OPENSTRINGSTREAM String (QUOTE INPUT)))
(SETQ Returnval (READ Stringstream))
(CLOSEF Stringstream)))
(CLOSEW Window)
(RETURN Returnval)))
(T
(* * Delete)
(PROG (Deleteitem)
(* * Tell user to select something)
(FRESHLINE PROMPTWINDOW)
(printout PROMPTWINDOW "Select a printer to delete " T)
(SETQ Deleteitem (PRINTERMENU.SELECTPRINTER))
(CLEARW PROMPTWINDOW)
(RETURN Deleteitem))))))
(PRINTERMENU.INFOHOOK
(LAMBDA (Process Button) (* RAR " 6-Nov-85 12:44")
(printout PROMPTWINDOW .TAB0 0 "Monitors the value of DEFAULTPRINTINGHOST for PRINTERMENU." T)))
(PRINTERMENU.SELECTPRINTER
(LAMBDA NIL (* RAR " 9-Oct-85 14:19")
(* * Return the printer selected with the mouse from the PRINTERMENU menu, or return NIL if none chosen)
(PROG (Listofprinters Menu Menuposition Printer Screenposition (Windowregion (WINDOWPROP
PRINTERMENU.WINDOW
(QUOTE REGION))))
(* * Get the menu in the PRINTERMENU.WINDOW)
(SETQ Menu (WINDOWPROP PRINTERMENU.WINDOW (QUOTE MENU)))
(COND
((LISTP Menu)
(SETQ Menu (CAR Menu))))
(* * Get the list of printers)
(SETQ Listofprinters (CDR (fetch (MENU ITEMS) of Menu)))
(* * Wait until mouse button down)
(until (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do (for Item in Listofprinters
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))
eachtime (SETQ Screenposition (create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY))
(SETQ Menuposition (create POSITION
XCOORD ←(LASTMOUSEX PRINTERMENU.WINDOW)
YCOORD ←(LASTMOUSEY PRINTERMENU.WINDOW)))
do (COND
((INSIDEP Windowregion Screenposition)
(for Item in Listofprinters do (COND
((INSIDEP (MENUITEMREGION Item Menu)
Menuposition)
(SHADEITEM Item Menu GRAYSHADE
PRINTERMENU.WINDOW))
(T (SHADEITEM Item Menu WHITESHADE
PRINTERMENU.WINDOW)))))
(T (for Item in Listofprinters do (SHADEITEM Item Menu WHITESHADE
PRINTERMENU.WINDOW))))
finally (for Item in Listofprinters do (SHADEITEM Item Menu (COND
((EQ Item (CAR Listofprinters))
BLACKSHADE)
(T WHITESHADE))
PRINTERMENU.WINDOW)))
(* * Get the position of the mouse following the click in the coordinates of the PRINTERMENU.WINDOW)
(SETQ Menuposition (create POSITION
XCOORD ←(LASTMOUSEX PRINTERMENU.WINDOW)
YCOORD ←(LASTMOUSEY PRINTERMENU.WINDOW)))
(* * If not in the PRINTERMENU.WINDOW, we'er done)
(COND
((NOT (INSIDEP Windowregion (create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY)))
(RETURN NIL)))
(* * 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)
Menuposition)
(SETQ Printer Item))))
(RETURN Printer))))
(PRINTERMENU.TOFRONTOFLIST
(LAMBDA (Item) (* RAR " 8-Oct-85 10:32")
(* * Move Item to front of DEFAULTPRINTINGHOST)
(PROG (Element Totop)
(* * First find the element of DEFAULTPRINTINGHOST to be moved to first place)
(for Element in DEFAULTPRINTINGHOST first (SETQ Totop NIL)
do (COND
((OR (AND (LISTP Element)
(EQUAL Item (MKATOM (OR (AND (IGEQ 2 (LENGTH Element))
(CADR Element))
(CAR Element)))))
(EQUAL Item (MKATOM Element)))
(SETQ Totop Element)))
repeatuntil Totop)
(* * Now place the element in first place)
(SETQ DEFAULTPRINTINGHOST (REMOVE Totop DEFAULTPRINTINGHOST))
(ATTACH Totop DEFAULTPRINTINGHOST))))
(PRINTERMENU.WATCH
(LAMBDA NIL (* RAR " 6-Nov-85 10:34")
(* * Every PRINTERMENU.WATCH.WAIT seconds check to see if DEFAULTPRINTINGHOST has changed. If it has, then update
the printer menu.)
(* * This function runs as a separate process. If the process is deleted or killed, the PRINTERMENU.WINDOW will be
grayed out.)
(PROG (Menu)
(RESETLST (RESETSAVE NIL (QUOTE (COND ((AND (OPENWP PRINTERMENU.WINDOW)
(TYPENAMEP (SETQ Menu
(CAR (WINDOWPROP
PRINTERMENU.WINDOW
(QUOTE MENU))))
(QUOTE MENU)))
(for Item in (CDR (fetch (MENU ITEMS) of Menu))
do (SHADEITEM Item Menu PRINTERMENU.SHADE1
PRINTERMENU.WINDOW))))))
(while (PROGN (* Until killed)
T)
do (COND
((NOT (EQUAL DEFAULTPRINTINGHOST (WINDOWPROP PRINTERMENU.WINDOW
(QUOTE DEFAULTPRINTINGHOST)))
)
(ADD.PROCESS (QUOTE (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) (* RAR " 4-Nov-85 10:49")
(* * Respond to item selected in menu)
(PROG ((Menuitems (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 (QUOTE PRINTERMENU.WATCH))))
(PRINTERMENU)
(RETURN NIL)))
(* * If selecting the "title bar", then popup the add-or-delete menu and add or delete a printer)
(COND
((EQ Item (CAR Menuitems))
(SETQ Item (PRINTERMENU.ADDORDELETE?))
(COND
(Item (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)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTTTYREGION PRINTERMENU.POSITION PRINTERMENU.SHADE1
PRINTERMENU.WATCH.WAIT PRINTERMENU.WINDOW PROMPTWINDOW)
)
(if (POSITIONP PRINTERMENU.POSITION)
then
(PRINTERMENU))
(PUTPROPS PRINTERMENU COPYRIGHT ("Robert Ridder" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1260 18157 (PRINTERMENU 1270 . 3923) (PRINTERMENU.ADDMENUTOWINDOW 3925 . 4502) (
PRINTERMENU.ADDORDELETE? 4504 . 6618) (PRINTERMENU.AFTERMOVEFN 6620 . 7056) (PRINTERMENU.CLOSEFN 7058
. 7540) (PRINTERMENU.CREATEMENU 7542 . 8266) (PRINTERMENU.CREATEPROMPTWINDOW 8268 . 9383) (
PRINTERMENU.GETNAME 9385 . 10511) (PRINTERMENU.INFOHOOK 10513 . 10734) (PRINTERMENU.SELECTPRINTER
10736 . 14023) (PRINTERMENU.TOFRONTOFLIST 14025 . 14935) (PRINTERMENU.WATCH 14937 . 16211) (
PRINTERMENU.WHENHELDFN 16213 . 16734) (PRINTERMENU.WHENSELECTEDFN 16736 . 18155)))))
STOP