/ivy/binding/calendar/calSupportImpl.mesa
Last edited by: Binding, July 21, 1984
Last Edited by: Binding, August 16, 1984 2:29:29 pm PDT
DIRECTORY
BasicTime USING [ GMT, Unpacked, Pack, Unpack, Now],
Buttons USING [ Button, Create, SetDisplayStyle],
Calendar USING [ Days, Weekdays, Months, Years, Date, ZoomLevel],
CalSupport,
CalBrowser USING [ DisplayEvents, HickoryChange],
CalForm USING [ DestroyViewer, HickoryChange],
CalNuts USING [ RegisterWithNuts],
CalStorage USING [ protData, GetEventsOfDay, DestroyAllViewers, HickoryChange, Mode],
Commander USING [ Register, CommandProc],
Containers USING [ Create],
Hickory USING [ EventList, RegisterNotifyProc, NotifyProc, Reason, Event, EventTuple],
Icons USING [ NewIconFromFile, IconFlavor],
Menus USING [ Menu, MenuEntry, CreateEntry, CreateMenu, AppendMenuEntry, MenuProc],
MessageWindow USING [ Append, Blink],
Nut USING [ DeRegister],
Rope USING [ ROPE],
RopeSets USING [ RopeSet],
ViewerClasses USING [ ViewerRec, Viewer],
ViewerOps USING [ DestroyViewer],
ViewerSpecs USING [ messageWindowHeight, openLeftWidth, openLeftTopY, openBottomY],
ViewerTools USING [ MakeNewTextViewer, InhibitUserEdits, SetContents]
;
CalSupportImpl: CEDAR MONITOR
LOCKS CalStorage.protData
IMPORTS BasicTime, Buttons, CalBrowser, CalForm, CalNuts, CalStorage, Commander, Containers, Hickory, Menus, MessageWindow, ViewerTools, ViewerOps, ViewerSpecs, Icons, Nut
EXPORTS CalSupport
SHARES CalBrowser, CalStorage, CalForm, CalNuts
= BEGIN OPEN Calendar, CalStorage.protData, Hickory;
Constants
RowHeight: PUBLIC CARDINAL ← ViewerSpecs.messageWindowHeight+2;
FormWidth: PUBLIC CARDINAL ← ViewerSpecs.openLeftWidth;
FormHeight: PUBLIC CARDINAL ← ViewerSpecs.openLeftTopY - ViewerSpecs.openBottomY - RowHeight;
-- dealing with the icons: we read them in from the files when starting up, so it's faster and
-- maybe also more robust... Currently the nbr of icons Icons can deal with seems to limited to
-- around 30. So for now you can't get one icon for every day viewer. Sorry.
icons: ARRAY [ 1..4] OF Icons.IconFlavor;
IconFile2: Rope.ROPE ← "CalendarDays.icons";
IconFile: Rope.ROPE ← "Calendar.icons";
ReadInAllIcons: PROC = BEGIN
icons[ 1] ← Icons.NewIconFromFile[ file: IconFile2, n: 12]; -- are you superstitious?
icons[ 2] ← Icons.NewIconFromFile[ file: IconFile, n: 0];
icons[ 3] ← Icons.NewIconFromFile[ file: IconFile, n: 1];
icons[ 4] ← Icons.NewIconFromFile[ file: IconFile, n: 5];
END; -- ReadInAllIcons
GetIconFlavor: PUBLIC PROCEDURE [ mode: CalStorage.Mode, zoom: ZoomLevel ← unspecified, day: Days ← 1] RETURNS [ icon: Icons.IconFlavor] = BEGIN
returns the appropriate Icon for the configuration of the calendar.
IF mode = Browse THEN BEGIN
IF zoom = Day THEN RETURN[ icons[ 1]]
ELSE IF zoom = Month THEN RETURN[ icons[ 2]]
ELSE IF zoom = Year THEN RETURN[ icons[ 3]];
END
ELSE IF mode = EnterEvent THEN RETURN[ icons[ 4]];
END; -- GetIconFlavor
General Support
ExtractDate: PUBLIC PROCEDURE [ time: BasicTime.GMT] RETURNS [ date: Date] = BEGIN
auxTime: BasicTime.Unpacked ← BasicTime.Unpack[ time];
date.Day ← auxTime.day;
date.Month ← auxTime.month;
date.Year ← auxTime.year;
END; -- ExtractDate
CreateTextViewer: PUBLIC PROCEDURE [ myParent: ViewerClasses.Viewer, width, height: CARDINAL, cont: Rope.ROPE ← NIL, scrolling: BOOLEAN ← FALSE, edit: BOOLEAN ← TRUE] RETURNS [ txtViewer: ViewerClasses.Viewer] = BEGIN
view: ViewerClasses.ViewerRec;
BEGIN OPEN view;
parent ← myParent;
ww ← width;
wh ← height;
iconic ← FALSE;
scrollable ← FALSE;
border ← FALSE;
scrollable ← scrolling;
END; -- OPEN
txtViewer ← ViewerTools.MakeNewTextViewer[ info: view, paint: FALSE];
IF cont # NIL THEN ViewerTools.SetContents[ txtViewer, cont, FALSE];
IF NOT edit THEN ViewerTools.InhibitUserEdits[ txtViewer];
RETURN[ txtViewer];
END; --CreateTextViewer
CreateButton: PUBLIC PROCEDURE [ title: Rope.ROPE, myParent: ViewerClasses.Viewer, hi, wi: CARDINAL, xOff, yOff: CARDINAL ← 0, proc: Menus.MenuProc, clientData: REF ANY, displayStyle: ATOM ← $BlackOnWhite] RETURNS [ button: Buttons.Button] = BEGIN
to create a button...
view: ViewerClasses.ViewerRec;
BEGIN OPEN view;
name ← title;
parent ← myParent;
wx ← xOff; wy ← yOff;
ww ← wi;
wh ← hi;
iconic ← FALSE;
scrollable ← FALSE;
border ← FALSE;
END; -- OPEN
button ← Buttons.Create[ info: view, proc: proc, clientData: clientData, paint: FALSE];
Buttons.SetDisplayStyle[ button, displayStyle, FALSE];
RETURN[ button];
END; -- CreateButton
-- this here is a hack... but the semantics of Buttons is so stupid, that I didn't really have the
-- choice... look into ButtonsImpl to understand a little more: The problem is the greyCount
-- that gets increased. So if you say Set(...$BlackOnGrey) twice followed by one
-- Set( ..$BlackOnWhite), it's still grey....! Boy, how idiotic, just to save a little refresh?
ButtonDataRec: TYPE = MONITORED RECORD [ -- this is defined in ButtonsImpl.mesa
proc: Menus.MenuProc,
font: REF ANY,
clientData: REF ANY,
documentation: REF ANY,
greyCount: INTEGER,
displayStyle: {blackOnWhite, whiteOnBlack, blackOnGrey},
inverted: BOOL,
fork: BOOL,
guarded: BOOL,
state: { guarded, arming, armed }
];
ClearButton: PUBLIC PROCEDURE [ but: Buttons.Button] = BEGIN
to set the button greycount to zero.
butData: REF ButtonDataRec;
IF but = NIL THEN RETURN;
IF but.data = NIL THEN RETURN;
TRUSTED BEGIN
butData ← LOOPHOLE[ but.data];
butData^.greyCount ← 0;
END;
Buttons.SetDisplayStyle[ but, $BlackOnWhite, TRUE];
END; -- ClearButton
SetButton: PUBLIC PROCEDURE [ but: Buttons.Button] = BEGIN
to set the button greycount to one.
butData: REF ButtonDataRec;
IF but = NIL THEN RETURN;
IF but.data = NIL THEN RETURN;
TRUSTED BEGIN
butData ← LOOPHOLE[ but.data];
butData^.greyCount ← 1;
END;
Buttons.SetDisplayStyle[ but, $BlackOnGrey, TRUE];
END; -- ClearButton
PreviousDay: PUBLIC PROCEDURE [ date: Date] RETURNS [ newDate: Date] = BEGIN
newDate ← date;
IF newDate.Day > 1 THEN newDate.Day ← PRED[ newDate.Day]
ELSE
SELECT newDate.Month FROM
December, October, August, July, May => BEGIN
newDate.Month ← PRED[ newDate.Month]; newDate.Day ← 30
END;
November, September, June, April, February => BEGIN
newDate.Month ← PRED[ newDate.Month]; newDate.Day ← 31
END;
January => BEGIN
newDate.Month ← December; newDate.Year ← PRED[ newDate.Year];
newDate.Day ← 31; -- Anne's birthday!
END;
February =>
IF newDate.Year MOD 4 = 0 THEN BEGIN
newDate.Month ← February; newDate.Day ← 29
END
ELSE BEGIN
newDate.Month ← February; newDate.Day ← 28
END;
ENDCASE => ERROR;
RETURN[ newDate];
END; -- PreviousDay
NextDay: PUBLIC PROCEDURE [ date: Date] RETURNS [ newDate: Date] = BEGIN
newDate ← date;
IF newDate.Day < 28 THEN newDate.Day ← SUCC[ newDate.Day]
ELSE
SELECT newDate.Month FROM
January, March, May, July, August, October =>
IF newDate.Day = 31 THEN BEGIN
newDate.Day ← 1; newDate.Month ← SUCC[ newDate.Month]
END
ELSE newDate.Day ← SUCC[ newDate.Day];
December =>
IF newDate.Day = 31 THEN BEGIN
newDate.Day ← 1; newDate.Month ← January; newDate.Year ← SUCC[ newDate.Year]
END
ELSE newDate.Day ← SUCC[ newDate.Day];
April, June, September, November =>
IF newDate.Day = 30 THEN BEGIN
newDate.Day ← 1; newDate.Month ← SUCC[ newDate.Month]
END
ELSE newDate.Day ← SUCC[ newDate.Day];
ENDCASE => ERROR;
RETURN[ newDate];
END; -- NextDay
GetDayName: PUBLIC PROCEDURE [ date: Date] RETURNS [ name: Rope.ROPE] = BEGIN
to get the date's day alphanumeric name
upTime: BasicTime.Unpacked;
time: BasicTime.GMT;
upTime.year ← date.Year; upTime.month ← date.Month; upTime.day ← date.Day;
upTime.hour ← 12; upTime.minute ← 0;
time ← BasicTime.Pack[ upTime];
upTime ← BasicTime.Unpack[ time];
SELECT upTime.weekday FROM
Sunday => RETURN[ "Sunday"];
Monday => RETURN[ "Monday"];
Tuesday => RETURN[ "Tuesday"];
Wednesday => RETURN[ "Wednesday"];
Thursday => RETURN[ "Thursday"];
Friday => RETURN[ "Friday"];
Saturday => RETURN[ "Saturday"];
ENDCASE;
END; -- GetDayName
GetMonthName: PUBLIC PROCEDURE [ mo: Months] RETURNS [ name: Rope.ROPE] = BEGIN
to get the month's alphanumeric name
SELECT mo FROM
January => RETURN[ "January"];
February => RETURN[ "February"];
March => RETURN[ "March"];
April => RETURN[ "April"];
May => RETURN[ "May"];
June => RETURN[ "June"];
July => RETURN[ "July"];
August => RETURN[ "August"];
September => RETURN[ "September"];
October => RETURN[ "October"];
November => RETURN[ "November"];
December => RETURN[ "December"];
ENDCASE;
END; -- GetMonthName
GetMonthInfo: PUBLIC PROCEDURE [ mo: Months, yr: Years] RETURNS [ nbrOfDays: Days, firstDay: Weekdays] = BEGIN
returns the number of days in the given month (yes it is a pain...) and 'firstDay' tells
us on what weekday the first of the month fell!
time: BasicTime.Unpacked;
SELECT mo FROM
January, March, May, July, August, October, December => nbrOfDays ← 31;
April, June, September, November => nbrOfDays ← 30;
February => IF yr MOD 4 = 0 THEN nbrOfDays ← 29 ELSE nbrOfDays ← 28;
ENDCASE;
time ← [ year: yr, month: mo, day: 1, hour: 0, minute: 0, second: 0];
firstDay ← BasicTime.Unpack[ BasicTime.Pack[ time]].weekday;
RETURN[ nbrOfDays, firstDay];
END; -- GetMonthInfo
GetTimeInterval: PUBLIC PROCEDURE [ date: Date, level: ZoomLevel] RETURNS [ from, to: BasicTime.GMT] = BEGIN
depending on the level we find the time interval corresponding to this day, month or year
time: BasicTime.Unpacked;
SELECT level FROM
Day => BEGIN
time ← [ year: date.Year, month: date.Month, day: date.Day, hour: 0, minute: 0, second: 0];
from ← BasicTime.Pack[ time];
time ← [ year: date.Year, month: date.Month, day: date.Day, hour: 23, minute: 59, second: 59];
to ← BasicTime.Pack[ time];
END;
Month => BEGIN
time ← [ year: date.Year, month: date.Month, day: 1, hour: 0, minute: 0, second: 0];
from ← BasicTime.Pack[ time];
time ← [ year: date.Year, month: date.Month, day: GetMonthInfo[ curDate.Month, curDate.Year].nbrOfDays, hour: 23, minute: 59, second: 59];
to ← BasicTime.Pack[ time];
END;
Year => BEGIN
time ← [ year: date.Year, month: January, day: 1, hour: 0, minute: 0, second: 0];
from ← BasicTime.Pack[ time];
time ← [ year: date.Year, month: December, day: 31, hour: 23, minute: 59, second: 59];
to ← BasicTime.Pack[ time];
END;
ENDCASE;
RETURN[ from ,to];
END; -- GetTimeInterval
GetNbrOfEvents: PUBLIC PROCEDURE [ zoom: ZoomLevel, evl: EventList ← NIL] RETURNS [ nbr: INTEGER] = BEGIN
counts the nbr of events in a day, month or year. uses curDate to determine where to look
or just in the supplied event list...
nbr ← 0;
IF evl # NIL THEN
FOR l: EventList ← evl, l.rest UNTIL l = NIL DO
nbr ← nbr + 1;
ENDLOOP
ELSE
SELECT zoom FROM
Day => FOR evl: EventList ← CalStorage.GetEventsOfDay[ curDate, Day], evl.rest UNTIL evl = NIL DO
nbr ← nbr + 1;
ENDLOOP;
Month => BEGIN
nbrOfDays: Days;
[ nbrOfDays, ] ← GetMonthInfo[ curDate.Month, curDate.Year];
FOR d: Days IN [ 1..nbrOfDays] DO
FOR evl: EventList ← CalStorage.GetEventsOfDay[ [ d, curDate.Month, curDate.Year], Month], evl.rest UNTIL evl = NIL DO
nbr ← nbr + 1;
ENDLOOP;
ENDLOOP;
END; --Month
Year =>
FOR m: Months IN [ January..December] DO
nbrOfDays: Days;
[ nbrOfDays, ] ← GetMonthInfo[ m, curDate.Year];
FOR d: Days IN [ 1..nbrOfDays] DO
FOR evl: EventList ← CalStorage.GetEventsOfDay[ [ d, m, curDate.Year], Year], evl.rest UNTIL evl = NIL DO
nbr ← nbr + 1;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDCASE => NULL;
RETURN[ nbr];
END; -- GetNbrOfEvents
DisplayMsg: PUBLIC PROCEDURE [ msg: Rope.ROPE, blink: BOOLEAN ← TRUE] = BEGIN
to display an error mesage in message window
MessageWindow.Append[ msg, TRUE];
IF blink THEN MessageWindow.Blink[];
END; -- DisplayErrorMessage
MakeMenu: PUBLIC PROCEDURE [ menuItems: LIST OF Rope.ROPE, menuProcs: LIST OF Menus.MenuProc, procArgs: LIST OF REF ANY] RETURNS [ menu: Menus.Menu] = BEGIN
makes a menu according to the parameter lists. Assume that lists have all same lengths...!
pl: LIST OF Menus.MenuProc ← menuProcs;
al: LIST OF REF ANY ← procArgs;
menu ← Menus.CreateMenu[];
FOR il: LIST OF Rope.ROPE ← menuItems, il.rest UNTIL il = NIL DO
entry: Menus.MenuEntry;
entry ← Menus.CreateEntry[ name: il.first, proc: pl.first, clientData: al.first, fork: TRUE];
Menus.AppendMenuEntry[ menu, entry];
pl ← pl.rest;
al ← al.rest;
ENDLOOP;
END; -- MakeMenu
Reflecting changes to Hickory. There is only one NotifyProc for entire calendar package,
which makes it easier to get order of execution right
HickoryChanged: Hickory.NotifyProc -- [ reason: Reason, ev: Event, data: Rope.ROPE] -- = BEGIN
gets called ( asynchronously) whenever somebody writes to the Hickory data base
UpdateCalendar[ reason, ev, data];
END; -- HickoryChanged
UpdateCalendar: ENTRY PROCEDURE [ reason: Hickory.Reason, ev: Hickory.Event, data: RopeSets.RopeSet] = BEGIN
here we enter the monitor and attempt to update all data we have cached from
hickory data base.
ENABLE UNWIND => NULL;
oldEvl, newEvl: Hickory.EventList ← NIL;
SELECT reason FROM
DestroyDB => BEGIN
CalStorage.DestroyAllViewers[];
CalForm.DestroyViewer[];
yearTrees ← NIL;
IF calViewer # NIL THEN ViewerOps.DestroyViewer[ calViewer];
calViewer ← NIL;
DisplayMsg[ "Congratulations: your hickory database was erased!"];
END;
Forget, Edit, NewEvent, Destroy, UnForget => BEGIN
[ oldEvl, newEvl] ← CalStorage.HickoryChange[ reason, ev, data];
CalBrowser.HickoryChange[ reason, oldEvl, newEvl, data];
IF newEvl # NIL THEN CalForm.HickoryChange[ reason, newEvl.first, data];
END;
NewGroup, GroupDestroy, RemoveFromGroup, InsertionToGroup => BEGIN
evt: Hickory.EventTuple; -- initialized to garbage..
evt.Key ← ev;
CalForm.HickoryChange[ reason, evt, data]; -- so we pass the key
END;
ENDCASE; -- other reasons are useless to Calendar
END; --UpdateCalendar
Initialization of it all
CreateCalViewer: PUBLIC INTERNAL PROCEDURE = BEGIN
to make certain there now is a viewer
view: ViewerClasses.ViewerRec;
IF calViewer # NIL AND NOT calViewer.destroyed THEN RETURN;
CalStorage.DestroyAllViewers[];
CalForm.DestroyViewer[];
IF calViewer # NIL THEN BEGIN
ViewerOps.DestroyViewer[ calViewer];
calViewer ← NIL;
END;
BEGIN OPEN view;
name ← "Calendar";
column ← left;
scrollable ← FALSE;
iconic ← FALSE;
icon ← GetIconFlavor[ mode: Browse, zoom: Day];
border ← TRUE;
END; -- OPEN
calViewer ← Containers.Create[ info: view, paint: TRUE]; -- Top Level viewer
END; -- CreateCalViewer
InitCalendar: ENTRY PROCEDURE = BEGIN
to initialize the calendar package. This is also called when the viewer has been
destroyed and user says "calendar" to commander again.
ENABLE UNWIND => NULL;
Nut.DeRegister[ domain: "Calendar", segment: $Hickory];
CreateCalViewer[];
CalNuts.RegisterWithNuts[];
start off in browsing mode, showing today
curDate ← ExtractDate[ BasicTime.Now[]];
CalBrowser.DisplayEvents[ Day, curDate];
END; --InitCalendar
CallInitialize: Commander.CommandProc = BEGIN
InitCalendar[];
END; -- CallInitialize
INITIALLY
ReadInAllIcons[];
Hickory.RegisterNotifyProc[ proc: HickoryChanged];
Commander.Register[ "Calendar", CallInitialize, "Calendar: browsing your personal calendar"];
END.