(FILECREATED " 1-Apr-85 13:53:39" {ICE}<TRILLIUM>BIRTHDAY84>SOURCES>FIXES>TRI-FIX-HARDCOPY.;2 33594
changes to: (FNS HARDCOPY.SCREEN HARDCOPY.DEFINE.SECTIONS HARDCOPY.LOOP.THRU.FRAMES
HARDCOPY.SECTIONS HARDCOPY.INTERFACE HARDCOPY.INTERFACE!Original
HARDCOPY.LOOP.THRU.FRAMES!Original)
(VARS TRI-FIX-HARDCOPYCOMS)
previous date: "29-Mar-85 15:51:02" {ICE}<INGALLS>LISP>TRI-FIX-HARDCOPY.;5)
(PRETTYCOMPRINT TRI-FIX-HARDCOPYCOMS)
(RPAQQ TRI-FIX-HARDCOPYCOMS ((* * From TRBs HardcopyEnhancement pkg. Possibly edited.)
(FNS HARDCOPYW HARDCOPY.SCREEN FIND.PRINTSERVER.NAME)
(* * This version is new. Now has "whole screen" included on the sub menu)
(FNS HARDCOPY.BACKGROUND.COMMAND HARDCOPY.BACKGROUND.COMMAND!Original)
(* * From DAIs Tri-Fix-Ingalls for hardcopy pkg. Edited.)
(FNS HARDCOPY.BACKBONE HARDCOPY.BACKBONE!Original HARDCOPY.CHECK.PRINTSERVER
HARDCOPY.CHECK.PRINTSERVER!Original HARDCOPY.DEFINE.SECTIONS
HARDCOPY.DEFINE.SECTIONS!Original HARDCOPY.INTERFACE HARDCOPY.INTERFACE!Original
HARDCOPY.LOOP.THRU.FRAMES HARDCOPY.LOOP.THRU.FRAMES!Original HARDCOPY.SECTIONS
HARDCOPY.SECTIONS!Original HARDCOPY.TEST.TIMEOUT HARDCOPY.TEST.TIMEOUT!Original
HARDCOPY.TIMEOUT.EXCESSIVE HARDCOPY.TIMEOUT.EXCESSIVE!Original HARDCOPY.WINDOW
HARDCOPY.WINDOW!Original)
(* * New function)
(FNS HARDCOPY.WINDOW.SECTIONABLE?)
(* * New functions. Uses the Lispusers package StyleSheet)
(FNS HARDCOPY.GET.SELECTION.STYLE.SHEET.MENU HARDCOPY.GET.ROTATION.MENU
HARDCOPY.GET.SCALE.MENU HARDCOPY.GET.SECTION.MENU)
(* * Used to return a sectioned window to its previous size)
(GLOBALVARS HARDCOPY.SECTIONREGION)
(FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
STYLESHEET)))
(* * From TRBs HardcopyEnhancement pkg. Possibly edited.)
(DEFINEQ
(HARDCOPYW
[LAMBDA (WINDOW/BITMAP/REGION FILE HOST SCALEFACTOR ROTATION PRINTERTYPE)
(* TBigham "14-Feb-85 18:39")
(* * removed the extraneous "Window Image" clutter)
(* lmm " 1-Sep-84 12:22")
(* makes a hard copy of a window)
(* WINDOW/BITMAP/REGION can be a WINDOW, a REGION, a
BITMAP, or NIL = select region)
(* If FILE supplied, output goes there.
If HOST supplied, IT is printed.
If neither FILE nor HOST supplied, default is to print)
(PROG ((BITMAP (SCREENBITMAP))
REGION
(PRINTHOST HOST))
[SETQ REGION (COND
((WINDOWP WINDOW/BITMAP/REGION)
(COND
((OPENWP WINDOW/BITMAP/REGION)
(TOTOPW WINDOW/BITMAP/REGION)
(WINDOWPROP WINDOW/BITMAP/REGION (QUOTE REGION)))
(T (SETQ BITMAP (WINDOWPROP WINDOW/BITMAP/REGION (QUOTE IMAGECOVERED)))
NIL)))
((BITMAPP WINDOW/BITMAP/REGION)
(SETQ BITMAP WINDOW/BITMAP/REGION)
NIL)
((type? REGION WINDOW/BITMAP/REGION)
WINDOW/BITMAP/REGION)
(T (GETREGION]
RETRY
(COND
[PRINTERTYPE (COND
[PRINTHOST (COND
((NEQ PRINTERTYPE (PRINTERTYPE PRINTHOST))
(ERROR PRINTHOST (CONCAT "not of printer type " PRINTERTYPE)
)
(GO RETRY]
(FILE (* don't need a PRINTHOST if you give a file)
)
[(SETQ PRINTHOST (find HOST inside DEFAULTPRINTINGHOST
suchthat (EQ PRINTERTYPE (PRINTERTYPE HOST]
(T (ERROR
"Can't find a printing host in DEFAULTPRINTINGHOST that is of type "
PRINTERTYPE)
(GO RETRY]
(PRINTHOST (SETQ PRINTERTYPE (PRINTERTYPE PRINTHOST)))
[DEFAULTPRINTINGHOST (for X inside DEFAULTPRINTINGHOST when (PRINTERPROP (SETQ
PRINTERTYPE
(PRINTERTYPE
X))
(QUOTE
BITMAPSCALE))
do (RETURN (SETQ PRINTHOST X))
finally (SETQ PRINTERTYPE (PRINTERTYPE (SETQ PRINTHOST
(COND
((LISTP
DEFAULTPRINTINGHOST)
(CAR
DEFAULTPRINTINGHOST))
(T DEFAULTPRINTINGHOST]
[FILE (COND
((NOT (SETQ PRINTERTYPE (PRINTFILETYPE FILE T)))
(ERROR FILE
"Can't tell what kind of print file to produce -- PRINTERTYPE, DEFAULTPRINTERTYPE, DEFAULTPRINTINGHOST all NIL"
)
(GO RETRY]
(T (ERROR "Can't tell where to send window image -- HOST, DEFAULTPRINTINGHOST are NIL")
(GO RETRY)))
[COND
((NOT SCALEFACTOR)
[SETQ SCALEFACTOR (COND
(REGION (PRINTER.BITMAPSCALE (fetch WIDTH of REGION)
(fetch HEIGHT of REGION)
PRINTERTYPE PRINTHOST))
(T (PRINTER.BITMAPSCALE (fetch BITMAPWIDTH of BITMAP)
(fetch BITMAPHEIGHT of BITMAP)
PRINTERTYPE PRINTHOST]
(COND
((LISTP SCALEFACTOR)
(SETQ ROTATION (CDR SCALEFACTOR))
(SETQ SCALEFACTOR (CAR SCALEFACTOR] (* (SETQ FULLFILE (PRINTER.BITMAPFILE
(OR FILE (PRINTER.SCRATCH.FILE)) PRINTERTYPE BITMAP
SCALEFACTOR REGION ROTATION "Window Image")))
(SETQ FULLFILE (PRINTER.BITMAPFILE (OR FILE (PRINTER.SCRATCH.FILE))
PRINTERTYPE BITMAP SCALEFACTOR REGION ROTATION))
[COND
((OR HOST (NULL FILE))
(ADD.PROCESS [BQUOTE (PROGN (, (PRINTERPROP PRINTERTYPE (QUOTE SEND))
(QUOTE , (COND ((LISTP PRINTHOST)
(CADR PRINTHOST))
(T PRINTHOST)))
(QUOTE , FULLFILE)
(QUOTE (DOCUMENT.NAME "Window Image")))
,
(AND (NULL FILE)
(BQUOTE (DELFILE (QUOTE , FULLFILE]
(QUOTE NAME)
(QUOTE HARDCOPYW]
(RETURN (COND
((NULL FILE)
NIL)
(T FULLFILE])
(HARDCOPY.SCREEN
[LAMBDA NIL (* DAI " 1-Apr-85 13:50")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(PROG (MENU)
(if (EQ (PRINTERTYPE (FIND.PRINTSERVER.NAME))
(QUOTE PRESS))
then (PROMPTPRINT "DEFAULTPRINTINGHOST must be set to an Interpress printer")
else (COND
((AND (BOUNDP (QUOTE CURRENT.INTERFACE.WINDOW))
(NOT (NULL CURRENT.INTERFACE.WINDOW)))
(TOTOPW CURRENT.INTERFACE.WINDOW)))
(HARDCOPYW (SCREENBITMAP)
DEFAULT.HARDCOPY.FILENAME NIL .75 90 (QUOTE INTERPRESS])
(FIND.PRINTSERVER.NAME
[LAMBDA NIL (* TBigham "15-Feb-85 13:23")
(* trb " 5-Jul-84 11:03")
(* now accounts for the case where elemets in the
DEFAULTPRINTINGHOST list may be a list themseleves e.g.
((FULLPRESS JEDI) Quake Expresso:))
(* 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 (if (LISTP (CAR DEFAULTPRINTINGHOST))
then (CADR (CAR DEFAULTPRINTINGHOST))
else (CAR DEFAULTPRINTINGHOST))
else DEFAULTPRINTINGHOST])
)
(* * This version is new. Now has "whole screen" included on the sub menu)
(DEFINEQ
(HARDCOPY.BACKGROUND.COMMAND
[LAMBDA NIL (* DAI "27-Mar-85 16:54")
(* HaKo "13-Aug-84 14:39")
(MENU (create MENU
TITLE ← "Hardcopy:"
CENTERFLG ← T
ITEMS ←(QUOTE ((window (HARDCOPY.WINDOW)
"Send hardcopy of a window to printer.")
(region (HARDCOPYW)
"Send hardcopy of screen region to printer.")
("whole screen" (HARDCOPY.SCREEN)
"Hardcopy the entire screen"])
(HARDCOPY.BACKGROUND.COMMAND!Original
[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."])
)
(* * From DAIs Tri-Fix-Ingalls for hardcopy pkg. Edited.)
(DEFINEQ
(HARDCOPY.BACKBONE
[LAMBDA (WINDOW FILE ROTATION SCALE) (* DAI "27-Mar-85 17:44")
(* 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))
(SETQ ROTATION (SELECTQ ROTATION
((QUOTE Portrait)
0)
((QUOTE Landscape)
90)
NIL))
(SETQ SCALE (SELECTQ SCALE
((QUOTE Full% Size)
1)
((QUOTE Reduced% 75% Percent)
.75)
NIL))
(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"))
(RESETFORM (CARET (QUOTE OFF))
(TOTOPW WINDOW)
(SETQ FILE (HARDCOPYW WINDOW FILE NIL SCALE ROTATION PRINTERTYPE]
(T (if HARDCOPY.TRACEFLG
then (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Computing HARDCOPYW in INTERPRESS mode"))
(RESETFORM (CARET (QUOTE OFF))
(TOTOPW WINDOW)
(SETQ FILE (HARDCOPYW WINDOW FILE NIL SCALE ROTATION 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.BACKBONE!Original
[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.CHECK.PRINTSERVER
[LAMBDA NIL (* DAI "28-Feb-85 12:58")
(* 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 (U-CASE (CADR (ASSOC ASPECT PRINTER.STATUS)))
(QUOTE AVAILABLE]
(SHOULDNT])
(HARDCOPY.CHECK.PRINTSERVER!Original
[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) (* DAI " 1-Apr-85 11:07")
(* 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)
(DECLARE (GLOBALVARS HARDCOPY.SECTIONREGION))
(PROG (EXTENT RULEX RULEY STEPX STEPY NX NY)
(TRILLIUM.PRINTOUT "Specify the shape of the hardcopy sections" T)
(SETQ HARDCOPY.SECTIONREGION (GETREGION))
(SETQ EXTENT (GET.WINDOW.EXTENT W))
(SETQ RULEX (CADDR EXTENT))
(SETQ RULEY (CADDDR EXTENT))
(SETQ STEPX (CADDR HARDCOPY.SECTIONREGION))
(SETQ STEPY (CADDDR HARDCOPY.SECTIONREGION))
(SETQ NX (IQUOTIENT RULEX STEPX))
(SETQ NY (IQUOTIENT RULEY STEPY))
(RETURN (LIST STEPX STEPY NX NY])
(HARDCOPY.DEFINE.SECTIONS!Original
[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.INTERFACE
[LAMBDA (INTERFACE) (* DAI " 1-Apr-85 09:24")
(* HaKo "16-Aug-84 15:01")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW HARDCOPY.TRACEFLG))
(PROG (HARDCOPY.OPTIONS ROTATION SCALE SECTIONS FRAMES FRAME.NAMES CUT.SPECS)
(COND
((NULL INTERFACE)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Hardcopy of interface aborted.")
(RETURN)))
(AND HARDCOPY.TRACEFLG (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Starting hardcopy..."
(DATE)))
(SETQ HARDCOPY.OPTIONS (STYLESHEET (HARDCOPY.GET.SELECTION.STYLE.SHEET.MENU)))
(COND
((NULL HARDCOPY.OPTIONS)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Hardcopy aborted")
(RETURN)))
(* * SET THE VARS ROTATION, SCALE, AND SECTIONS TO THE VALUES SELECTED BY THE USER)
(for OPTION.CHOSEN in HARDCOPY.OPTIONS by (CDR HARDCOPY.OPTIONS) as OPTION
in (QUOTE (ROTATION SCALE SECTIONS)) do (SET OPTION OPTION.CHOSEN))
(HARDCOPY.SETUP)
[COND
((EQ SECTIONS (QUOTE In% Sections))
(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 ROTATION SCALE)
(AND HARDCOPY.TRACEFLG (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Finishing hardcopy..."
(DATE])
(HARDCOPY.INTERFACE!Original
[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.LOOP.THRU.FRAMES
[LAMBDA (INTERFACE FRAME.NAMES CUT.SPECS ROTATION SCALE) (* DAI " 1-Apr-85 09:24")
(* 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 CURRENT.INTERFACE.WINDOW CUT.SPECS FILE ROTATION SCALE))
(T (HARDCOPY.BACKBONE CURRENT.INTERFACE.WINDOW FILE ROTATION SCALE])
(HARDCOPY.LOOP.THRU.FRAMES!Original
[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.SECTIONS
[LAMBDA (W CUT.SPECS FILE ROTATION SCALE) (* DAI " 1-Apr-85 11:07")
(* trb " 8-Jul-84 20:47")
(DECLARE (GLOBALVARS HARDCOPY.SECTIONREGION))
(PROG (OLDWINDOWREGION FLAG STEPX STEPY NX NY)
(COND
((NOT (REGIONP CUT.SPECS))
(RETURN NIL)))
(SETQ OLDWINDOWREGION (WINDOWPROP W (QUOTE REGION)))
(SHAPEW W HARDCOPY.SECTIONREGION)
(SETQ FLAG T)
(SETQ STEPX (CAR CUT.SPECS))
(SETQ STEPY (CADR CUT.SPECS))
(SETQ NX (CADDR CUT.SPECS))
(SETQ NY (CAR (LAST CUT.SPECS)))
(from 0 to NY
do [from 1 to NX
do (HARDCOPY.BACKBONE W FILE ROTATION SCALE)
(COND
(FLAG (SCROLLW W (IMINUS STEPX)
0))
(T (SCROLLW W STEPX 0]
(SETQ FLAG (NOT FLAG))
(HARDCOPY.BACKBONE W FILE ROTATION SCALE)
(SCROLLW W 0 (IMINUS STEPY)))
(SCROLLW W (COND
(FLAG 0)
(T (TIMES NX STEPX)))
(TIMES (ADD1 NY)
STEPY))
(SHAPEW W OLDWINDOWREGION])
(HARDCOPY.SECTIONS!Original
[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.TEST.TIMEOUT
[LAMBDA NIL (* DAI "27-Feb-85 18:10")
(* 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))
(BLOCK))
(if HARDCOPY.ABORT.WINDOW
then (CLOSEW HARDCOPY.ABORT.WINDOW))
(if HARDCOPY.ABORTED
then (HARDCOPY.ABORT.CLEANUP))
HARDCOPY.ABORTED])
(HARDCOPY.TEST.TIMEOUT!Original
[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 (* DAI "27-Feb-85 18:10")
(* 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 (SPAWN.MOUSE)
(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.TIMEOUT.EXCESSIVE!Original
[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 (* DAI "29-Mar-85 15:03")
(* HaKo "13-Aug-84 14:51")
(DECLARE (GLOBALVARS DEFAULT.HARDCOPY.FILENAME))
(PROG (W HARDCOPY.OPTIONS ROTATION SCALE SECTIONS 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)))
(TOTOPW W)
(SETQ HARDCOPY.OPTIONS (STYLESHEET (HARDCOPY.GET.SELECTION.STYLE.SHEET.MENU)))
(COND
((NULL HARDCOPY.OPTIONS)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Hardcopy aborted")
(RETURN)))
(* * SET THE VARS ROTATION, SCALE, AND SECTIONS TO THE VALUES SELECTED BY THE USER)
(for OPTION.CHOSEN in HARDCOPY.OPTIONS by (CDR HARDCOPY.OPTIONS) as OPTION
in (QUOTE (ROTATION SCALE SECTIONS)) do (SET OPTION OPTION.CHOSEN))
(SETQ FILE DEFAULT.HARDCOPY.FILENAME)
(HARDCOPY.SETUP)
(COND
((EQ SECTIONS (QUOTE In% Sections))
(AND (HARDCOPY.WINDOW.SECTIONABLE? W)
(HARDCOPY.SECTIONS W (HARDCOPY.DEFINE.SECTIONS W)
FILE ROTATION SCALE)))
(T (HARDCOPY.BACKBONE W FILE ROTATION SCALE])
(HARDCOPY.WINDOW!Original
[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])
)
(* * New function)
(DEFINEQ
(HARDCOPY.WINDOW.SECTIONABLE?
[LAMBDA (W) (* DAI "29-Mar-85 11:08")
(COND
[(NULL (WINDOWPROP W (QUOTE INTERFACE)))
(COND
((NULL (WINDOWPROP W (QUOTE REPAINTFN)))
(CLEARW PROMPTWINDOW)
(FLASHWINDOW PROMPTWINDOW 3)
(MOUSECONFIRM
"WARNING: Hardcopy by Sections only works on Trillium Interface windows.
Do you still want to try?"))
(T (CLEARW PROMPTWINDOW)
(FLASHWINDOW PROMPTWINDOW 3)
(MOUSECONFIRM
"WARNING: Hardcopy by Sections only works on Trillium Interface windows.
Do you still want to try?"]
(T])
)
(* * New functions. Uses the Lispusers package StyleSheet)
(DEFINEQ
(HARDCOPY.GET.SELECTION.STYLE.SHEET.MENU
[LAMBDA NIL (* DAI "29-Mar-85 10:59")
(CREATE.STYLE (QUOTE ITEMS)
(LIST (HARDCOPY.GET.ROTATION.MENU)
(HARDCOPY.GET.SCALE.MENU)
(HARDCOPY.GET.SECTION.MENU))
(QUOTE SELECTIONS)
(QUOTE (Portrait Full% Size Not% In% Sections))
(QUOTE TITLE)
"MAKE HARDCOPY SELECTIONS"])
(HARDCOPY.GET.ROTATION.MENU
[LAMBDA NIL (* DAI "29-Mar-85 10:50")
(OR (GETPROP (QUOTE HARDCOPY.GET.ROTATION.MENU)
(QUOTE MENU))
(PUTPROP (QUOTE HARDCOPY.GET.ROTATION.MENU)
(QUOTE MENU)
(create MENU
ITEMS ←(QUOTE (Portrait Landscape))
CENTERFLG ← T])
(HARDCOPY.GET.SCALE.MENU
[LAMBDA NIL (* DAI "29-Mar-85 10:53")
(OR (GETPROP (QUOTE HARDCOPY.GET.SCALE.MENU)
(QUOTE MENU))
(PUTPROP (QUOTE HARDCOPY.GET.SCALE.MENU)
(QUOTE MENU)
(create MENU
ITEMS ←(QUOTE (Full% Size Reduced% 75% Percent))
CENTERFLG ← T])
(HARDCOPY.GET.SECTION.MENU
[LAMBDA NIL (* DAI "29-Mar-85 10:54")
(OR (GETPROP (QUOTE HARDCOPY.GET.SECTION.MENU)
(QUOTE MENU))
(PUTPROP (QUOTE HARDCOPY.GET.SECTION.MENU)
(QUOTE MENU)
(create MENU
ITEMS ←(QUOTE (In% Sections Not% In% Sections))
CENTERFLG ← T])
)
(* * Used to return a sectioned window to its previous size)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS HARDCOPY.SECTIONREGION)
)
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
STYLESHEET)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1821 7977 (HARDCOPYW 1831 . 6363) (HARDCOPY.SCREEN 6365 . 7041) (FIND.PRINTSERVER.NAME
7043 . 7975)) (8059 9017 (HARDCOPY.BACKGROUND.COMMAND 8069 . 8623) (
HARDCOPY.BACKGROUND.COMMAND!Original 8625 . 9015)) (9082 31046 (HARDCOPY.BACKBONE 9092 . 11371) (
HARDCOPY.BACKBONE!Original 11373 . 13133) (HARDCOPY.CHECK.PRINTSERVER 13135 . 14301) (
HARDCOPY.CHECK.PRINTSERVER!Original 14303 . 15374) (HARDCOPY.DEFINE.SECTIONS 15376 . 16621) (
HARDCOPY.DEFINE.SECTIONS!Original 16623 . 17734) (HARDCOPY.INTERFACE 17736 . 19515) (
HARDCOPY.INTERFACE!Original 19517 . 20639) (HARDCOPY.LOOP.THRU.FRAMES 20641 . 21451) (
HARDCOPY.LOOP.THRU.FRAMES!Original 21453 . 22126) (HARDCOPY.SECTIONS 22128 . 23399) (
HARDCOPY.SECTIONS!Original 23401 . 24155) (HARDCOPY.TEST.TIMEOUT 24157 . 24954) (
HARDCOPY.TEST.TIMEOUT!Original 24956 . 25656) (HARDCOPY.TIMEOUT.EXCESSIVE 25658 . 27239) (
HARDCOPY.TIMEOUT.EXCESSIVE!Original 27241 . 28714) (HARDCOPY.WINDOW 28716 . 30224) (
HARDCOPY.WINDOW!Original 30226 . 31044)) (31072 31751 (HARDCOPY.WINDOW.SECTIONABLE? 31082 . 31749)) (
31817 33369 (HARDCOPY.GET.SELECTION.STYLE.SHEET.MENU 31827 . 32256) (HARDCOPY.GET.ROTATION.MENU 32258
. 32622) (HARDCOPY.GET.SCALE.MENU 32624 . 32992) (HARDCOPY.GET.SECTION.MENU 32994 . 33367)))))
STOP