(FILECREATED "12-Dec-85 17:28:07" {IVAN}<TBIGHAM>LISP>CHANGEPRINTER.;11 12998
changes to: (FNS CPN.SET.PRINTER)
previous date: "12-Dec-85 16:36:52" {IVAN}<TBIGHAM>LISP>CHANGEPRINTER.;10)
(* Copyright (c) 1985 by TBigham, Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CHANGEPRINTERCOMS)
(RPAQQ CHANGEPRINTERCOMS ((FNS CPN.ADD.NEWPRINTER CPN.BUILD.SUBMENU CPN.CHANGE.DEFAULTPRINTER
CPN.FETCH.DEFAULTPRINTER CPN.GET.NEW.PRINTER CPN.GET.PRINTER
CPN.GET.PRINTERMENU CPN.INIT CPN.PARSE.PRINTER.LIST CPN.SET.PRINTER
CPN.SET.DEFAULTPRINTINGHOST)
(* will initialize CPN.PRINTER.LIST to the value of DEFAULTPRINTINGHOST
unless it has already has a value)
(INITVARS (CPN.PRINTER.LIST (COPY DEFAULTPRINTINGHOST)))
[VARS (CPN.PRINTER.MENU)
(CPN.EXAMPLE.PRINTER.LIST (QUOTE ((Rover (QUOTE Rover)
"A&E 1st floor PRESS printer")
(Emperor (QUOTE Emperor)
"A&E 2nd floor PRESS printer")
(Thud (QUOTE Thud)
"A&E 3rd floor PRESS printer")
("Moe:El Segundo:Xerox"
"Moe:El Segundo:Xerox"
"A&E 1st floor INTERPRESS printer")
("Curly:El Segundo:Xerox"
"Curly:El Segundo:Xerox"
"A&E 2nd floor INTERPRESS printer")
("Larry:El Segundo:Xerox"
(QUOTE Larry:El% Segundo)
"A&E 3rd floor INTERPRESS printer"]
(P (CPN.INIT T))))
(DEFINEQ
(CPN.ADD.NEWPRINTER
[LAMBDA (NEW.PRINTER) (* TBigham " 2-Dec-85 07:48")
(* * adds a new printer to DEFAULTPRINTINGHOST and CPN.PRINTER.LIST)
(DECLARE (GLOBALVARS CPN.PRINTER.LIST DEFAULTPRINTINGHOST))
(LET ((DPH (U-CASE DEFAULTPRINTINGHOST)))
(SETQ NEW.PRINTER (U-CASE NEW.PRINTER))
(if [AND (NOT (MEMBER NEW.PRINTER DPH))
(NULL (for P inside DPH thereis (AND (LISTP P)
(if (EQ NEW.PRINTER
(CADR P]
then (if (ATOM DEFAULTPRINTINGHOST)
then (SETQ DEFAULTPRINTINGHOST (LIST DEFAULTPRINTINGHOST)))
(if (ATOM CPN.PRINTER.LIST)
then (SETQ CPN.PRINTER.LIST (LIST CPN.PRINTER.LIST)))
(SETQ DEFAULTPRINTINGHOST (ATTACH NEW.PRINTER DEFAULTPRINTINGHOST))
(SETQ CPN.PRINTER.LIST (ATTACH NEW.PRINTER CPN.PRINTER.LIST])
(CPN.BUILD.SUBMENU
[LAMBDA (ITEMS) (* TBigham "12-Dec-85 16:35")
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands))
(PROG (BACKGROUND.LIST OLD.LIST)
(if ITEMS
then [SETQ BACKGROUND.LIST
(LIST " Change Printer " (QUOTE (CPN.GET.PRINTER))
"Change primary printer"
(ATTACH (QUOTE SUBITEMS)
(for EACH inside ITEMS bind RV
collect (if (LISTP EACH)
then (SETQ RV (CADR EACH))
(if (STRINGP RV)
then
(LIST (CAR EACH)
(ATTACH
(QUOTE
CPN.SET.PRINTER)
(LIST RV))
(CADDR EACH))
else
(SUBST (ATTACH
(QUOTE
CPN.SET.PRINTER)
(LIST RV))
RV EACH))
else (LIST EACH (LIST (QUOTE
CPN.SET.PRINTER)
(KWOTE EACH]
[if (SETQ OLD.LIST (SASSOC " Change Printer " BackgroundMenuCommands))
then (DSUBST BACKGROUND.LIST OLD.LIST BackgroundMenuCommands)
else (SETQ BackgroundMenuCommands (REVERSE (ATTACH BACKGROUND.LIST
(REVERSE
BackgroundMenuCommands]
(SETQ BackgroundMenu])
(CPN.CHANGE.DEFAULTPRINTER
[LAMBDA (PRINTER DEFAULTPRINTER) (* TBigham "12-Dec-85 12:18")
(* * moves the selected printer to the front of the DEFAULTPRINTINGHOST list to make it the default printer and
sets the DEFAULTPRINTERTYPE)
(DECLARE (GLOBALVARS DEFAULTPRINTERTYPE DEFAULTPRINTINGHOST))
(LET ((NEW.PRINTER (U-CASE PRINTER))) (* for ease of comparison, make everything caps)
(SETQ DEFAULTPRINTINGHOST (U-CASE DEFAULTPRINTINGHOST))
(if (NEQ NEW.PRINTER DEFAULTPRINTER)
then (* if the selected printer isn't the default printer
then make it so)
(if (MEMBER NEW.PRINTER DEFAULTPRINTINGHOST)
then (* the new printer is an atom and a member of
DEFAULTPRINTINGHOST)
(SETQ DEFAULTPRINTINGHOST (ATTACH NEW.PRINTER (REMOVE
NEW.PRINTER
DEFAULTPRINTINGHOST)))
(SETQ DEFAULTPRINTERTYPE (PRINTERTYPE NEW.PRINTER))
(PROMPTPRINT "Default printer changed to " NEW.PRINTER)
else (* for the case where the printer is in the standard
Interlisp-D menu item format of
(seen.text returned.value prompt.message))
(for PRINTER inside DEFAULTPRINTINGHOST
do (if (AND (LISTP PRINTER)
(EQUAL (CADR PRINTER)
NEW.PRINTER))
then (SETQ DEFAULTPRINTINGHOST (ATTACH PRINTER
(REMOVE
PRINTER
DEFAULTPRINTINGHOST)))
(SETQ DEFAULTPRINTERTYPE (PRINTERTYPE NEW.PRINTER)
)
(PROMPTPRINT "Default printer changed to "
(CADR PRINTER])
(CPN.FETCH.DEFAULTPRINTER
[LAMBDA NIL (* TBigham " 3-Apr-85 15:12")
(* now accounts for the case where elemets in the
DEFAULTPRINTINGHOST list may be a list themseleves
e.g. ((FULLPRESS JEDI) Quake Expresso:))
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST))
(if (LISTP DEFAULTPRINTINGHOST)
then (if (LISTP (CAR DEFAULTPRINTINGHOST))
then (CADR (CAR DEFAULTPRINTINGHOST))
else (CAR DEFAULTPRINTINGHOST))
else DEFAULTPRINTINGHOST])
(CPN.GET.NEW.PRINTER
[LAMBDA (PROMPTSTRING) (* TBigham " 2-Dec-85 07:48")
(DECLARE (GLOBALVARS LASTMOUSEX LASTMOUSEY))
(LET* ((FONT (DEFAULTFONT))
[WIDTH (IPLUS (STRINGWIDTH PROMPTSTRING FONT)
(ITIMES 40 (CHARWIDTH (CHARCODE A)
FONT]
(PROMPTW (CREATEW [MAKEWITHINREGION (CREATEREGION LASTMOUSEX LASTMOUSEY
(WIDTHIFWINDOW WIDTH)
(HEIGHTIFWINDOW
(FONTPROP FONT (QUOTE HEIGHT]
NIL NIL T)))
(RESETLST (RESETSAVE (OPENW PROMPTW)
(BQUOTE (CLOSEW , PROMPTW)))
(MKATOM (PROMPTFORWORD PROMPTSTRING NIL NIL PROMPTW NIL NIL (CHARCODE
EOL])
(CPN.GET.PRINTER
[LAMBDA NIL (* TBigham "12-Dec-85 14:58")
(* * acquires a printer name from the value of DEFAULTPRINTINGHOST and moves it to the front of the list.
If a new name is entered, it's added to the value of DEFAULTPRINTINGHOST)
(PROG (PRINTERCHOICE (CPN.MENU (CPN.GET.PRINTERMENU)))
(if (type? MENU CPN.MENU)
then (SETQ PRINTERCHOICE (U-CASE (MENU CPN.MENU)))
(CPN.SET.PRINTER PRINTERCHOICE])
(CPN.GET.PRINTERMENU
[LAMBDA (RESET.MENU) (* TBigham "12-Dec-85 13:02")
(* * either returns the cached menu or creates a new menu of items from the value of CPN.PRINTER.LIST)
(DECLARE (GLOBALVARS CPN.PRINTER.LIST CPN.PRINTER.MENU PROMPTWINDOW))
(LET (FULL.PRINTER.LIST ITEMS)
(if (OR RESET.MENU (NULL CPN.PRINTER.MENU))
then (if (SETQ FULL.PRINTER.LIST (CPN.PARSE.PRINTER.LIST CPN.PRINTER.LIST))
then [SETQ ITEMS (APPEND FULL.PRINTER.LIST
(LIST (LIST "Other..."
(KWOTE (QUOTE OTHER))
"You will be prompted for a printer"]
(CPN.BUILD.SUBMENU ITEMS)
(SETQ CPN.PRINTER.MENU (create MENU
ITEMS ← ITEMS
CENTERFLG ← T))
else (printout PROMPTWINDOW T "CPN.PRINTER.LIST does not have any values.")
(printout PROMPTWINDOW T " Call (CPN.INIT 'EXAMPLE) for a test case."))
else CPN.PRINTER.MENU])
(CPN.INIT
[LAMBDA (USE.CPN.PRINTER.LIST) (* TBigham " 2-Dec-85 08:14")
(DECLARE (GLOBALVARS CPN.EXAMPLE.PRINTER.LIST CPN.PRINTER.LIST CPN.PRINTER.MENU
DEFAULTPRINTINGHOST))
(PROGN (if (EQ USE.CPN.PRINTER.LIST (QUOTE EXAMPLE))
then (SETQ CPN.PRINTER.LIST (COPY CPN.EXAMPLE.PRINTER.LIST))
(CPN.SET.DEFAULTPRINTINGHOST)
elseif USE.CPN.PRINTER.LIST
then (CPN.SET.DEFAULTPRINTINGHOST)
else (SETQ CPN.PRINTER.LIST (COPY DEFAULTPRINTINGHOST))
(CPN.SET.DEFAULTPRINTINGHOST))
(SETQ CPN.PRINTER.MENU)
(CPN.GET.PRINTERMENU T])
(CPN.PARSE.PRINTER.LIST
[LAMBDA (ALL.PRINTERS) (* TBigham "12-Dec-85 12:01")
(* * parses any legal form of items in DEFAULTPRINTINGOST and items in CPN.PRINTER.LIST)
(for PRINTER inside ALL.PRINTERS collect (if (LISTP PRINTER)
then (if (FMEMB (CAR PRINTER)
(QUOTE (FULLPRESS
INTERPRESS
PRESS)))
then (CADR PRINTER)
else PRINTER)
else PRINTER])
(CPN.SET.PRINTER
[LAMBDA (PRINTERCHOICE) (* TBigham "12-Dec-85 17:27")
(DECLARE (GLOBALVARS CPN.PRINTER.LIST CPN.PRINTER.MENU DEFAULTPRINTERTYPE))
(PROG [(DEFAULTPRINTER (U-CASE (CPN.FETCH.DEFAULTPRINTER]
(SETQ PRINTERCHOICE (U-CASE PRINTERCHOICE))
(if (EQ PRINTERCHOICE (QUOTE OTHER))
then (SETQ PRINTERCHOICE (U-CASE (CPN.GET.NEW.PRINTER
"Printer (CR to abort): ")))
(SETQ CPN.PRINTER.MENU))
(if PRINTERCHOICE
then (if (NEQ DEFAULTPRINTER PRINTERCHOICE)
then (CPN.ADD.NEWPRINTER PRINTERCHOICE)
(CPN.CHANGE.DEFAULTPRINTER PRINTERCHOICE DEFAULTPRINTER)
[CPN.BUILD.SUBMENU (APPEND (CPN.PARSE.PRINTER.LIST
CPN.PRINTER.LIST)
(LIST (LIST "Other..."
(KWOTE
(QUOTE OTHER))
"You will be prompted for a printer"]
else (PROMPTPRINT "Default printer is " DEFAULTPRINTER)))
(SETQ DEFAULTPRINTERTYPE (if (STRPOS ":" PRINTERCHOICE)
then (QUOTE INTERPRESS)
else (QUOTE PRESS])
(CPN.SET.DEFAULTPRINTINGHOST
[LAMBDA NIL (* TBigham " 1-Dec-85 16:00")
(DECLARE (GLOBALVARS CPN.PRINTER.LIST DEFAULTPRINTERTYPE DEFAULTPRINTINGHOST))
(PROGN [SETQ DEFAULTPRINTINGHOST (for PRINTER inside CPN.PRINTER.LIST
collect (if (OR (ATOM PRINTER)
(STRINGP PRINTER))
then PRINTER
elseif (MEMBER (CAR PRINTER)
(QUOTE (FULLPRESS PRESS
INTERPRESS)))
then PRINTER
else (CAR PRINTER]
(SETQ DEFAULTPRINTERTYPE (PRINTERTYPE (CPN.FETCH.DEFAULTPRINTER])
)
(* will initialize CPN.PRINTER.LIST to the value of DEFAULTPRINTINGHOST unless it has already
has a value)
(RPAQ? CPN.PRINTER.LIST (COPY DEFAULTPRINTINGHOST))
(RPAQQ CPN.PRINTER.MENU NIL)
(RPAQQ CPN.EXAMPLE.PRINTER.LIST ((Rover (QUOTE Rover)
"A&E 1st floor PRESS printer")
(Emperor (QUOTE Emperor)
"A&E 2nd floor PRESS printer")
(Thud (QUOTE Thud)
"A&E 3rd floor PRESS printer")
("Moe:El Segundo:Xerox" "Moe:El Segundo:Xerox"
"A&E 1st floor INTERPRESS printer")
("Curly:El Segundo:Xerox" "Curly:El Segundo:Xerox"
"A&E 2nd floor INTERPRESS printer")
("Larry:El Segundo:Xerox" (QUOTE Larry:El% Segundo)
"A&E 3rd floor INTERPRESS printer")))
(CPN.INIT T)
(PUTPROPS CHANGEPRINTER COPYRIGHT ("TBigham, Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1566 12136 (CPN.ADD.NEWPRINTER 1576 . 2566) (CPN.BUILD.SUBMENU 2568 . 3998) (
CPN.CHANGE.DEFAULTPRINTER 4000 . 5922) (CPN.FETCH.DEFAULTPRINTER 5924 . 6583) (CPN.GET.NEW.PRINTER
6585 . 7363) (CPN.GET.PRINTER 7365 . 7905) (CPN.GET.PRINTERMENU 7907 . 8984) (CPN.INIT 8986 . 9677) (
CPN.PARSE.PRINTER.LIST 9679 . 10224) (CPN.SET.PRINTER 10226 . 11445) (CPN.SET.DEFAULTPRINTINGHOST
11447 . 12134)))))
STOP