<> <> <> 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; <> <<>> 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 <> 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 <> <<>> 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 <> 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 <> 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 <> 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 <> 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 <> 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 <> <> 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 <> 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 <> <> 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 <> 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 <> 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 <> <> HickoryChanged: Hickory.NotifyProc -- [ reason: Reason, ev: Event, data: Rope.ROPE] -- = BEGIN <> UpdateCalendar[ reason, ev, data]; END; -- HickoryChanged UpdateCalendar: ENTRY PROCEDURE [ reason: Hickory.Reason, ev: Hickory.Event, data: RopeSets.RopeSet] = BEGIN <> <> 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 <> <<>> CreateCalViewer: PUBLIC INTERNAL PROCEDURE = BEGIN <> 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 <> <> ENABLE UNWIND => NULL; Nut.DeRegister[ domain: "Calendar", segment: $Hickory]; CreateCalViewer[]; CalNuts.RegisterWithNuts[]; <> curDate _ ExtractDate[ BasicTime.Now[]]; CalBrowser.DisplayEvents[ Day, curDate]; END; --InitCalendar CallInitialize: Commander.CommandProc = BEGIN InitCalendar[]; END; -- CallInitialize <> ReadInAllIcons[]; Hickory.RegisterNotifyProc[ proc: HickoryChanged]; Commander.Register[ "Calendar", CallInitialize, "Calendar: browsing your personal calendar"]; END.