(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "17-Sep-87 15:17:45" |{MCS:MCS:STANFORD}<LANE>STORAGE.;16| 16510
changes to%: (VARS STORAGECOMS)
(FNS SHOWSTORAGEREPAINT)
previous date%: " 9-Sep-87 10:06:41" |{MCS:MCS:STANFORD}<LANE>STORAGE.;13|)
(* "
Copyright (c) 1984, 1985, 1986, 1987 by Stanford University. All rights reserved.
")
(PRETTYCOMPRINT STORAGECOMS)
(RPAQQ STORAGECOMS [(LOCALVARS . T)
(FNS SHOWSTORAGE)
(FNS SHOWSTORAGEBUTTONFN SHOWSTORAGEREPAINT SHOWSTORAGEUPDATE SHOWSTORAGEDISPLAY
SHOWSTORAGEALLOCMDS)
(ADDVARS (SHOWSTORAGEIGNORE SMALLP LITATOM CHARACTER CL::STRUCTURE-OBJECT))
(INITVARS (SHOWSTORAGEMODES '(ITEM PAGE BOX))
(SHOWSTORAGEWINDOWSIZE 275)
(SHOWSTORAGEDEFAULTTHRESHOLD 1)
(SHOWSTORAGEFONT (bind FONT for ROTATION in '(90 0) thereis
(for SIZE from 5 to 10 thereis
(SETQ FONT (FONTCREATE 'HELVETICA SIZE
'MRR ROTATION 'DISPLAY T)))
finally
(RETURN FONT)))
SHOWSTORAGEPRIN2FLG)
(GLOBALVARS SHOWSTORAGEIGNORE SHOWSTORAGEMODES SHOWSTORAGEWINDOWSIZE
SHOWSTORAGEDEFAULTTHRESHOLD SHOWSTORAGEFONT SHOWSTORAGEPRIN2FLG)
(DECLARE%: DONTCOPY (CONSTANTS (SHOWSTORAGESHADE 42405])
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(SHOWSTORAGE
[LAMBDA (PAGETHRESHOLD MODE ROTATION) (* ; "Edited 9-Sep-87 10:06 by cdl")
(if (NOT (MEMB MODE SHOWSTORAGEMODES))
then (SETQ MODE (CAR SHOWSTORAGEMODES)))
(if (NOT (NUMBERP PAGETHRESHOLD))
then (SETQ PAGETHRESHOLD SHOWSTORAGEDEFAULTTHRESHOLD))
(LET (WINDOW SIZE (TYPES (SHOWSTORAGEALLOCMDS PAGETHRESHOLD))
(FONT (if ROTATION
then (FONTCOPY SHOWSTORAGEFONT 'ROTATION ROTATION)
else SHOWSTORAGEFONT)))
[SETQ SIZE (TIMES (LENGTH TYPES)
(FONTPROP FONT 'HEIGHT]
(SETQ WINDOW (CREATEW (SELECTQ (FONTPROP FONT 'ROTATION)
(90 (GETBOXREGION (WIDTHIFWINDOW SIZE)
(HEIGHTIFWINDOW SHOWSTORAGEWINDOWSIZE T)))
(GETBOXREGION (WIDTHIFWINDOW SHOWSTORAGEWINDOWSIZE)
(HEIGHTIFWINDOW SIZE T)))
(CONCAT "Datatype Storage by " MODE " count, threshold = " PAGETHRESHOLD
)))
(DSPFONT FONT WINDOW)
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION SHOWSTORAGEBUTTONFN))
(WINDOWPROP WINDOW 'RESHAPEFN (FUNCTION SHOWSTORAGEREPAINT))
(WINDOWPROP WINDOW 'REPAINTFN (FUNCTION SHOWSTORAGEREPAINT))
(WINDOWPROP WINDOW 'EXPANDFN (FUNCTION SHOWSTORAGEUPDATE))
(WINDOWPROP WINDOW 'MODE MODE)
(WINDOWPROP WINDOW 'THRESHOLD PAGETHRESHOLD)
(WINDOWPROP WINDOW 'ALLOCMDS TYPES)
(REDISPLAYW WINDOW])
)
(DEFINEQ
(SHOWSTORAGEBUTTONFN
[LAMBDA (WINDOW) (* ; "Edited 9-Sep-87 08:10 by cdl")
(if (MOUSESTATE LEFT)
then (SHOWSTORAGEUPDATE WINDOW)
elseif (MOUSESTATE MIDDLE)
then [LET [(MODE (OR (CADR (MEMB (WINDOWPROP WINDOW 'MODE)
SHOWSTORAGEMODES))
(CAR SHOWSTORAGEMODES]
(WINDOWPROP WINDOW 'MODE MODE)
(WINDOWPROP WINDOW 'TITLE (CONCAT "Datatype Storage by " MODE
" count, threshold = " (WINDOWPROP WINDOW
'THRESHOLD]
(DSPFILL (SELECTQ (FONTPROP (DSPFONT NIL WINDOW)
'ROTATION)
(90 (create REGION
HEIGHT ← (WINDOWPROP WINDOW 'DIVISION) using (DSPCLIPPINGREGION
NIL WINDOW)))
(create REGION
WIDTH ← (WINDOWPROP WINDOW 'DIVISION) using (DSPCLIPPINGREGION
NIL WINDOW)))
WHITESHADE
'REPLACE WINDOW)
(SHOWSTORAGEUPDATE WINDOW))
(until (MOUSESTATE UP) do (BLOCK])
(SHOWSTORAGEREPAINT
[LAMBDA (WINDOW) (* ; "Edited 17-Sep-87 15:07 by cdl")
(PROG ((FONT (DSPFONT NIL WINDOW))
(REGION (DSPCLIPPINGREGION NIL WINDOW))
DATATYPES SIZE DIVISION FONTHEIGHT ROTATION)
[if [NULL (SETQ DATATYPES (WINDOWPROP WINDOW 'ALLOCMDS]
then (WINDOWPROP WINDOW 'ALLOCMDS (SETQ DATATYPES (SHOWSTORAGEALLOCMDS
(WINDOWPROP WINDOW 'THRESHOLD]
(WINDOWPROP WINDOW 'DATATYPES (SETQ DATATYPES (in DATATYPES collect CAR)))
(if (NEQ [SETQ SIZE (TIMES (LENGTH DATATYPES)
(SETQ FONTHEIGHT (FONTPROP FONT 'HEIGHT]
(with REGION REGION (SELECTQ (SETQ ROTATION (FONTPROP FONT 'ROTATION))
(90 WIDTH)
HEIGHT)))
then [SHAPEW WINDOW (SELECTQ ROTATION
(90 (create REGION
WIDTH ← (WIDTHIFWINDOW SIZE)
using (WINDOWPROP WINDOW 'REGION)))
(create REGION
HEIGHT ← (HEIGHTIFWINDOW SIZE T)
using (WINDOWPROP WINDOW 'REGION]
(RETURN))
[WINDOWPROP WINDOW 'DIVISION (SETQ DIVISION (DIFFERENCE (with REGION REGION
(SELECTQ ROTATION
(90 TOP)
RIGHT))
(STRINGWIDTH (for DATATYPE in DATATYPES
largest (NCHARS DATATYPE
SHOWSTORAGEPRIN2FLG
))
FONT SHOWSTORAGEPRIN2FLG]
(bind (WIDTH ← (ADD1 DIVISION))
[HEIGHT ← (SELECTQ ROTATION
(90 (FONTPROP FONT 'ASCENT))
(FONTPROP FONT 'DESCENT] for DATATYPE in DATATYPES
do (SELECTQ ROTATION
(90 (MOVETO HEIGHT WIDTH WINDOW))
(MOVETO WIDTH HEIGHT WINDOW))
(if SHOWSTORAGEPRIN2FLG
then (printout WINDOW |.P2| DATATYPE)
else (printout WINDOW DATATYPE))
(add HEIGHT FONTHEIGHT))
(SHOWSTORAGEUPDATE WINDOW])
(SHOWSTORAGEUPDATE
[LAMBDA (WINDOW) (* ; "Edited 9-Sep-87 07:48 by cdl")
(DECLARE (SPECVARS WINDOW)
(GLOBALVARS WAITINGCURSOR))
(RESETFORM
(CURSOR WAITINGCURSOR)
(LET ((FONT (DSPFONT NIL WINDOW))
(DIVISION (WINDOWPROP WINDOW 'DIVISION))
(MODE (WINDOWPROP WINDOW 'MODE))
(DATATYPES (WINDOWPROP WINDOW 'DATATYPES))
(ALLOCMDSLST (WINDOWPROP WINDOW 'ALLOCMDS NIL))
(FREE (CREATECELL \FIXP))
ALLOCMDS DATATYPE REGION ITEMSPERMDS TYPENUMBER ROTATION FONTHEIGHT)
(DECLARE (SPECVARS ALLOCMDS))
(SETQ FONTHEIGHT (FONTPROP FONT 'HEIGHT))
(SETQ REGION (SELECTQ (SETQ ROTATION (FONTPROP FONT 'ROTATION))
(90 (create REGION
WIDTH ← FONTHEIGHT
LEFT ← 1))
(create REGION
HEIGHT ← FONTHEIGHT
BOTTOM ← 0)))
(for DATATYPE in DATATYPES
do (SETQ TYPENUMBER (\TYPENUMBERFROMNAME DATATYPE))
(SELECTQ MODE
((PAGE ITEM)
(\StatsZero FREE)
(if (NULL ALLOCMDSLST)
then (SETQ ALLOCMDSLST (SHOWSTORAGEALLOCMDS (WINDOWPROP WINDOW
'THRESHOLD)
DATATYPE)))
(SETQ ALLOCMDS (CADR (pop ALLOCMDSLST)))
[if (EQ 'LISTP (\TYPENAMEFROMNUMBER TYPENUMBER))
then [SETQ ITEMSPERMDS (CONSTANT (FIX (FQUOTIENT \MDSIncrement 2.2]
(for (LSTPAG ← (create POINTER
PAGE# ← (fetch (DTD DTDNEXTPAGE) of \LISTPDTD
)))
by (create POINTER
PAGE# ← (fetch (CONSPAGE NEXTPAGE) of LSTPAG))
while LSTPAG do (\BOXIPLUS FREE (fetch (CONSPAGE CNT)
of LSTPAG)))
else (with DTD (\GETDTD TYPENUMBER)
(SETQ ITEMSPERMDS (QUOTIENT \MDSIncrement DTDSIZE))
(for (PTR ← DTDFREE) by (\GETBASEPTR PTR 0) while PTR
do (\BOXIPLUS FREE 1])
NIL)
(SELECTQ MODE
(PAGE (SHOWSTORAGEDISPLAY (TIMES ALLOCMDS (QUOTIENT \MDSIncrement WORDSPERPAGE))
(TIMES (QUOTIENT FREE ITEMSPERMDS)
(QUOTIENT \MDSIncrement WORDSPERPAGE))
WINDOW REGION))
(ITEM (SHOWSTORAGEDISPLAY (TIMES ALLOCMDS ITEMSPERMDS)
FREE WINDOW REGION))
(BOX (SHOWSTORAGEDISPLAY (BOXCOUNT TYPENUMBER)
NIL WINDOW REGION))
(SHOULDNT))
(with REGION REGION (SELECTQ ROTATION
(90 (add LEFT FONTHEIGHT))
(add BOTTOM FONTHEIGHT])
(SHOWSTORAGEDISPLAY
[LAMBDA (TOTAL FREE WINDOW REGION) (* cdl "28-Jan-87 18:22")
(PROG ((FONT (DSPFONT NIL WINDOW))
(DIVISION (WINDOWPROP WINDOW 'DIVISION))
ROTATION INUSE OFFSET STRINGWIDTH)
(with REGION REGION [SELECTQ (SETQ ROTATION (FONTPROP FONT 'ROTATION))
(90 (SETQ HEIGHT TOTAL)
(SETQ BOTTOM (DIFFERENCE DIVISION TOTAL))
[SETQ OFFSET (PLUS LEFT (SUB1 (FONTPROP FONT 'ASCENT])
(PROGN (SETQ WIDTH TOTAL)
(SETQ LEFT (DIFFERENCE DIVISION TOTAL))
(SETQ OFFSET (PLUS BOTTOM (FONTPROP FONT 'DESCENT]
(DSPFILL REGION BLACKSHADE NIL WINDOW)
(if (NULL FREE)
then (if (GREATERP TOTAL (STRINGWIDTH TOTAL FONT))
then (SELECTQ ROTATION
(90 (MOVETO OFFSET (ADD1 (MAX BOTTOM 0))
WINDOW))
(MOVETO (ADD1 (MAX LEFT 0))
OFFSET WINDOW))
(printout WINDOW TOTAL))
(RETURN))
(if (GREATERP (SETQ INUSE (DIFFERENCE TOTAL FREE))
(STRINGWIDTH INUSE FONT))
then (SELECTQ ROTATION
(90 (MOVETO OFFSET (ADD1 (MAX (PLUS BOTTOM FREE)
0))
WINDOW))
(MOVETO (ADD1 (MAX (PLUS LEFT FREE)
0))
OFFSET WINDOW))
(DSPOPERATION 'INVERT WINDOW)
(PRIN1 INUSE WINDOW)
(DSPOPERATION 'REPLACE WINDOW))
(SELECTQ ROTATION
(90 (SETQ HEIGHT FREE))
(SETQ WIDTH FREE))
(DSPFILL REGION SHOWSTORAGESHADE NIL WINDOW)
(if (AND (GREATERP FREE (SETQ STRINGWIDTH (STRINGWIDTH FREE FONT)))
(GREATERP (DIFFERENCE DIVISION INUSE)
STRINGWIDTH))
then (SELECTQ ROTATION
(90 (MOVETO OFFSET (ADD1 (MAX BOTTOM 0))
WINDOW))
(MOVETO (ADD1 (MAX LEFT 0))
OFFSET WINDOW))
(PRIN1 FREE WINDOW])
(SHOWSTORAGEALLOCMDS
[LAMBDA (THRESHOLD TYPES) (* ; "Edited 9-Sep-87 10:05 by cdl")
(DECLARE (SPECVARS THRESHOLD)
(GLOBALVARS WAITINGCURSOR))
(RESETFORM (CURSOR WAITINGCURSOR)
(bind ALLOCMDS declare%: (SPECVARS ALLOCMDS) for DATATYPE
inside (OR TYPES (LDIFFERENCE (DATATYPES)
SHOWSTORAGEIGNORE)) eachtime (SETQ ALLOCMDS 0)
[\MAPMDS (\TYPENUMBERFROMNAME
DATATYPE)
(FUNCTION (LAMBDA NIL
(ADD1VAR ALLOCMDS]
when (GEQ (TIMES ALLOCMDS (QUOTIENT \MDSIncrement WORDSPERPAGE))
THRESHOLD) collect (LIST DATATYPE ALLOCMDS])
)
(ADDTOVAR SHOWSTORAGEIGNORE SMALLP LITATOM CHARACTER CL::STRUCTURE-OBJECT)
(RPAQ? SHOWSTORAGEMODES '(ITEM PAGE BOX))
(RPAQ? SHOWSTORAGEWINDOWSIZE 275)
(RPAQ? SHOWSTORAGEDEFAULTTHRESHOLD 1)
(RPAQ? SHOWSTORAGEFONT (bind FONT for ROTATION in '(90 0) thereis
(for SIZE from 5 to 10 thereis (SETQ FONT (FONTCREATE 'HELVETICA SIZE
'MRR ROTATION
'DISPLAY T)))
finally
(RETURN FONT)))
(RPAQ? SHOWSTORAGEPRIN2FLG NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SHOWSTORAGEIGNORE SHOWSTORAGEMODES SHOWSTORAGEWINDOWSIZE SHOWSTORAGEDEFAULTTHRESHOLD
SHOWSTORAGEFONT SHOWSTORAGEPRIN2FLG)
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(RPAQQ SHOWSTORAGESHADE 42405)
(CONSTANTS (SHOWSTORAGESHADE 42405))
)
)
(PUTPROPS STORAGE COPYRIGHT ("Stanford University" 1984 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1791 3480 (SHOWSTORAGE 1801 . 3478)) (3481 15428 (SHOWSTORAGEBUTTONFN 3491 . 4996) (
SHOWSTORAGEREPAINT 4998 . 7973) (SHOWSTORAGEUPDATE 7975 . 11637) (SHOWSTORAGEDISPLAY 11639 . 14411) (
SHOWSTORAGEALLOCMDS 14413 . 15426)))))
STOP