(FILECREATED "26-Mar-86 15:59:44" {DSK}<KOOMEN>LISP>VSTATS.;21 46921
changes to: (VARS VSTATSCOMS)
(FNS VStatsReDisplayClock VStatsReDisplaySpace VStatsReDisplayMUtil VStatsTOPWP)
previous date: "19-Feb-86 16:41:59" {DSK}<KOOMEN>LISP>VSTATS.;20)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT VSTATSCOMS)
(RPAQQ VSTATSCOMS [(* * User interface * *)
(FNS VSTATS)
(INITVARS (VSTATS.BLACK? NIL)
(VSTATS.ALWAYS? NIL)
(VSTATS.CLOCK.INTERVAL 1)
(VSTATS.SPACE.INTERVAL 300)
(VSTATS.MUTIL.INTERVAL 1)
(VSTATS.SPACE.SHOW.DISK? T)
(VSTATS.MUTIL.HYSTERESIS 20)
(VSTATS.POSITION (create POSITION XCOORD ← SCREENWIDTH YCOORD ←
SCREENHEIGHT)))
(* * VSTATS support stuff * *)
(RECORDS VSTATSPCTINFO VSTATSTIMERINFO)
[VARS (VStatsDsp)
(VStatsOff? T)
(VStatsWindow)
(VStatsOptionsMenu)
(VStatsCurrentTime (SETUPTIMER 0 NIL (QUOTE TICKS]
(FNS VStatsDisplay VStatsDrawLine VStatsInit VStatsReDisplay? VStatsCreatePCTs
VStatsGetPCTsRegion VStatsCenterRegion VStatsDisplayPct VStatsSetOptions
VStatsSetUpTimer VStatsTimerExpired?)
(* * clock support stuff * *)
(VARS (VStatsClockFont)
(VStatsResetClock?)
(VStatsClockTimer (create VSTATSTIMERINFO)))
(FNS VStatsDisplayClock VStatsDisplayClockDigits VStatsDisplayClockMonth
VStatsGetClock VStatsInitClock VStatsReDisplayClock)
(* * space support stuff * *)
(VARS (VStatsSpaceFont)
(VStatsSpaceTimer (create VSTATSTIMERINFO))
(VStatsSpacePCTs)
(VStatsSpaceDiskPages))
(INITVARS (\LASTVMEMFILEPAGE 16383))
(FNS VStatsDisplaySpace VStatsGetSpace VStatsInitSpace VStatsReDisplaySpace
VStatsShrinkSpaceInterval)
(* * machine utilization support stuff * *)
(VARS (VStatsMUtilFont)
(VStatsMUtilTimer (create VSTATSTIMERINFO))
(VStatsMUtilPCTs)
(VStatsMUtilOrigState))
(FNS VStatsDisplayMUtil VStatsGetMUtil VStatsInitMUtil VStatsInitMUtilState
VStatsReDisplayMUtil)
(* * These ought to be system functions!!! * *)
(MACROS HALF)
(FNS CLOCKTICKS DISKTOTALPAGES)
(* Lisp before Lute version does not have a TOPWP function to test if window is
on top)
(FNS VStatsTOPWP)
(P (MOVD? (QUOTE VStatsTOPWP)
(QUOTE TOPWP)))
(* * Initialize on LOAD * *)
(VARS (BackgroundMenu))
(ADDVARS (BackgroundMenuCommands ("VStats" (NILL (VSTATS (QUOTE On)))
"Running display of clock and/or space utilization")))
(P (COND ((OR VSTATS.CLOCK.INTERVAL VSTATS.SPACE.INTERVAL VSTATS.MUTIL.INTERVAL)
(VSTATS (QUOTE On])
(* * User interface * *)
(DEFINEQ
(VSTATS
[LAMBDA (on/off) (* HaKo "14-Feb-86 11:15")
(DECLARE (GLOBALVARS AFTERSYSOUTFORMS BACKGROUNDFNS VStatsDsp VStatsOff? VStatsWindow))
(if (WINDOWP VStatsWindow)
then (CLOSEW VStatsWindow)
(SETQ VStatsWindow)
(SETQ VStatsDsp))
(SETQ on/off (AND (LITATOM on/off)
(U-CASE on/off)))
[SETQ VStatsOff? (OR (NULL on/off)
(EQ on/off (QUOTE OFF]
[if (NOT VStatsOff?)
then (if (NOT (VStatsInit))
then (VStatsSetOptions)
(if (NOT (VStatsInit))
then (SETQ VStatsOff? T]
(if VStatsOff?
then (SETQ BACKGROUNDFNS (REMOVE (QUOTE VStatsReDisplay?)
BACKGROUNDFNS))
(SETQ AFTERSYSOUTFORMS (REMOVE (QUOTE (VSTATS T))
AFTERSYSOUTFORMS))
(QUOTE Off)
else (VStatsDisplay)
(ADDTOVAR BACKGROUNDFNS VStatsReDisplay?)
(ADDTOVAR AFTERSYSOUTFORMS (VSTATS T))
(QUOTE On])
)
(RPAQ? VSTATS.BLACK? NIL)
(RPAQ? VSTATS.ALWAYS? NIL)
(RPAQ? VSTATS.CLOCK.INTERVAL 1)
(RPAQ? VSTATS.SPACE.INTERVAL 300)
(RPAQ? VSTATS.MUTIL.INTERVAL 1)
(RPAQ? VSTATS.SPACE.SHOW.DISK? T)
(RPAQ? VSTATS.MUTIL.HYSTERESIS 20)
(RPAQ? VSTATS.POSITION (create POSITION XCOORD ← SCREENWIDTH YCOORD ← SCREENHEIGHT))
(* * VSTATS support stuff * *)
[DECLARE: EVAL@COMPILE
(RECORD VSTATSPCTINFO (NAME LABEL NEWPCT OLDPCT LBLREGION BARREGION MAXBARHEIGHT))
(RECORD VSTATSTIMERINFO (INTERVAL TIMER LASTSETUP)
INTERVAL ← 0 TIMER ← (SETUPTIMER 0 NIL (QUOTE TICKS))
LASTSETUP ← (SETUPTIMER 0 NIL (QUOTE TICKS)))
]
(RPAQQ VStatsDsp NIL)
(RPAQQ VStatsOff? T)
(RPAQQ VStatsWindow NIL)
(RPAQQ VStatsOptionsMenu NIL)
(RPAQ VStatsCurrentTime (SETUPTIMER 0 NIL (QUOTE TICKS)))
(DEFINEQ
(VStatsDisplay
[LAMBDA NIL (* HaKo "15-Jan-86 16:58")
(DECLARE (GLOBALVARS VStatsClockRegion VStatsClockTimer VStatsMUtilRegion VStatsMUtilTimer
VStatsSpaceRegion VStatsSpaceTimer VStatsWindow))
(PROG (r1 r2 r3)
(CLEARW VStatsWindow)
(if (SETQ r1 VStatsClockRegion)
then (VStatsSetUpTimer VStatsClockTimer)
(VStatsDisplayClock))
(if (SETQ r2 VStatsSpaceRegion)
then (VStatsSetUpTimer VStatsSpaceTimer)
(VStatsDisplaySpace))
(if (SETQ r3 VStatsMUtilRegion)
then (VStatsSetUpTimer VStatsMUtilTimer)
(VStatsDisplayMUtil))
(if (AND r1 r2 r3)
then (VStatsDrawLine r1 r2)
(VStatsDrawLine r2 r3)
elseif (AND r1 r2)
then (VStatsDrawLine r1 r2)
elseif (AND r1 r3)
then (VStatsDrawLine r1 r3)
elseif (AND r2 r3)
then (VStatsDrawLine r2 r3])
(VStatsDrawLine
[LAMBDA (hiregion loregion) (* HaKo "16-Jan-86 13:56")
(DECLARE (GLOBALVARS VStatsDsp))
(PROG [(x1 (DSPLEFTMARGIN NIL VStatsDsp))
(x2 (DSPRIGHTMARGIN NIL VStatsDsp))
(y (SUB1 (HALF (PLUS (fetch (REGION BOTTOM) of hiregion)
(fetch (REGION TOP) of loregion]
(DRAWLINE x1 y x2 y 2 (QUOTE INVERT)
VStatsDsp])
(VStatsInit
[LAMBDA NIL (* HaKo "16-Jan-86 13:54")
(DECLARE (GLOBALVARS SCREENHEIGHT SCREENWIDTH VSTATS.BLACK? VSTATS.POSITION VStatsClockRegion
VStatsDsp VStatsMUtilPCTs VStatsMUtilRegion VStatsSpacePCTs
VStatsSpaceRegion VStatsWindow WBorder))
(PROG [clockwidth clockheight spacewidth spaceheight mutilwidth mutilheight wleft wbottom
wwidth wheight wposition wregion (width 0)
(height 0)
(bottom 0)
(border WBorder)
(spacing (HALF (TIMES 3 WBorder]
(if (WINDOWP VStatsWindow)
then (CLOSEW VStatsWindow)
(SETQ VStatsWindow))
(if (VStatsInitClock)
then (SETQ clockwidth (fetch (REGION WIDTH) of VStatsClockRegion))
(SETQ width (MAX width clockwidth))
(SETQ clockheight (fetch (REGION HEIGHT) of VStatsClockRegion))
(SETQ height (PLUS height clockheight spacing)))
(if (VStatsInitSpace)
then (SETQ spacewidth (fetch (REGION WIDTH) of VStatsSpaceRegion))
(SETQ width (MAX width spacewidth))
(SETQ spaceheight (fetch (REGION HEIGHT) of VStatsSpaceRegion))
(SETQ height (PLUS height spaceheight spacing)))
(if (VStatsInitMUtil)
then (SETQ mutilwidth (fetch (REGION WIDTH) of VStatsMUtilRegion))
(SETQ width (MAX width mutilwidth))
(SETQ mutilheight (fetch (REGION HEIGHT) of VStatsMUtilRegion))
(SETQ height (PLUS height mutilheight spacing)))
(if (ZEROP width)
then (RETURN))
(SETQ width (PLUS width spacing))
(SETQ wwidth (WIDTHIFWINDOW width border))
(SETQ wheight (HEIGHTIFWINDOW height NIL border))
(SETQ wposition (OR (POSITIONP VSTATS.POSITION)
(GETBOXPOSITION wwidth wheight NIL NIL NIL
"Indicate placement of VSTATS window:")))
[SETQ wleft (MAX 0 (MIN (fetch (POSITION XCOORD) of wposition)
(IDIFFERENCE SCREENWIDTH (ADD1 wwidth]
[SETQ wbottom (MAX 0 (MIN (fetch (POSITION YCOORD) of wposition)
(IDIFFERENCE SCREENHEIGHT (ADD1 wheight]
(if (NOT (POSITIONP VSTATS.POSITION))
then (SETQ VSTATS.POSITION (create POSITION
XCOORD ← wleft
YCOORD ← wbottom)))
(SETQ wregion (create REGION
LEFT ← wleft
BOTTOM ← wbottom
WIDTH ← wwidth
HEIGHT ← wheight))
(SETQ VStatsWindow (CREATEW wregion NIL border))
(SETQ VStatsDsp (WINDOWPROP VStatsWindow (QUOTE DSP)))
(if VSTATS.BLACK?
then (DSPTEXTURE BLACKSHADE VStatsDsp)
(DSPSOURCETYPE (QUOTE INVERT)
VStatsDsp))
(SETQ bottom (HALF (HALF spacing)))
(if VStatsMUtilRegion
then (VStatsCenterRegion VStatsMUtilRegion width bottom VStatsMUtilPCTs)
(SETQ bottom (PLUS bottom mutilheight spacing)))
(if VStatsSpaceRegion
then (VStatsCenterRegion VStatsSpaceRegion width bottom VStatsSpacePCTs)
(SETQ bottom (PLUS bottom spaceheight spacing)))
(if VStatsClockRegion
then (VStatsCenterRegion VStatsClockRegion width bottom)
(SETQ bottom (PLUS bottom clockheight spacing)))
(WINDOWPROP VStatsWindow (QUOTE REPAINTFN)
(FUNCTION VStatsDisplay))
[WINDOWPROP VStatsWindow (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (w)
(DECLARE (GLOBALVARS VStatsOff?))
(SETQ VStatsOff? T]
[WINDOWPROP VStatsWindow (QUOTE AFTERMOVEFN)
(FUNCTION (LAMBDA (w)
(DECLARE (GLOBALVARS VSTATS.POSITION))
(PROG ((r (WINDOWREGION w)))
(SETQ VSTATS.POSITION (create POSITION
XCOORD ←
(fetch (REGION LEFT)
of r)
YCOORD ←
(fetch (REGION BOTTOM)
of r]
[WINDOWPROP VStatsWindow (QUOTE BUTTONEVENTFN)
(FUNCTION (LAMBDA (w)
(if (LASTMOUSESTATE (ONLY LEFT))
then (VStatsDisplay)
elseif (LASTMOUSESTATE (ONLY MIDDLE))
then (VStatsSetOptions]
(WINDOWPROP VStatsWindow (QUOTE SHRINKFN)
(QUOTE DON'T))
(WINDOWPROP VStatsWindow (QUOTE RESHAPEFN)
(QUOTE DON'T))
(RETURN T])
(VStatsReDisplay?
[LAMBDA NIL (* HaKo "15-Jan-86 16:56")
(DECLARE (GLOBALVARS VStatsClockTimer VStatsMUtilTimer VStatsOff? VStatsSpaceTimer))
(if VStatsOff?
then (VSTATS (QUOTE Off))
else (if (VStatsTimerExpired? VStatsClockTimer)
then (VStatsReDisplayClock))
(if (VStatsTimerExpired? VStatsSpaceTimer)
then (VStatsReDisplaySpace))
(if (VStatsTimerExpired? VStatsMUtilTimer)
then (VStatsReDisplayMUtil])
(VStatsCreatePCTs
[LAMBDA (font names&labels) (* HaKo "15-Jan-86 15:43")
(PROG [pctlist (lblwidths 0)
(lblheight (TIMES 2 (FONTHEIGHT font)))
(barwidth (STRINGWIDTH "A" font))
(barheight (PLUS (FONTHEIGHT font)
(FONTPROP font (QUOTE ASCENT]
(SETQ pctlist
(for name&lbl in names&labels bind (name lbl lblwidth)
collect (SETQ name (CAR name&lbl))
(SETQ lbl (CDR name&lbl))
(SETQ lblwidth (STRINGWIDTH lbl font))
(SETQ lblwidths (PLUS lblwidths lblwidth))
(create VSTATSPCTINFO
NAME ← name
LABEL ← lbl
NEWPCT ← 0
OLDPCT ← 0
LBLREGION ←
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← lblwidth
HEIGHT ← lblheight)
BARREGION ←
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 0
HEIGHT ← barheight)
MAXBARHEIGHT ← barheight)))
[for pct in pctlist bind (r w x)
first (SETQ w (HALF (TIMES 3 barwidth)))
(SETQ x (DIFFERENCE w barwidth))
do (SETQ r (fetch (VSTATSPCTINFO BARREGION) of pct))
(replace (REGION LEFT) of r with x)
(replace (REGION WIDTH) of r with barwidth)
(SETQ r (fetch (VSTATSPCTINFO LBLREGION) of pct))
(replace (REGION LEFT) of r with (PLUS x w))
(SETQ x (PLUS w (fetch (REGION RIGHT) of r]
(RETURN pctlist])
(VStatsGetPCTsRegion
[LAMBDA (pctlist) (* HaKo "16-Jan-86 13:57")
(DECLARE (GLOBALVARS SCREENWIDTH))
(for pct in pctlist bind barregion lblregion (minleft ← SCREENWIDTH)
(maxright ← 0)
(maxheight ← 0)
do (SETQ barregion (fetch (VSTATSPCTINFO BARREGION) of pct))
(SETQ lblregion (fetch (VSTATSPCTINFO LBLREGION) of pct))
[SETQ minleft (MIN minleft (MIN (fetch (REGION LEFT) of barregion)
(fetch (REGION LEFT) of lblregion]
[SETQ maxright (MAX maxright (MAX (fetch (REGION RIGHT) of barregion)
(fetch (REGION RIGHT) of lblregion]
[SETQ maxheight (MAX maxheight (MAX (fetch (REGION HEIGHT) of barregion)
(fetch (REGION HEIGHT) of lblregion]
finally (RETURN (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← maxright
HEIGHT ← maxheight])
(VStatsCenterRegion
[LAMBDA (region width bottom pctlist) (* HaKo "15-Jan-86 15:43")
(PROG [(delta (HALF (DIFFERENCE width (fetch (REGION WIDTH) of region]
(replace (REGION LEFT) of region with delta)
(replace (REGION BOTTOM) of region with bottom)
(for pct in pctlist bind (r)
do (SETQ r (fetch (VSTATSPCTINFO BARREGION) of pct))
(replace (REGION LEFT) of r with (PLUS delta (fetch (REGION LEFT)
of r)))
(replace (REGION BOTTOM) of r with bottom)
(SETQ r (fetch (VSTATSPCTINFO LBLREGION) of pct))
(replace (REGION LEFT) of r with (PLUS delta (fetch (REGION LEFT)
of r)))
(replace (REGION BOTTOM) of r with bottom])
(VStatsDisplayPct
[LAMBDA (PCT BOX.ALWAYS?) (* HaKo "18-Feb-86 16:31")
(DECLARE (GLOBALVARS VSTATS.BLACK? VStatsDsp))
(PROG ((shade (if VSTATS.BLACK?
then WHITESHADE
else BLACKSHADE))
(oldpct (fetch (VSTATSPCTINFO OLDPCT) of PCT))
(newpct (fetch (VSTATSPCTINFO NEWPCT) of PCT))
(lblregion (fetch (VSTATSPCTINFO LBLREGION) of PCT))
(barregion (fetch (VSTATSPCTINFO BARREGION) of PCT))
(maxbarheight (fetch (VSTATSPCTINFO MAXBARHEIGHT) of PCT)))
(* * Print percentage as d.dd * *)
(MOVETO (fetch (REGION LEFT) of lblregion)
(fetch (REGION BOTTOM) of lblregion)
VStatsDsp)
(BOUT VStatsDsp (IPLUS (IQUOTIENT newpct 100)
(CHARCODE "0")))
(BOUT VStatsDsp (CHARCODE "."))
(BOUT VStatsDsp (IPLUS (IQUOTIENT (IREMAINDER newpct 100)
10)
(CHARCODE "0")))
(BOUT VStatsDsp (IPLUS (IREMAINDER newpct 10)
(CHARCODE "0")))
(* * Display percentage graphically in box * *)
(replace (REGION HEIGHT) of barregion with (IQUOTIENT (ITIMES newpct
maxbarheight)
100))
(if (OR BOX.ALWAYS? (LESSP newpct oldpct))
then (GRAYBOXAREA (fetch (REGION LEFT) of barregion)
(fetch (REGION BOTTOM) of barregion)
(fetch (REGION WIDTH) of barregion)
maxbarheight 1 shade VStatsDsp))
(DSPFILL barregion shade NIL VStatsDsp])
(VStatsSetOptions
[LAMBDA NIL (* HaKo " 3-Feb-86 14:56")
(DECLARE (GLOBALVARS VSTATS.BLACK? VSTATS.CLOCK.INTERVAL VSTATS.MUTIL.HYSTERESIS
VSTATS.MUTIL.INTERVAL VSTATS.SPACE.INTERVAL VSTATS.SPACE.SHOW.DISK?
VStatsDsp VStatsOptionsMenu VStatsWindow))
[if (NULL VStatsOptionsMenu)
then (SETQ VStatsOptionsMenu (create MENU
TITLE ← "VSTATS options"
CENTERFLG ← T
ITEMS ←
(QUOTE (("Invert Display" (QUOTE INVERTDSP)
"inverts color of VDATE display")
("Toggle Clock Display"
(QUOTE TOGGLECLOCK)
"switches display of clock on/off"
(SUBITEMS ("Toggle Seconds"
(QUOTE TOGGLESECS)
"switches display of seconds on/off")))
("Toggle Space Display"
(QUOTE TOGGLESPACE)
"switches display of memory utilization on/off"
(SUBITEMS ("Toggle Disk Display"
(QUOTE TOGGLEDISK)
"switches display of disk space on/off")))
("Toggle Machine Display"
(QUOTE TOGGLEMUTIL)
"switches display of machine utilization on/off"
(SUBITEMS ("Set Hysteresis"
(QUOTE SETMUTILHYST)
"Sets processor utilization display hysteresis"]
(SELECTQ (MENU VStatsOptionsMenu)
(NIL
(* * Buttoned outside menu so ignore)
NIL)
(INVERTDSP
(* * Change display from black to white or vice-versa)
(SETQ VSTATS.BLACK? (NOT VSTATS.BLACK?))
(if VStatsWindow
then (if VSTATS.BLACK?
then (DSPTEXTURE BLACKSHADE VStatsDsp)
(DSPSOURCETYPE (QUOTE INVERT)
VStatsDsp)
else (DSPTEXTURE WHITESHADE VStatsDsp)
(DSPSOURCETYPE (QUOTE INPUT)
VStatsDsp))
(VStatsDisplay)))
[TOGGLESECS
(* * Remove or add display of seconds. Have to switch VSTATS off and back on since window size changes.)
(SETQ VSTATS.CLOCK.INTERVAL (if (AND (NUMBERP
VSTATS.CLOCK.INTERVAL)
(LESSP VSTATS.CLOCK.INTERVAL
60))
then (TIMES 60 (RNUMBER
"Interval (mins):"))
else (RNUMBER "Interval (secs):")))
(if VStatsWindow
then (VSTATS (QUOTE Off))
(VSTATS (QUOTE On]
[TOGGLECLOCK
(* * Remove or add display of clock. Have to switch VSTATS off and back on since window size changes.)
(SETQ VSTATS.CLOCK.INTERVAL (if VSTATS.CLOCK.INTERVAL
then NIL
else (RNUMBER "Interval (secs):")))
(if VStatsWindow
then (VSTATS (QUOTE Off))
(VSTATS (QUOTE On]
[TOGGLESPACE
(* * Remove or add display of memory utilization. Have to switch VSTATS off and back on since window size changes.)
(SETQ VSTATS.SPACE.INTERVAL (if VSTATS.SPACE.INTERVAL
then NIL
else (RNUMBER "Interval (secs):")))
(if VStatsWindow
then (VSTATS (QUOTE Off))
(VSTATS (QUOTE On]
[TOGGLEDISK
(* * Turns display of disk space utilization on/off)
(SETQ VSTATS.SPACE.SHOW.DISK? (NOT VSTATS.SPACE.SHOW.DISK?))
(if VStatsWindow
then (VSTATS (QUOTE Off))
(VSTATS (QUOTE On]
[TOGGLEMUTIL
(* * Remove or add display of machine utilization. Have to switch VSTATS off and back on since window size
changes.)
(SETQ VSTATS.MUTIL.INTERVAL (if VSTATS.MUTIL.INTERVAL
then NIL
else (RNUMBER "Interval (secs):")))
(if VSTATS.MUTIL.INTERVAL
then (SETQ VSTATS.MUTIL.HYSTERESIS (RNUMBER "Hysteresis:")))
(if VStatsWindow
then (VSTATS (QUOTE Off))
(VSTATS (QUOTE On]
[SETMUTILHYST
(* * Set hysteresis on machine utilization display. The greater the hysteresis, the slower the display changes.)
(if VSTATS.MUTIL.INTERVAL
then (SETQ VSTATS.MUTIL.HYSTERESIS (RNUMBER "Hysteresis:"))
(VStatsInitMUtilState T)
(if VStatsWindow
then (VStatsDisplay]
(SHOULDNT])
(VStatsSetUpTimer
[LAMBDA (TIMERINFO) (* HaKo "15-Jan-86 16:51")
(\RCLK (fetch (VSTATSTIMERINFO LASTSETUP) of TIMERINFO))
(SETUPTIMER (fetch (VSTATSTIMERINFO INTERVAL) of TIMERINFO)
(fetch (VSTATSTIMERINFO TIMER) of TIMERINFO)
(QUOTE TICKS])
(VStatsTimerExpired?
[LAMBDA (TIMERINFO) (* HaKo "15-Jan-86 17:06")
(* * Knowing the last time the timer was set allows us to test for wrap around. Using the standard TIMEREXPIRED?
the timer could be set at some big positive number (say MAX.FIXP -
100), If we don't get to check the machine clock between the timer's value and the largest positive number the
machine clock will wrap around to some big negative number (say MAX.FIXP + 100) and it will be quite a while before
the machine clock is again GREATERP than our timer!)
(DECLARE (GLOBALVARS VStatsCurrentTime))
(\RCLK VStatsCurrentTime)
(if (OR (IGREATERP VStatsCurrentTime (fetch (VSTATSTIMERINFO TIMER) of TIMERINFO))
(ILESSP VStatsCurrentTime (fetch (VSTATSTIMERINFO LASTSETUP) of TIMERINFO)))
then (VStatsSetUpTimer TIMERINFO])
)
(* * clock support stuff * *)
(RPAQQ VStatsClockFont NIL)
(RPAQQ VStatsResetClock? NIL)
(RPAQ VStatsClockTimer (create VSTATSTIMERINFO))
(DEFINEQ
(VStatsDisplayClock
[LAMBDA NIL (* HaKo " 1-Aug-85 12:16")
(DECLARE (GLOBALVARS VStatsClockDay VStatsClockDayPos VStatsClockFont VStatsClockHr
VStatsClockHrPos VStatsClockMin VStatsClockMinPos VStatsClockMon
VStatsClockMonPos VStatsClockRegion VStatsClockSec VStatsClockSecPos
VStatsClockXPos VStatsClockYPos VStatsClockYr VStatsClockYrPos
VStatsDisplayClockSeconds? VStatsDsp))
(VStatsGetClock)
(SETQ VStatsClockXPos (fetch (REGION LEFT) of VStatsClockRegion))
[SETQ VStatsClockYPos (PLUS (fetch (REGION BOTTOM) of VStatsClockRegion)
(FONTPROP VStatsClockFont (QUOTE DESCENT]
(MOVETO VStatsClockXPos VStatsClockYPos VStatsDsp)
(DSPFONT VStatsClockFont VStatsDsp)
(SETQ VStatsClockDayPos (DSPXPOSITION NIL VStatsDsp))
(VStatsDisplayClockDigits VStatsClockDayPos VStatsClockDay)
(BOUT VStatsDsp (CHARCODE "-"))
(SETQ VStatsClockMonPos (DSPXPOSITION NIL VStatsDsp))
(VStatsDisplayClockMonth VStatsClockMonPos VStatsClockMon)
(BOUT VStatsDsp (CHARCODE "-"))
(SETQ VStatsClockYrPos (DSPXPOSITION NIL VStatsDsp))
(VStatsDisplayClockDigits VStatsClockYrPos VStatsClockYr)
(BOUT VStatsDsp (CHARCODE " "))
(SETQ VStatsClockHrPos (DSPXPOSITION NIL VStatsDsp))
(VStatsDisplayClockDigits VStatsClockHrPos VStatsClockHr)
(BOUT VStatsDsp (CHARCODE ":"))
(SETQ VStatsClockMinPos (DSPXPOSITION NIL VStatsDsp))
(VStatsDisplayClockDigits VStatsClockMinPos VStatsClockMin)
(if VStatsDisplayClockSeconds?
then (BOUT VStatsDsp (CHARCODE ":"))
(SETQ VStatsClockSecPos (DSPXPOSITION NIL VStatsDsp))
(VStatsDisplayClockDigits VStatsClockSecPos VStatsClockSec])
(VStatsDisplayClockDigits
[LAMBDA (dspxpos n) (* HaKo " 1-Aug-85 10:10")
(DECLARE (GLOBALVARS VStatsDsp))
(DSPXPOSITION dspxpos VStatsDsp)
(BOUT VStatsDsp (IPLUS (IQUOTIENT (IREMAINDER n 100)
10)
(CHARCODE "0")))
(BOUT VStatsDsp (IPLUS (IREMAINDER n 10)
(CHARCODE "0"])
(VStatsDisplayClockMonth
[LAMBDA (dspxpos m) (* HaKo " 1-Aug-85 10:13")
(DECLARE (GLOBALVARS VStatsDsp))
(PROG ((i (ADD1 (ITIMES 3 m)))
(lbl "JanFebMarAprMayJunJulAugSepOctNovDec"))
(DSPXPOSITION dspxpos VStatsDsp)
(BOUT VStatsDsp (OR (NTHCHARCODE lbl i)
(CHARCODE "?")))
(BOUT VStatsDsp (OR (NTHCHARCODE lbl (IPLUS i 1))
(CHARCODE "?")))
(BOUT VStatsDsp (OR (NTHCHARCODE lbl (IPLUS i 2))
(CHARCODE "?"])
(VStatsGetClock
[LAMBDA NIL (* HaKo "30-Jul-85 11:31")
(APPLY (FUNCTION [LAMBDA (yr mon day hr min sec dst)
(SETQ VStatsClockDay day)
(SETQ VStatsClockMon mon)
(SETQ VStatsClockYr yr)
(SETQ VStatsClockHr hr)
(SETQ VStatsClockMin min)
(SETQ VStatsClockSec sec])
(\UNPACKDATE])
(VStatsInitClock
[LAMBDA NIL (* HaKo "15-Jan-86 16:59")
(* * If the clock interval is not a FIXP or not positive, the clock display is disabled.)
(DECLARE (GLOBALVARS VSTATS.CLOCK.INTERVAL VStatsClockFont VStatsClockRegion VStatsClockTimer
VStatsDisplayClockSeconds?))
(if (AND (NUMBERP VSTATS.CLOCK.INTERVAL)
(GREATERP VSTATS.CLOCK.INTERVAL 0))
then (PROG ((datestr (DATE)))
(replace (VSTATSTIMERINFO INTERVAL) of VStatsClockTimer
with (CLOCKTICKS (MIN (CONSTANT (TIMES 15 60))
(MAX 1 VSTATS.CLOCK.INTERVAL))
(QUOTE SECONDS)))
[if (NULL VStatsClockFont)
then (SETQ VStatsClockFont (FONTCREATE (QUOTE (GACHA 12 BOLD]
(SETQ VStatsDisplayClockSeconds? (LESSP VSTATS.CLOCK.INTERVAL 60))
(if (NOT VStatsDisplayClockSeconds?)
then (SETQ datestr (SUBSTRING datestr 1 -4)))
(SETQ VStatsClockRegion (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← (STRINGWIDTH datestr
VStatsClockFont)
HEIGHT ← (FONTHEIGHT VStatsClockFont)))
(RETURN T))
else (SETQ VStatsClockRegion NIL])
(VStatsReDisplayClock
[LAMBDA NIL (* HaKo "26-Mar-86 15:52")
(DECLARE (GLOBALVARS VSTATS.ALWAYS? VStatsClockDay VStatsClockDayPos VStatsClockFont
VStatsClockHr VStatsClockHrPos VStatsClockMin VStatsClockMinPos
VStatsClockMon VStatsClockMonPos VStatsClockSec VStatsClockSecPos
VStatsClockYPos VStatsClockYr VStatsClockYrPos
VStatsDisplayClockSeconds? VStatsDsp VStatsResetClock? VStatsWindow))
(if (OR VSTATS.ALWAYS? (TOPWP VStatsWindow))
then (PROG ((oldday VStatsClockDay)
(oldmon VStatsClockMon)
(oldyr VStatsClockYr)
(oldhr VStatsClockHr)
(oldmin VStatsClockMin)
(oldsec VStatsClockSec))
(DSPFONT VStatsClockFont VStatsDsp)
(DSPYPOSITION VStatsClockYPos VStatsDsp)
(VStatsGetClock)
(if (NEQ VStatsClockDay oldday)
then (SETQ VStatsResetClock? T))
(if (AND VStatsResetClock? (NEQ VStatsClockHr oldhr)
(\NET.SETTIME))
then (SETQ VStatsResetClock? NIL)
(VStatsGetClock))
(if (NEQ VStatsClockDay oldday)
then (VStatsDisplayClockDigits VStatsClockDayPos VStatsClockDay))
(if (NEQ VStatsClockMon oldmon)
then (VStatsDisplayClockMonth VStatsClockMonPos VStatsClockMon))
(if (NEQ VStatsClockYr oldyr)
then (VStatsDisplayClockDigits VStatsClockYrPos VStatsClockYr))
(if (NEQ VStatsClockHr oldhr)
then (VStatsDisplayClockDigits VStatsClockHrPos VStatsClockHr))
(if (NEQ VStatsClockMin oldmin)
then (VStatsDisplayClockDigits VStatsClockMinPos VStatsClockMin))
(if (AND VStatsDisplayClockSeconds? (NEQ VStatsClockSec oldsec))
then (VStatsDisplayClockDigits VStatsClockSecPos VStatsClockSec])
)
(* * space support stuff * *)
(RPAQQ VStatsSpaceFont NIL)
(RPAQ VStatsSpaceTimer (create VSTATSTIMERINFO))
(RPAQQ VStatsSpacePCTs NIL)
(RPAQQ VStatsSpaceDiskPages NIL)
(RPAQ? \LASTVMEMFILEPAGE 16383)
(DEFINEQ
(VStatsDisplaySpace
[LAMBDA NIL (* HaKo "18-Feb-86 16:13")
(DECLARE (GLOBALVARS VStatsDsp VStatsSpaceFont VStatsSpacePCTs VStatsSpaceRegion))
(PROG [x (xoffset (fetch (REGION LEFT) of VStatsSpaceRegion))
(yoffset (PLUS (fetch (REGION BOTTOM) of VStatsSpaceRegion)
(FONTPROP VStatsSpaceFont (QUOTE HEIGHT]
(DSPFONT VStatsSpaceFont VStatsDsp)
(MOVETO xoffset yoffset VStatsDsp)
(for PCT in VStatsSpacePCTs
do (DSPXPOSITION (fetch (REGION LEFT) of (fetch (VSTATSPCTINFO LBLREGION)
of PCT))
VStatsDsp)
(printout VStatsDsp (fetch (VSTATSPCTINFO LABEL) of PCT)))
(TERPRI VStatsDsp)
(SETQ yoffset (DSPYPOSITION NIL VStatsDsp))
(VStatsGetSpace)
(for PCT in VStatsSpacePCTs
do (replace (REGION BOTTOM) of (fetch (VSTATSPCTINFO LBLREGION) of PCT)
with yoffset)
(replace (REGION BOTTOM) of (fetch (VSTATSPCTINFO BARREGION) of PCT)
with yoffset)
(VStatsDisplayPct PCT T])
(VStatsGetSpace
[LAMBDA NIL (* HaKo "15-Jan-86 12:37")
(* DECLARATIONS: (RECORD SPACEDATA
(MDSFREE MDSFRAC 8MBFRAC ATOMSFREE ATOMFRAC)))
(DECLARE (GLOBALVARS VStatsSpaceDiskPages VStatsSpacePCTs \LASTVMEMFILEPAGE))
(for PCT in VStatsSpacePCTs bind (heap ← (STORAGE.LEFT))
do (replace (VSTATSPCTINFO OLDPCT) of PCT with (fetch (VSTATSPCTINFO NEWPCT)
of PCT))
(replace (VSTATSPCTINFO NEWPCT) of PCT
with (SELECTQ (fetch (VSTATSPCTINFO NAME) of PCT)
[DATA (FIX (FDIFFERENCE 100.5 (FTIMES 100.0
(fetch MDSFRAC
of heap]
[ATOM (FIX (FDIFFERENCE 100.5 (FTIMES 100.0
(fetch ATOMFRAC
of heap]
(VMEM (QUOTIENT (PLUS (TIMES 100 (VMEMSIZE))
(HALF \LASTVMEMFILEPAGE))
\LASTVMEMFILEPAGE))
(DISK (QUOTIENT (PLUS (TIMES 100 (DIFFERENCE
VStatsSpaceDiskPages
(DISKFREEPAGES
)))
(HALF VStatsSpaceDiskPages))
VStatsSpaceDiskPages))
(SHOULDNT])
(VStatsInitSpace
[LAMBDA NIL (* HaKo "15-Jan-86 17:01")
(* * If the space interval is not a FIXP or not positive, the space display is disabled, and this function returns
NIL. Otherwise it returns the region required for the space display.)
(DECLARE (GLOBALVARS VSTATS.SPACE.INTERVAL VSTATS.SPACE.SHOW.DISK? VStatsSpaceDiskPages
VStatsSpaceFont VStatsSpacePCTs VStatsSpaceRegion VStatsSpaceTimer))
(if (AND (NUMBERP VSTATS.SPACE.INTERVAL)
(GREATERP VSTATS.SPACE.INTERVAL 0))
then (replace (VSTATSTIMERINFO INTERVAL) of VStatsSpaceTimer
with (CLOCKTICKS (MIN VSTATS.SPACE.INTERVAL (CONSTANT (TIMES 15 60)))
(QUOTE SECONDS)))
[if (NULL VStatsSpaceFont)
then (SETQ VStatsSpaceFont (FONTCREATE (QUOTE (GACHA 10]
(SETQ VStatsSpaceDiskPages (if VSTATS.SPACE.SHOW.DISK?
then (DISKTOTALPAGES)))
[SETQ VStatsSpacePCTs (VStatsCreatePCTs VStatsSpaceFont
(if VStatsSpaceDiskPages
then (QUOTE ((DATA . "Data")
(ATOM . "Atom")
(VMEM . "VMem")
(DISK . "Disk")))
else (QUOTE ((DATA . "Data")
(ATOM . "Atom")
(VMEM . "VMem"]
(SETQ VStatsSpaceRegion (VStatsGetPCTsRegion VStatsSpacePCTs))
else (SETQ VStatsSpaceRegion NIL])
(VStatsReDisplaySpace
[LAMBDA NIL (* HaKo "26-Mar-86 15:53")
(DECLARE (GLOBALVARS VSTATS.ALWAYS? VStatsDsp VStatsSpaceFont VStatsSpacePCTs VStatsWindow))
(VStatsGetSpace)
(PROG [(flashes (for pct in VStatsSpacePCTs sum (MAX 0 (DIFFERENCE
(fetch (VSTATSPCTINFO NEWPCT)
of pct)
90]
(if (OR VSTATS.ALWAYS? (GREATERP flashes 0)
(TOPWP VStatsWindow))
then (DSPFONT VStatsSpaceFont VStatsDsp)
(for pct in VStatsSpacePCTs when (NEQ (fetch (VSTATSPCTINFO NEWPCT)
of pct)
(fetch (VSTATSPCTINFO OLDPCT)
of pct))
do (VStatsDisplayPct pct))
(if (GREATERP flashes 0)
then (FLASHWINDOW VStatsWindow flashes)
(VStatsShrinkSpaceInterval (TIMES 5 flashes])
(VStatsShrinkSpaceInterval
[LAMBDA (shrinkpct) (* HaKo "19-Feb-86 16:40")
(DECLARE (GLOBALVARS VStatsSpaceTimer))
(PROG ([delta (MAX 50 (DIFFERENCE 100 (OR shrinkpct 25]
(oldint (fetch (VSTATSTIMERINFO INTERVAL) of VStatsSpaceTimer))
newint)
[SETQ newint (MAX (QUOTIENT (TIMES oldint delta)
100)
(CLOCKTICKS 30 (QUOTE SECONDS]
(if (LESSP newint oldint)
then (replace (VSTATSTIMERINFO INTERVAL) of VStatsSpaceTimer with newint)
(VStatsSetUpTimer VStatsSpaceTimer])
)
(* * machine utilization support stuff * *)
(RPAQQ VStatsMUtilFont NIL)
(RPAQ VStatsMUtilTimer (create VSTATSTIMERINFO))
(RPAQQ VStatsMUtilPCTs NIL)
(RPAQQ VStatsMUtilOrigState NIL)
(DEFINEQ
(VStatsDisplayMUtil
[LAMBDA NIL (* HaKo "18-Feb-86 16:13")
(DECLARE (GLOBALVARS VStatsDsp VStatsMUtilFont VStatsMUtilPCTs VStatsMUtilRegion))
(PROG [x (xoffset (fetch (REGION LEFT) of VStatsMUtilRegion))
(yoffset (PLUS (fetch (REGION BOTTOM) of VStatsMUtilRegion)
(FONTPROP VStatsMUtilFont (QUOTE HEIGHT]
(DSPFONT VStatsMUtilFont VStatsDsp)
(MOVETO xoffset yoffset VStatsDsp)
(for PCT in VStatsMUtilPCTs
do (DSPXPOSITION (fetch (REGION LEFT) of (fetch (VSTATSPCTINFO LBLREGION)
of PCT))
VStatsDsp)
(printout VStatsDsp (fetch (VSTATSPCTINFO LABEL) of PCT)))
(TERPRI VStatsDsp)
(SETQ yoffset (DSPYPOSITION NIL VStatsDsp))
(VStatsGetMUtil)
(for PCT in VStatsMUtilPCTs
do (replace (REGION BOTTOM) of (fetch (VSTATSPCTINFO LBLREGION) of PCT)
with yoffset)
(replace (REGION BOTTOM) of (fetch (VSTATSPCTINFO BARREGION) of PCT)
with yoffset)
(VStatsDisplayPct PCT T])
(VStatsGetMUtil
[LAMBDA NIL (* HaKo "16-Jan-86 14:17")
(* DECLARATIONS: (BLOCKRECORD MISCSTATS ((STARTTIME FIXP) (TOTALTIME FIXP) (SWAPWAITTIME FIXP)
(PAGEFAULTS FIXP) (SWAPWRITES FIXP) (DISKIOTIME FIXP) (DISKOPS FIXP) (KEYBOARDWAITTIME FIXP)
(GCTIME FIXP) (NETIOTIME FIXP) (NETIOOPS FIXP) (SWAPTEMP0 FIXP) (SWAPTEMP1 FIXP) (RCLKSECOND FIXP)
(SECONDSCLOCK FIXP) (MILLISECONDSCLOCK FIXP) (BASECLOCK FIXP) (RCLKTEMP0 FIXP) (SECONDSTMP FIXP)
(MILLISECONDSTMP FIXP) (BASETMP FIXP) (EXCESSTIMETMP FIXP) (CLOCKTEMP0 FIXP) (DISKTEMP0 FIXP)
(DISKTEMP1 FIXP) (TELERAIDTEMP1 FIXP) (TELERAIDTEMP2 FIXP) (TELERAIDTEMP3 FIXP) (LASTUSERACTION FIXP)
(DLMOUSETIMER FIXP) (DLMOUSETEMP FIXP))))
(* State is kept on a LIST whose CAR is a FIXP given to CLOCK0 to obtain elapsed time, and whose CADR is a
blockrecord a la \MISCSTATS. The functions CREATEMISCSTATS COPYMISCSTATS and DIFFMISCSTATS are peovided by
Interlisp-D (cf. file SOURCES>DMISC (-- contains the \MISCSTAT record decl also)))
(* * (To reinitialize, execute (SETQ VStatsMUtilOrigState)))
(DECLARE (GLOBALVARS VStatsMUtilDiffState VStatsMUtilNextState VStatsMUtilOrigState
VStatsMUtilPCTs VStatsMUtilStateRing))
(PROG (oldstate newstate elapsed sw gc io cpu)
(if VStatsMUtilStateRing
then (SETQ newstate (pop VStatsMUtilStateRing))
(SETQ oldstate (CAR VStatsMUtilStateRing))
else (SETQ newstate VStatsMUtilNextState)
(SETQ oldstate VStatsMUtilOrigState))
(COPYMISCSTATS newstate)
(DIFFMISCSTATS oldstate newstate VStatsMUtilDiffState)
(SETQ elapsed (CAR VStatsMUtilDiffState))
[SETQ sw (MAX 0 (fetch (MISCSTATS SWAPWAITTIME) of (CADR VStatsMUtilDiffState]
[SETQ gc (MAX 0 (fetch (MISCSTATS GCTIME) of (CADR VStatsMUtilDiffState]
[SETQ io (PLUS (MAX 0 (fetch (MISCSTATS NETIOTIME) of (CADR
VStatsMUtilDiffState)))
(MAX 0 (fetch (MISCSTATS DISKIOTIME) of (CADR
VStatsMUtilDiffState]
[SETQ cpu (MAX 0 (DIFFERENCE elapsed (PLUS sw gc io]
(if (ZEROP (SETQ elapsed (PLUS cpu sw gc io)))
then (SETQ elapsed 1))
(for PCT in VStatsMUtilPCTs
do (replace (VSTATSPCTINFO OLDPCT) of PCT with (fetch (VSTATSPCTINFO NEWPCT)
of PCT))
(replace (VSTATSPCTINFO NEWPCT) of PCT
with (SELECTQ (fetch (VSTATSPCTINFO NAME) of PCT)
(CPU (QUOTIENT (PLUS (TIMES 100 cpu)
(HALF elapsed))
elapsed))
(IO (QUOTIENT (PLUS (TIMES 100 io)
(HALF elapsed))
elapsed))
(GC (QUOTIENT (PLUS (TIMES 100 gc)
(HALF elapsed))
elapsed))
(SWAP (QUOTIENT (PLUS (TIMES 100 sw)
(HALF elapsed))
elapsed))
(SHOULDNT])
(VStatsInitMUtil
[LAMBDA NIL (* HaKo "16-Jan-86 14:36")
(* * If the machine utilization interval is not a FIXP or not positive, the machine utilization display is
disabled, and this function returns NIL. Otherwise it returns the region required for the machine utilization
display.)
(DECLARE (GLOBALVARS AFTERLOGOUTFORMS VSTATS.MUTIL.INTERVAL VStatsMUtilFont VStatsMUtilPCTs
VStatsMUtilRegion VStatsMUtilTimer))
(if (AND (NUMBERP VSTATS.MUTIL.INTERVAL)
(GREATERP VSTATS.MUTIL.INTERVAL 0))
then (VStatsInitMUtilState)
[OR (MEMBER (QUOTE (VStatsInitMUtilState))
AFTERLOGOUTFORMS)
(push AFTERLOGOUTFORMS (QUOTE (VStatsInitMUtilState]
(replace (VSTATSTIMERINFO INTERVAL) of VStatsMUtilTimer
with (CLOCKTICKS (MIN VSTATS.MUTIL.INTERVAL (CONSTANT (TIMES 5 60)))
(QUOTE SECONDS)))
[if (NULL VStatsMUtilFont)
then (SETQ VStatsMUtilFont (FONTCREATE (QUOTE (GACHA 10]
[SETQ VStatsMUtilPCTs (VStatsCreatePCTs VStatsMUtilFont (QUOTE ((CPU . " CPU")
(IO . " I/O")
(GC . " GC")
(SWAP .
"Swap"]
(SETQ VStatsMUtilRegion (VStatsGetPCTsRegion VStatsMUtilPCTs))
else (SETQ AFTERLOGOUTFORMS (REMOVE (QUOTE (VStatsInitMUtilState))
AFTERLOGOUTFORMS))
(SETQ VStatsMUtilRegion NIL])
(VStatsInitMUtilState
[LAMBDA (DONT.SET.ORIG?) (* HaKo " 3-Feb-86 14:45")
(DECLARE (GLOBALVARS VSTATS.MUTIL.HYSTERESIS VStatsMUtilDiffState VStatsMUtilNextState
VStatsMUtilOrigState VStatsMUtilStateRing))
(if (NULL VStatsMUtilOrigState)
then (SETQ VStatsMUtilOrigState (CREATEMISCSTATS NIL T))
(SETQ VStatsMUtilDiffState (CREATEMISCSTATS NIL T))
(SETQ VStatsMUtilNextState)
(SETQ VStatsMUtilStateRing))
(if VStatsMUtilStateRing
then (* Break the old ring so it can be GC'd)
(RPLACD VStatsMUtilStateRing))
(OR DONT.SET.ORIG? (COPYMISCSTATS VStatsMUtilOrigState))
(if (AND (NUMBERP VSTATS.MUTIL.HYSTERESIS)
(GREATERP VSTATS.MUTIL.HYSTERESIS 0))
then (* Build a ring of MISCSTATS records)
[SETQ VStatsMUtilStateRing (for i from 0 to VSTATS.MUTIL.HYSTERESIS
bind s collect (PROG1 (SETQ s
(CREATEMISCSTATS
NIL T))
(COPYMISCSTATS s]
(* Complete the circle)
(RPLACD (LAST VStatsMUtilStateRing)
VStatsMUtilStateRing)
(SETQ VStatsMUtilNextState)
else (SETQ VStatsMUtilNextState (CREATEMISCSTATS NIL T))
(COPYMISCSTATS VStatsMUtilNextState)
(SETQ VStatsMUtilStateRing])
(VStatsReDisplayMUtil
[LAMBDA NIL (* HaKo "26-Mar-86 15:53")
(DECLARE (GLOBALVARS VSTATS.ALWAYS? VStatsDsp VStatsMUtilFont VStatsMUtilPCTs VStatsWindow))
(if (OR VSTATS.ALWAYS? (TOPWP VStatsWindow))
then (VStatsGetMUtil)
(DSPFONT VStatsMUtilFont VStatsDsp)
(for pct in VStatsMUtilPCTs when (NEQ (fetch (VSTATSPCTINFO NEWPCT)
of pct)
(fetch (VSTATSPCTINFO OLDPCT)
of pct))
do (VStatsDisplayPct pct])
)
(* * These ought to be system functions!!! * *)
(DECLARE: EVAL@COMPILE
(PUTPROPS HALF MACRO ((X)
(QUOTIENT X 2)))
)
(DEFINEQ
(CLOCKTICKS
[LAMBDA (interval timerunits) (* HaKo "12-Aug-85 09:05")
(DECLARE (GLOBALVARS \RCLKSECOND))
(PROG ((ticks (if (NULL interval)
then 1
elseif (NOT (NUMBERP interval))
then (ERROR "Non-numeric arg: " interval)
elseif (NOT (GREATERP interval 0))
then (ERROR "Non-positive arg: " interval)
else interval)))
(SELECTQ (U-CASE timerunits)
((TICK TICKS))
((MSEC MILLISEC MSECS MILLISECS)
(SETQ ticks (TIMES .001 \RCLKSECOND ticks)))
((NIL SEC SECOND SECS SECONDS)
(SETQ ticks (TIMES \RCLKSECOND ticks)))
((MIN MINUTE MINS MINUTES)
(SETQ ticks (TIMES 60 \RCLKSECOND ticks)))
((HR HOUR HRS HOURS)
(SETQ ticks (TIMES 3600 \RCLKSECOND ticks)))
(ERROR "unknown timerunits: " timerunits))
(RETURN (if (FLOATP ticks)
then (FIX (FPLUS ticks .5))
else ticks])
(DISKTOTALPAGES
[LAMBDA (DSK RECOMPUTE) (* HaKo "14-Jan-86 16:08")
(SELECTQ (MACHINETYPE)
((DANDELION DAYBREAK DOVE)
(if (EQ (QUOTE DSK)
(FILENAMEFIELD (DIRECTORYNAME "{DSK}")
(QUOTE HOST)))
then (VOLUMESIZE DSK RECOMPUTE)))
NIL])
)
(* Lisp before Lute version does not have a TOPWP function to test if window is on top)
(DEFINEQ
(VStatsTOPWP
[LAMBDA (WINDOW) (* HaKo " 8-Jul-85 14:27")
(DECLARE (GLOBALVARS TOPW))
(* * NOTE: the calls to FETCHFIELD should be replaced by the indicated fetch instructions)
(if (OPENWP WINDOW)
then (PROG (R (W TOPW))
LP (COND
((EQ W WINDOW)
(RETURN WINDOW))
([REGIONSINTERSECTP (FETCHFIELD (QUOTE (WINDOW 6 POINTER))
W)
(OR R (SETQ R (FETCHFIELD (QUOTE (WINDOW
6 POINTER))
WINDOW]
(* * (REGIONSINTERSECTP (fetch (WINDOW REG) of W) (OR R (SETQ R (fetch (WINDOW REG) of WINDOW)))))
(RETURN NIL))
((SETQ W (FETCHFIELD (QUOTE (WINDOW 2 POINTER))
W))
(* * (SETQ W (fetch (WINDOW NEXTW) of X)))
(GO LP])
)
(MOVD? (QUOTE VStatsTOPWP)
(QUOTE TOPWP))
(* * Initialize on LOAD * *)
(RPAQQ BackgroundMenu NIL)
(ADDTOVAR BackgroundMenuCommands ("VStats" (NILL (VSTATS (QUOTE On)))
"Running display of clock and/or space utilization"))
[COND ((OR VSTATS.CLOCK.INTERVAL VSTATS.SPACE.INTERVAL VSTATS.MUTIL.INTERVAL)
(VSTATS (QUOTE On]
(PUTPROPS VSTATS COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2826 3956 (VSTATS 2836 . 3954)) (4828 22852 (VStatsDisplay 4838 . 5882) (VStatsDrawLine
5884 . 6335) (VStatsInit 6337 . 10959) (VStatsReDisplay? 10961 . 11533) (VStatsCreatePCTs 11535 .
13269) (VStatsGetPCTsRegion 13271 . 14342) (VStatsCenterRegion 14344 . 15225) (VStatsDisplayPct 15227
. 16908) (VStatsSetOptions 16910 . 21560) (VStatsSetUpTimer 21562 . 21900) (VStatsTimerExpired? 21902
. 22850)) (23011 29665 (VStatsDisplayClock 23021 . 24936) (VStatsDisplayClockDigits 24938 . 25349) (
VStatsDisplayClockMonth 25351 . 25942) (VStatsGetClock 25944 . 26340) (VStatsInitClock 26342 . 27717)
(VStatsReDisplayClock 27719 . 29663)) (29897 35565 (VStatsDisplaySpace 29907 . 31109) (VStatsGetSpace
31111 . 32427) (VStatsInitSpace 32429 . 33954) (VStatsReDisplaySpace 33956 . 34907) (
VStatsShrinkSpaceInterval 34909 . 35563)) (35774 43907 (VStatsDisplayMUtil 35784 . 36986) (
VStatsGetMUtil 36988 . 40135) (VStatsInitMUtil 40137 . 41726) (VStatsInitMUtilState 41728 . 43319) (
VStatsReDisplayMUtil 43321 . 43905)) (44035 45478 (CLOCKTICKS 44045 . 45110) (DISKTOTALPAGES 45112 .
45476)) (45575 46480 (VStatsTOPWP 45585 . 46478)))))
STOP