(FILECREATED "17-Oct-84 16:37:27" {DSK}TRI-HARDCOPY.;3 18063
previous date: " 5-Sep-84 17:03:52" {DSK}TRI-HARDCOPY.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TRI-HARDCOPYCOMS)
(RPAQQ TRI-HARDCOPYCOMS ((* * Functions for Automated Trillium Hardcopy)
(FNS FIND.PRINTSERVER.NAME FIND.PRINTSERVER.TYPE GET.HARDCOPY.CONFIRM.MENU GET.WINDOW.EXTENT
HARDCOPY.ABORT.CLEANUP HARDCOPY.ABORT.FROMMENU HARDCOPY.ACQUIRE.FRAME.LIST
HARDCOPY.BACKBONE HARDCOPY.BACKGROUND.COMMAND HARDCOPY.CHECK.PRINTSERVER
HARDCOPY.DEFINE.SECTIONS HARDCOPY.FRAME HARDCOPY.INTERFACE HARDCOPY.INTERFACE.CONFIRM
HARDCOPY.LOOP.THRU.FRAMES HARDCOPY.METHOD HARDCOPY.SECTIONS HARDCOPY.SETUP
HARDCOPY.SETUP.ABORTVARS HARDCOPY.TEST.TIMEOUT HARDCOPY.TIMEOUT.EXCESSIVE
HARDCOPY.WINDOW)
(* * This adds Hardcopy.Window to the BackGroundMenu for hardcopy of lisp windows)
(FNS HARDCOPY.SETUP.BACKGROUND.MENU)
(INITVARS (MICASPERINCH 2540)
(HARDCOPY.CONFIRM.MENU)
(PRINTSERVER)
(PRINTERTYPE)
(DEFAULT.HARDCOPY.FILENAME (QUOTE TRILLIUM-HARDCOPY.SCRATCH))
(HARDCOPY.ABORT.REGION (QUOTE (606 632 301 169)))
(HARDCOPY.ABORTED)
(HARDCOPY.ABORT.MENU)
(HARDCOPY.TRACEFLG))
(P (HARDCOPY.SETUP.BACKGROUND.MENU))))
(* * Functions for Automated Trillium Hardcopy)
(DEFINEQ
(FIND.PRINTSERVER.NAME
[LAMBDA NIL (* HaKo " 8-Aug-84 13:35")
(* trb " 5-Jul-84 11:03")
(* Takes the value of DEFAULTPRINTINGHOST as the PRINTSERVER if it is an ATOM. If DEFAULTPRINTINGHOST is a list,
then the first element in the list is taken)
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST))
(if (LISTP DEFAULTPRINTINGHOST)
then (CAR DEFAULTPRINTINGHOST)
else DEFAULTPRINTINGHOST])
(FIND.PRINTSERVER.TYPE
[LAMBDA (PRINTSERVER) (* HaKo " 8-Aug-84 13:36")
(* Very simple way to determine the type of printer. If the PRINTSERVER has a colon in it, then return INTERPRESS,
otherwise return PRESS. See, I told you it was simple. Eventually I will expand this to do all the right kind of
things. -- tim)
(if (STRPOS ":" PRINTSERVER)
then (QUOTE INTERPRESS)
else (QUOTE PRESS])
(GET.HARDCOPY.CONFIRM.MENU
[LAMBDA NIL (* trb " 5-Jul-84 13:55")
(DECLARE (GLOBALVARS HARDCOPY.CONFIRM.MENU))
(OR HARDCOPY.CONFIRM.MENU (SETQ HARDCOPY.CONFIRM.MENU (create MENU
TITLE ← "Proceed with HARDCOPY?"
ITEMS ←[QUOTE
((Yes (QUOTE Y))
(No (QUOTE N))
(" " NIL)
("Edit Frame List"
(QUOTE E))
("Show Frame List"
(QUOTE S]
CENTERFLG ← T])
(GET.WINDOW.EXTENT
[LAMBDA (W) (* HaKo " 8-Aug-84 13:05")
(* trb "13-Jul-84 13:04")
(* * Returns the EXTENT of a of the window if it has one. Otrherwise returns the region of the current Trillium
interface)
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(OR (WINDOWPROP W (QUOTE EXTENT))
(GET.FIELDQ CURRENT.INTERFACE REGION INTERFACE])
(HARDCOPY.ABORT.CLEANUP
[LAMBDA NIL (* HaKo " 8-Aug-84 13:37")
(* trb "12-Jul-84 14:14")
(DECLARE (GLOBALVARS HARDCOPY.ABORT.MENU))
(DELETEMENU HARDCOPY.ABORT.MENU T)
(SETQ HARDCOPY.ABORT.MENU NIL)
T])
(HARDCOPY.ABORT.FROMMENU
[LAMBDA (ITEM MENU BUTTON) (* HaKo " 8-Aug-84 13:38")
(* trb "12-Jul-84 13:40")
(DECLARE (GLOBALVARS GRAYSHADE HARDCOPY.ABORT.MENU HARDCOPY.ABORTED))
(if (EQ BUTTON (QUOTE LEFT))
then (SHADEITEM (QUOTE ABORT)
MENU GRAYSHADE)
(SETQ HARDCOPY.ABORT.MENU MENU)
(SETQ HARDCOPY.ABORTED T])
(HARDCOPY.ACQUIRE.FRAME.LIST
[LAMBDA (FRAMES) (* HaKo " 8-Aug-84 13:39")
(* trb " 3-Jul-84 14:24")
(* * This will eventually have to take a frame CLASS as an argument so that the entire class can be hardcopied
without having to specify eah one)
(if FRAMES
then (ACQUIRE.LIST.ITEMS (for FRAME.NAME in FRAMES collect (GET.FIELDQ FRAME.NAME NAME))
"Choose Frames to be Hardcopied"])
(HARDCOPY.BACKBONE
[LAMBDA (WINDOW FILE) (* HaKo "16-Aug-84 15:01")
(* trb "13-Jul-84 07:00")
(* this function has a multiple personality in that I want it to be compatible with the current Interlisp release
as well as take full advantage of the newer releases. For example, in the upcoming release HARDCOPYW has a
PRINTERTYPRE argument, very useful)
(DECLARE (GLOBALVARS HARDCOPY.ABORT.WINDOW HARDCOPY.ABORTED HARDCOPY.TRACEFLG PRINTERTYPE
PRINTSERVER))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Computing hardcopy...")
[COND
((EQ PRINTERTYPE (QUOTE PRESS))
(if HARDCOPY.TRACEFLG
then (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Computing HARDCOPYW in PRESS mode"))
(SETQ FILE (HARDCOPYW WINDOW FILE NIL NIL NIL PRINTERTYPE)))
(T (if HARDCOPY.TRACEFLG
then (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Computing HARDCOPYW in INTERPRESS mode"))
(SETQ FILE (HARDCOPYW WINDOW FILE NIL NIL NIL PRINTERTYPE]
(HARDCOPY.TEST.TIMEOUT)
(COND
(HARDCOPY.ABORTED (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Hardcopy aborted. Check the status of "
FILE)
(SETQ HARDCOPY.ABORTED NIL))
(T (SETQ HARDCOPY.ABORT.WINDOW NIL)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Sending hardcopy to " PRINTSERVER ".")
(AND HARDCOPY.TRACEFLG (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "EMPRESSing hardcopy to "
PRINTSERVER))
(EMPRESS FILE 1 PRINTSERVER " ")
(if HARDCOPY.TRACEFLG
then (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "DELETING hardcopy file " FILE))
(DELFILE FILE])
(HARDCOPY.BACKGROUND.COMMAND
[LAMBDA NIL (* HaKo "13-Aug-84 14:39")
(MENU (create MENU
TITLE ← "Hardcopy:"
CENTERFLG ← T
ITEMS ←(QUOTE ((region (HARDCOPYW)
"Send hardcopy of screen region to printer.")
(window (HARDCOPY.WINDOW)
"Send hardcopy of a window to printer."])
(HARDCOPY.CHECK.PRINTSERVER
[LAMBDA NIL (* PH " 5-Sep-84 16:38")
(* HaKo "16-Aug-84 15:01")
(DECLARE (GLOBALVARS HARDCOPY.TRACEFLG PRINTER.STATUS PRINTERTYPE PRINTSERVER))
(SELECTQ PRINTERTYPE
[PRESS (SETQ PRINTER.STATUS (PRINTERSTATUS PRINTSERVER))
(if HARDCOPY.TRACEFLG
then (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "PRINTER.STATUS " PRINTER.STATUS))
(TRILLIUM.PRINTOUT (CDR PRINTER.STATUS))
(AND PRINTER.STATUS (IEQP 2 (CAR PRINTER.STATUS]
[INTERPRESS [SETQ PRINTER.STATUS (CAR (NLSETQ (NSPRINTER.STATUS PRINTSERVER]
(if HARDCOPY.TRACEFLG
then (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "PRINTER.STATUS "
PRINTER.STATUS))
(for ASPECT in (QUOTE (SPOOLER FORMATTER PRINTER))
always (EQ (CADR (ASSOC ASPECT PRINTER.STATUS))
(QUOTE AVAILABLE]
(SHOULDNT])
(HARDCOPY.DEFINE.SECTIONS
[LAMBDA (W) (* HaKo " 8-Aug-84 13:54")
(* trb "13-Jul-84 06:36")
(* * To move a window about the size of Manhanttan within a user defined REGION for HARDCOPYW.
It is assumed that the purpose of these hardcopies is to cut-and-paste them to make a real-to-life representation
of the windows' contents)
(PROG (REGION EXTENT RULEX RULEY STEPX STEPY NX NY)
(TRILLIUM.PRINTOUT "Specify the shape of the hardcopy sections" T)
(SETQ REGION (GETREGION))
(SETQ W (SHAPEW W REGION))
(SETQ EXTENT (GET.WINDOW.EXTENT W))
(SETQ RULEX (CADDR EXTENT))
(SETQ RULEY (CADDDR EXTENT))
(SETQ STEPX (CADDR REGION))
(SETQ STEPY (CADDDR REGION))
(SETQ NX (IQUOTIENT RULEX STEPX))
(SETQ NY (IQUOTIENT RULEY STEPY))
(RETURN (LIST W STEPX STEPY NX NY])
(HARDCOPY.FRAME
[LAMBDA (FRAME) (* HaKo "13-Aug-84 14:50")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW DEFAULT.HARDCOPY.FILENAME))
(PROG (FILE CUT CUT.SPECS)
(COND
((NULL FRAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Hardcopy of frame aborted.")
(RETURN)))
(SETQ CUT (CONFIRM "Hardcopy in sections?"))
(HARDCOPY.SETUP)
(SETQ FILE DEFAULT.HARDCOPY.FILENAME)
(AND CUT (SETQ CUT.SPECS (HARDCOPY.DEFINE.SECTIONS CURRENT.INTERFACE.WINDOW)))
(COND
(CUT.SPECS (HARDCOPY.SECTIONS CUT.SPECS FILE))
(T (HARDCOPY.BACKBONE CURRENT.INTERFACE.WINDOW FILE])
(HARDCOPY.INTERFACE
[LAMBDA (INTERFACE) (* HaKo "16-Aug-84 15:01")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW HARDCOPY.TRACEFLG))
(PROG (FRAMES FRAME.NAMES FILE CUT CUT.SPECS)
(COND
((NULL INTERFACE)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Hardcopy of interface aborted.")
(RETURN)))
(SETQ CUT (CONFIRM "Hardcopy in sections?"))
(AND HARDCOPY.TRACEFLG (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Starting hardcopy..."
(DATE)))
(HARDCOPY.SETUP)
(AND CUT (SETQ CUT.SPECS (HARDCOPY.DEFINE.SECTIONS CURRENT.INTERFACE.WINDOW)))
(SETQ FRAMES (GET.FIELDQ INTERFACE FRAMES))
(SETQ FRAME.NAMES (HARDCOPY.ACQUIRE.FRAME.LIST FRAMES))
(AND (HARDCOPY.INTERFACE.CONFIRM INTERFACE FRAMES FRAME.NAMES)
(HARDCOPY.LOOP.THRU.FRAMES INTERFACE FRAME.NAMES CUT.SPECS)
(AND HARDCOPY.TRACEFLG (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Finishing hardcopy..."
(DATE])
(HARDCOPY.INTERFACE.CONFIRM
[LAMBDA (INTERFACE FRAMES FRAME.NAMES) (* HaKo "16-Aug-84 16:19")
(* trb " 5-Jul-84 14:35")
(TRILLIUM.CLEAR.ALL.PROMPTING)
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS T "There are " (FLENGTH FRAME.NAMES)
" frames in interface "
(GET.FIELDQ INTERFACE NAME)
" to be hardcopied." T T)
(do (SELECTQ (MENU (GET.HARDCOPY.CONFIRM.MENU))
(NIL)
(Y (RETURN T))
(N (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Hardcopy of interface aborted.")
(RETURN NIL))
(E (EDITE FRAME.NAMES))
(S (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS T 5 FRAME.NAMES T T))
(SHOULDNT])
(HARDCOPY.LOOP.THRU.FRAMES
[LAMBDA (INTERFACE FRAME.NAMES CUT.SPECS) (* HaKo " 8-Aug-84 13:17")
(* trb " 8-Jul-84 20:49")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW DEFAULT.HARDCOPY.FILENAME))
(for FRAME.NAME in FRAME.NAMES bind (FRAME (FILE ← DEFAULT.HARDCOPY.FILENAME))
when (SETQ FRAME (FIND.FRAME INTERFACE FRAME.NAME))
do (FRAME.DO.PUSH FRAME)
(START.FRAME FRAME)
(COND
(CUT.SPECS (HARDCOPY.SECTIONS CUT.SPECS FILE))
(T (HARDCOPY.BACKBONE CURRENT.INTERFACE.WINDOW FILE])
(HARDCOPY.METHOD
[LAMBDA NIL (* HaKo " 8-Aug-84 13:57")
(* trb " 3-Jul-84 11:54")
(DECLARE (GLOBALVARS HARDCOPY.METHOD.MENU))
(MENU (OR HARDCOPY.METHOD.MENU (SETQ HARDCOPY.METHOD.MENU (create MENU
TITLE ← "Hardcopy Method"
ITEMS ←[QUOTE
(("Entire Interface "
(QUOTE ALL))
("Entire Category "
(QUOTE CAT))
("Single Frame "
(QUOTE ONE))
(" " NIL)
("DONE " (QUOTE OK]
CENTERFLG ← T])
(HARDCOPY.SECTIONS
[LAMBDA (CUT.SPECS FILE) (* trb " 8-Jul-84 20:47")
(PROG (FLAG W STEPX STEPY NX NY)
(SETQ FLAG T)
(SETQ W (CAR CUT.SPECS))
(SETQ STEPX (CADR CUT.SPECS))
(SETQ STEPY (CADDR CUT.SPECS))
(SETQ NX (CADDDR CUT.SPECS))
(SETQ NY (CAR (LAST CUT.SPECS)))
(from 0 to NY
do [from 1 to NX
do (HARDCOPY.BACKBONE W FILE)
(COND
(FLAG (SCROLLW W (IMINUS STEPX)
0))
(T (SCROLLW W STEPX 0]
(SETQ FLAG (NOT FLAG))
(HARDCOPY.BACKBONE W FILE)
(SCROLLW W 0 (IMINUS STEPY])
(HARDCOPY.SETUP
[LAMBDA NIL (* trb "13-Jul-84 06:35")
(DECLARE (GLOBALVARS PRINTERTYPE PRINTSERVER))
(PROG NIL
(SETQ PRINTSERVER (FIND.PRINTSERVER.NAME))
(SETQ PRINTERTYPE (FIND.PRINTSERVER.TYPE PRINTSERVER])
(HARDCOPY.SETUP.ABORTVARS
[LAMBDA NIL (* HaKo " 8-Aug-84 13:58")
(DECLARE (GLOBALVARS HARDCOPY.ABORT.MENU HARDCOPY.ABORT.WINDOW HARDCOPY.ABORTED))
(SETQ HARDCOPY.ABORT.WINDOW NIL)
(SETQ HARDCOPY.ABORT.MENU NIL)
(SETQ HARDCOPY.ABORTED NIL])
(HARDCOPY.TEST.TIMEOUT
[LAMBDA NIL (* HaKo " 8-Aug-84 14:05")
(* trb "12-Jul-84 14:31")
(DECLARE (GLOBALVARS HARDCOPY.ABORT.WINDOW HARDCOPY.ABORTED))
(HARDCOPY.SETUP.ABORTVARS)
(for k from 1 until (OR HARDCOPY.ABORTED (HARDCOPY.CHECK.PRINTSERVER))
do (if (ZEROP (IREMAINDER k 3))
then (HARDCOPY.TIMEOUT.EXCESSIVE)))
(if HARDCOPY.ABORT.WINDOW
then (CLOSEW HARDCOPY.ABORT.WINDOW))
(if HARDCOPY.ABORTED
then (HARDCOPY.ABORT.CLEANUP))
HARDCOPY.ABORTED])
(HARDCOPY.TIMEOUT.EXCESSIVE
[LAMBDA NIL (* HaKo "16-Aug-84 15:03")
(* trb "12-Jul-84 16:49")
(DECLARE (GLOBALVARS HARDCOPY.ABORT.REGION HARDCOPY.ABORT.WINDOW HARDCOPY.TRACEFLG PRINTSERVER))
(PROG (W M P)
(COND
(HARDCOPY.ABORT.WINDOW (TOTOPW HARDCOPY.ABORT.WINDOW)
(AND HARDCOPY.TRACEFLG (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE
"Putting Abort window to top again.")))
(T (SETQ W (CREATEW HARDCOPY.ABORT.REGION (CONCAT "Abort Window for " PRINTSERVER)))
(SETQ M (create MENU
ITEMS ←(QUOTE (ABORT))
WHENSELECTEDFN ←(FUNCTION HARDCOPY.ABORT.FROMMENU)))
(SETQ P (create POSITION
XCOORD ←(IQUOTIENT (IDIFFERENCE (WINDOWPROP W (QUOTE WIDTH))
(STRINGWIDTH (QUOTE ABORT)
(fetch (MENU MENUFONT)
of M)))
2)
YCOORD ← 10))
(printout W PRINTSERVER "is not responding.")
(printout W T T "....will keep trying." T)
(printout W T "If you do not wish to wait for the ")
(printout W T "printer to become available, you can ")
(printout W T "abort the connection by clicking ABORT")
(ADDMENU M W P)
(SETQ HARDCOPY.ABORT.WINDOW W])
(HARDCOPY.WINDOW
[LAMBDA NIL (* HaKo "13-Aug-84 14:51")
(DECLARE (GLOBALVARS DEFAULT.HARDCOPY.FILENAME))
(PROG (W CUT CUT.SPECS FILE)
(TRILLIUM.PRINTOUT "Click left button on window to be printed...")
(SETQ W (WHICHW (GETPOSITION)))
(COND
((NULL W)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Hardcopy aborted")
(RETURN)))
(SETQ CUT (CONFIRM "Hardcopy in Sections?"))
(SETQ FILE DEFAULT.HARDCOPY.FILENAME)
(HARDCOPY.SETUP)
(AND CUT (SETQ CUT.SPECS (HARDCOPY.DEFINE.SECTIONS W)))
(COND
(CUT.SPECS (HARDCOPY.SECTIONS CUT.SPECS FILE))
(T (HARDCOPY.BACKBONE W FILE])
)
(* * This adds Hardcopy.Window to the BackGroundMenu for hardcopy of lisp windows)
(DEFINEQ
(HARDCOPY.SETUP.BACKGROUND.MENU
[LAMBDA NIL (* HaKo "13-Aug-84 14:45")
(* a general window printing hook)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands))
(PROG [(OldHardcopyCmd (FASSOC (QUOTE Hardcopy)
BackgroundMenuCommands))
(NewHardcopyCmd (QUOTE (Hardcopy (QUOTE (HARDCOPY.BACKGROUND.COMMAND))
"To print a window or screen region."]
(if OldHardcopyCmd
then (DSUBST NewHardcopyCmd OldHardcopyCmd BackgroundMenuCommands)
else (NCONC1 BackgroundMenuCommands NewHardcopyCmd))
(SETQ BackgroundMenu])
)
(RPAQ? MICASPERINCH 2540)
(RPAQ? HARDCOPY.CONFIRM.MENU )
(RPAQ? PRINTSERVER )
(RPAQ? PRINTERTYPE )
(RPAQ? DEFAULT.HARDCOPY.FILENAME (QUOTE TRILLIUM-HARDCOPY.SCRATCH))
(RPAQ? HARDCOPY.ABORT.REGION (QUOTE (606 632 301 169)))
(RPAQ? HARDCOPY.ABORTED )
(RPAQ? HARDCOPY.ABORT.MENU )
(RPAQ? HARDCOPY.TRACEFLG )
(HARDCOPY.SETUP.BACKGROUND.MENU)
(PUTPROPS TRI-HARDCOPY COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1356 16782 (FIND.PRINTSERVER.NAME 1366 . 1922) (FIND.PRINTSERVER.TYPE 1924 . 2414) (
GET.HARDCOPY.CONFIRM.MENU 2416 . 2945) (GET.WINDOW.EXTENT 2947 . 3437) (HARDCOPY.ABORT.CLEANUP 3439 .
3782) (HARDCOPY.ABORT.FROMMENU 3784 . 4235) (HARDCOPY.ACQUIRE.FRAME.LIST 4237 . 4788) (
HARDCOPY.BACKBONE 4790 . 6487) (HARDCOPY.BACKGROUND.COMMAND 6489 . 6858) (HARDCOPY.CHECK.PRINTSERVER
6860 . 7850) (HARDCOPY.DEFINE.SECTIONS 7852 . 8875) (HARDCOPY.FRAME 8877 . 9593) (HARDCOPY.INTERFACE
9595 . 10644) (HARDCOPY.INTERFACE.CONFIRM 10646 . 11386) (HARDCOPY.LOOP.THRU.FRAMES 11388 . 12028) (
HARDCOPY.METHOD 12030 . 12682) (HARDCOPY.SECTIONS 12684 . 13345) (HARDCOPY.SETUP 13347 . 13652) (
HARDCOPY.SETUP.ABORTVARS 13654 . 13970) (HARDCOPY.TEST.TIMEOUT 13972 . 14643) (
HARDCOPY.TIMEOUT.EXCESSIVE 14645 . 16025) (HARDCOPY.WINDOW 16027 . 16780)) (16872 17597 (
HARDCOPY.SETUP.BACKGROUND.MENU 16882 . 17595)))))
STOP