(FILECREATED "19-JUL-78 01:38:57" <KRL>DISPLAYFNS.;40 10749
changes to: VISIBLE TracePrint
previous date: "10-JUL-78 13:55:22" <KRL>DISPLAYFNS.;39)
(PRETTYCOMPRINT DISPLAYFNSCOMS)
(RPAQQ DISPLAYFNSCOMS [(* various display printing FNS)
(FNS * DPRINTFNS)
(* various window manipulating functions)
(FNS * MWINFNS)
(VARS MFONTSHRINKLST)
(* Fns for other DLISP things, like Documents, Canvases, Desktops, etc.)
(FNS * MDOCFNS)
(IFPROP WINDOWSPECS TESTWIN)
(IFPROP CURSOR KEYSET SYMBOL)
(ADDVARS (CURSORLST KEYSET SYMBOL))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML DPPV DPP DPPU)))
(DECLARE: DONTCOPY EVAL@COMPILE DONTEVAL@LOAD
(P (COND ((EQ (GETATOMVAL (QUOTE RECORDSCOMS))
(QUOTE NOBIND))
(LOAD (QUOTE <KBA>RECORDS)
T)))
(COND ((EQ (GETATOMVAL (QUOTE DISPCOMPCOMS))
(QUOTE NOBIND))
(LOAD (QUOTE <KBA>DISPCOMP)
T])
(* various display printing FNS)
(RPAQQ DPRINTFNS (DPPU DPP DPPV KPRETTYPRINT TracePrint))
(DEFINEQ
(DPPU
[NLAMBDA (UNIT) (* mlm: " 3-MAR-78 14:19")
(SETWINDOWSPECS 'KRLWORKAREA '((VISIBLE T)
(ONTOP T)))
(VISIBLE 'KRLWORKDESK)
(fetch (DISPEDITREC VALUE) of (DISPEDIT NIL [FUNCTION (LAMBDA NIL
(PROG ((GCGAGFLG T))
(RESETSAVE (ECHOES 'PP))
(ADISREGION (ADISTTYREGION))
(if ADISOFILE
then (TERPRI T)
(TERPRI T))
(PUPCOPYBYTES CONTROLIN T 26)
(RETURN UNIT]
'KRLWORKAREA
(create GLUMPID NAME ← UNIT WHENDONE ←('DONEKEDITING)
OTHER ←('UNIT])
(DPP
[NLAMBDA (ATM DEF) (* mlm: "15-FEB-78 12:48")
(KPRETTYPRINT ATM DEF 'FN 2 T])
(DPPV
[NLAMBDA (ATM DEF)
(KPRETTYPRINT ATM DEF 'VAR NIL T])
(KPRETTYPRINT
[LAMBDA (ATM EXPR OTHER LEFT DEF TAILFLG)
(DECLARE (SPECVARS . T)) (* mlm: "27-APR-78 16:54")
(VISIBLE 'KRLWORKDESK)
(fetch (DISPEDITREC VALUE) of (DISPEDIT NIL [FUNCTION (LAMBDA NIL
(PROG (PRETTYTABFLG TEM (FIRSTCOL ('(40 . 5)))
(FONTCHANGEFLG (AND ADISOFILE
'ALL))
**COMMENT**FLG
(GCGAGFLG T))
(DECLARE (SPECVARS . T))
(RESETSAVE (ECHOES 'PP))
(ADISREGION (ADISTTYREGION))
(if ADISOFILE
then (TERPRI T)
(TERPRI T))
(if FONTCHANGEFLG='ALL
then (PROG (FILEFLG LASTFONT)
(DECLARE (SPECVARS . T))
(CHANGEFONT LAMBDAFONT)
(if OTHER='FN
then (PRIN1 "(" T))
(PRIN2 ATM T)
(CHANGEFONT DEFAULTFONT)
(TERPRI)))
(RETURN (PROG1 (PRINTDEF EXPR LEFT (OR DEF '(
NIL))
TAILFLG)
(AND OTHER='FN (PRIN1 ")
" T]
'KRLWORKAREA
(create GLUMPID NAME ← ATM WHENDONE ←('DONEKEDITING)
OTHER ← OTHER])
(TracePrint
[LAMBDA (WIN NAME OTHER GLUMPFLG) (* mlm: " 6-MAR-78 09:39")
(* generalized trace printer)
(PROG ($DOC ($WIN (GETWINDOW WIN)))
(VISIBLE $WIN)
($DOC←$WIN:DOCWINDOW.DOCUMENT)
(if GLUMPFLG
then (NEWGLUMP $DOC NAME))
[RESETFORM (OUTPUT $DOC:DOCUMENT.FILENAME)
(PROGN (TERPRI)
(PRINTXDTMSG BOLDMSG)
(PRINT NAME)
(PRINTXDTMSG NORMALMSG)
(for XX in OTHER do (SPACES 3)
(if (NLISTP XX)
then (PRIN1 XX)
else (PRINTXDTMSG ITALICMSG)
(PRIN1 XX:1)
(PRIN1 ": ")
(PRINTXDTMSG NORMALMSG)
(PRIN1 XX::1))
(TERPRI]
(if GLUMPFLG
then (SETWINDOWCONTENTS WIN NAME))
(UPDATEDOCUMENT $DOC])
)
(* various window manipulating functions)
(RPAQQ MWINFNS (BlotWindow UnblotWindow CLEARWINDOW MSHRINKWINDOW VISIBLE INVISIBLE))
(DEFINEQ
(BlotWindow
[LAMBDA (WindowName) (* edited: " 7-NOV-77 19:17")
(* assumes WindowName is a DOCWINDOW)
(PROG ($CAPREG ($WIN (GETWINDOW WindowName)))
($CAPREG←$WIN:WINDOW.CAPTION)
(SETWINDOWSPECS WindowName 'VISIBLE)
(PUTPROP WindowName 'UNBLOTSPECS <<'CAPTION <'BACKGROUND (if (ATOM $CAPREG)
then 0
else $CAPREG:CAPTION.BACKGROUND)
>> <'BACKGROUND
$WIN:WINDOW.BACKGROUND> <'BOLD
$WIN:DOCWINDOW.BOLD>>)
(SETWINDOWSPECS WindowName '((BACKGROUND BIGWHITESPOTS)
(CAPTION (BACKGROUND BIGWHITESPOTS])
(UnblotWindow
[LAMBDA (WindowName)
(PROG ((UNBLOTSPECS (GETPROP WindowName 'UNBLOTSPECS)))
(if UNBLOTSPECS=NIL
then (PRIN1 "
No UNBLOTSPECS for window " T)
(PRINT WindowName T)
(PRIN1 "so ignoring UnblotWindow.
"))
(SETWINDOWSPECS WindowName '((ONTOP T)
(VISIBLE T)))
(SETWINDOWSPECS WindowName UNBLOTSPECS)
(REMPROP WindowName 'UNBLOTSPECS)
(RETURN WindowName])
(CLEARWINDOW
[LAMBDA (WIN BACKGROUND) (* edited: "14-NOV-77 18:28")
(PROG (($WIN (GETWINDOW WIN))
REG)
(SELECTQ BACKGROUND
(NIL BACKGROUND←0)
(T BACKGROUND←$WIN:WINDOW.BACKGROUND)
(OR (NUMBERP BACKGROUND)
BACKGROUND←(GETPROP BACKGROUND 'BACKGROUND)))
(* (REG← (COPY ($WIN:SUBWINDOW.REGION))) (REG:REGION.LFT←REG:REGION.LFT+1) (REG:REGION.WDTH←REG:REGION.WDTH-2)
(REG:REGION.BTM←REG:REGION.BTM+1) (REG:REGION.HGHT←REG:REGION.HGHT-2) (* so as not to wipe out box around window!!))
(CLEARSCREEN $WIN:WINDOW.INTERIOREGION BACKGROUND 'REPLACE])
(MSHRINKWINDOW
[LAMBDA (WIN PERCENT FONTSHRINKFLG RIGHTANCHORFLG BOTTOMANCHORFLG)
(* edited: " 4-NOV-77 18:27")
(* anchors left unless RIGHTANCHORFLG -
anchors top unless BOTTOMANCHORFLG -
PERCENT is number (reals are actual factors, integers are implied percents) (.25 means 25% of current AREA, 150
150% of current AREA, etc) or dotted pair (HORIZ . VERT) or list (HORIZ VERT) -
if WIN is a list, does it for all in WIN)
(if (LISTP WIN)
then (for W in WIN do (SHRINKWINDOW W PERCENT FONTSHRINKFLG RIGHTANCHORFLG BOTTOMANCHORFLG))
else (PROG (($WIN (GETWINDOW WIN))
CURRWIDTH CURRHEIGHT HPC VPC CURRFONT NEWFONT)
(if (LISTP PERCENT)
then HPC←PERCENT:1
VPC←(if (LISTP PERCENT::1)
then (CADR PERCENT)
else PERCENT::1)
(if (SMALLP HPC)
then HPC←HPC/100.0)
(if (SMALLP VPC)
then VPC←VPC/100.0)
else HPC←VPC←(SQRT (if (SMALLP PERCENT)
then PERCENT/100.0
else PERCENT)))
(CURRWIDTH←$WIN:WINDOW.WIDTH)
(CURRHEIGHT←$WIN:WINDOW.HEIGHT)
(SETWINDOWSPECS WIN <<'WIDTH (FTIMES CURRWIDTH HPC)>
<'HEIGHT (FTIMES CURRHEIGHT VPC)>
<(if RIGHTANCHORFLG
then 'RIGHT
else 'LEFT)
'SAME >
<(if BOTTOMANCHORFLG
then 'BOTTOM
else 'TOP)
'SAME >>)
(if FONTSHRINKFLG
then CURRFONT←(if (type? DOCWINDOW $WIN)
then $WIN:DOCWINDOW.FONTREC:FONTREC.FONTNUMBER)
NEWFONT←(FASSOC CURRFONT FONTSHRINKLST)
NEWFONT←(if (FGREATERP HPC 1.0)
then (CADDR NEWFONT)
else (CADR NEWFONT)) (* that is, FONTSHRINKLST is of form
((FontNumber ShrinkFont GrowFont) %.
%. %.))
(if CURRFONT~=NEWFONT
then (SETWINDOWSPECS WIN <<'FONT NEWFONT>>])
(VISIBLE
[LAMBDA (WIN) (* mlm: " 3-MAR-78 13:17")
(PROG (($WIN (GETWINDOW WIN)))
(SETWINDOWSPECS $WIN '((ONTOP T)
(VISIBLE T)))
(TOUCHWINDOW $WIN)
(for $W in $WIN:WINDOW.ONDESKTOP:DESKTOP.WINDOWS do (SETWINDOWSPECS $W '((VISIBLE T)
(ONTOP T])
(INVISIBLE
[LAMBDA (WIN) (* mlm: " 3-MAR-78 13:24")
(PROG (($WIN (GETWINDOW WIN)))
(SETWINDOWSPECS $WIN '((VISIBLE NIL)))
(if ~(for W in $WIN:WINDOW.ONDESKTOP:DESKTOP.CONTENTS thereis (GETWINDOW W)
:WINDOW.VISIBLEFLG)
then (for $DW in $WIN:WINDOW.ONDESKTOP:DESKTOP.WINDOWS
do (SETWINDOWSPECS $DW '((VISIBLE NIL])
)
(RPAQQ MFONTSHRINKLST ((0 1 5)
(1 2 0)
(2 2 1)
(3 4 3)
(4 4 3)
(5 0 5)))
(* Fns for other DLISP things, like Documents, Canvases, Desktops, etc.)
(RPAQQ MDOCFNS (GLUMPSTRING))
(DEFINEQ
(GLUMPSTRING
[LAMBDA (GLUMP)
(GETSTRING (GLUMP:GLUMP.STARTADR)
(GLUMP:GLUMP.ENDADR])
)
(PUTPROPS TESTWIN WINDOWSPECS ((LEFT 50)
(RIGHT 450)
(BOTTOM 50)
(TOP 275)
(CAPTION "Test Window" (BACKGROUND LIGHTGREY))
(INITIMEFUSE 15)))
(PUTPROPS KEYSET CURSOR ((#647604 7 7)
65535 - 32769 - 65535 60855 - 28086 - - - - - - - -))
(PUTPROPS SYMBOL CURSOR ((#647623 7 0)
65535 - 32769 - 33153 384 - - - - - - - - - -))
(ADDTOVAR CURSORLST KEYSET SYMBOL)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML DPPV DPP DPPU)
)
(DECLARE: DONTCOPY EVAL@COMPILE DONTEVAL@LOAD
(COND ((EQ (GETATOMVAL (QUOTE RECORDSCOMS))
(QUOTE NOBIND))
(LOAD (QUOTE <KBA>RECORDS)
T)))
(COND ((EQ (GETATOMVAL (QUOTE DISPCOMPCOMS))
(QUOTE NOBIND))
(LOAD (QUOTE <KBA>DISPCOMP)
T)))
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1279 4375 (DPPU 1291 . 1954) (DPP 1958 . 2099) (DPPV 2103 . 2178) (KPRETTYPRINT 2182 .
3428) (TracePrint 3432 . 4372)) (4529 9379 (BlotWindow 4541 . 5280) (UnblotWindow 5284 . 5749) (
CLEARWINDOW 5753 . 6426) (MSHRINKWINDOW 6430 . 8533) (VISIBLE 8537 . 8916) (INVISIBLE 8920 . 9376)) (
9638 9758 (GLUMPSTRING 9650 . 9755)))))
STOP