<<-- /ivy/binding/calendar/calFormImplB.mesa>> -- handling the selection of things on the calendar form and parsing of the calendar form -- once the user says "DoIt" -- Last edited by: Binding, August 5, 1984 10:01:22 am PDT DIRECTORY BasicTime USING [ Unpack, Now, Period, GMT, nullGMT, Unpacked, Pack], Buttons USING [ Button, ReLabel], Calendar USING [ Date, Years, Months, Days, Weekdays, ZoomLevel], CalBrowser USING [ DisplayEvents], CalForm USING [ RepetitionDescriptor, EventDescriptor, YearTable, MonthTable, DayTable, Row1, Row234, Row5, Row6, Row7, MenuTable, CalForm, CurSelection, calForm, curSelection, FillDayTable, Delta], CalStorage USING [ protData], CalSupport USING [ GetMonthInfo, DisplayMsg, GetRowCol, M2I, R2I, ClearButton, SetButton], Hickory USING [ Group, GroupSet, RepetitionType, ProtectionType, EventTuple, EventList], InputFocus USING [ SetInputFocus], IO USING [ STREAM, RIS, EndOfStream, GetTokenRope, GetChar, SkipWhitespace, EndOf, BreakProc, NUL, SP], Menus USING [ MouseButton], Rope USING [ ROPE, Equal], RopeSets USING [ InsertValueIntoSet, IsValueInSet, Direction, RopeSetEl, MoveRover, IsSetEmpty, DeleteValueFromSet], Tempus USING [ Parse, Adjust, Unintelligible], ViewerClasses USING [ Viewer], ViewerOps USING [ PaintViewer, MoveViewer], ViewerTools USING [ GetContents] ; CalFormImplB: CEDAR MONITOR LOCKS CalStorage.protData IMPORTS BasicTime, Buttons, CalStorage, CalSupport, IO, Rope, Tempus, ViewerOps, ViewerTools, CalForm, CalBrowser, RopeSets, InputFocus EXPORTS CalForm SHARES CalSupport, CalForm, CalBrowser = BEGIN OPEN CalStorage.protData, Calendar, CalForm; <> SyntaxError: PUBLIC ERROR = CODE; <> curYear: Years _ BasicTime.Unpack[ BasicTime.Now[]].year; <> UpdateButtons: PROCEDURE [ but1, but2: Buttons.Button] = BEGIN <> IF but1 # NIL THEN CalSupport.ClearButton[ but1]; IF but2 # NIL THEN CalSupport.SetButton[ but2]; END; -- UpdateButtons AdjustDay: PROCEDURE [ inDate: Date] RETURNS [ outDate: Date] = BEGIN <> <<30 days...>> nbrOfDays: Days _ CalSupport.GetMonthInfo[ inDate.Month, inDate.Year].nbrOfDays; outDate _ inDate; IF outDate.Day > nbrOfDays THEN outDate.Day _ nbrOfDays; RETURN[ outDate]; END; -- AdjustDay <> YearSelection: PUBLIC ENTRY PROCEDURE [ y: Years, mouseBut: Menus.MouseButton] = BEGIN ENABLE UNWIND => NULL; IF y # curSelection.date.Year THEN BEGIN <> OPEN calForm.row1.yearTable; oldRow, newRow: INT; oldRow _ curSelection.date.Year - curYear + ( rows-1)/2; newRow _ y - curYear + ( rows-1)/2; UpdateButtons[ buttons[ oldRow], buttons[ newRow]]; curSelection.date.Year _ y; curSelection.date _ AdjustDay[ curSelection.date]; FillDayTable[ calForm.row1.dayTable.table, curSelection.date]; IF mouseBut # yellow THEN ViewerOps.PaintViewer[ calForm.row1.dayTable.table, all]; END; IF mouseBut = yellow THEN BrowseCmd[ Year]; END; -- YearSelection MonthSelection: PUBLIC ENTRY PROCEDURE [ m: Months, mouseBut: Menus.MouseButton] = BEGIN ENABLE UNWIND => NULL; IF m # curSelection.date.Month THEN BEGIN <> OPEN calForm.row1.monthTable; oldRow, newRow: INT; oldRow _ CalSupport.M2I[ curSelection.date.Month] + 1; newRow _ CalSupport.M2I[ m] + 1; UpdateButtons[ buttons[ oldRow], buttons[ newRow]]; curSelection.date.Month _ m; curSelection.date _ AdjustDay[ curSelection.date]; FillDayTable[ calForm.row1.dayTable.table, curSelection.date]; IF mouseBut # yellow THEN ViewerOps.PaintViewer[ calForm.row1.dayTable.table, all]; END; IF mouseBut = yellow THEN BrowseCmd[ Month]; END; -- MonthSelection DaySelection: PUBLIC ENTRY PROCEDURE [ d: Days, mouseBut: Menus.MouseButton] = BEGIN <> ENABLE UNWIND => NULL; IF d # curSelection.date.Day THEN BEGIN OPEN calForm.row1.dayTable; oldRow, oldCol, newRow, newCol: INT; firstDay: Weekdays; [ , firstDay] _ CalSupport.GetMonthInfo[ curSelection.date.Month, curSelection.date.Year]; [ oldRow, oldCol] _ CalSupport.GetRowCol[ curSelection.date.Day, firstDay]; [ newRow, newCol] _ CalSupport.GetRowCol[ d, firstDay]; UpdateButtons[ buttons[ oldRow] [oldCol], buttons[ newRow] [ newCol]]; curSelection.date.Day _ d; END; IF mouseBut = yellow THEN BrowseCmd[ Day]; END; -- DaySelection BrowseCmd: INTERNAL PROCEDURE [ zoom: ZoomLevel] = BEGIN <> IF calForm.container # NIL THEN BEGIN InputFocus.SetInputFocus[]; -- to nowhere ViewerOps.MoveViewer[ viewer: calForm.container, x: calForm.container.wx+Delta, y: calForm.container.wy+Delta, w: calForm.container.ww, h: calForm.container.wh, paint: FALSE]; END; CalBrowser.DisplayEvents[ zoom, curSelection.date]; END; ChangeRepetitionSelection: PUBLIC ENTRY PROCEDURE [ repType: Hickory.RepetitionType] = BEGIN <> OPEN curSelection.repetition; ENABLE UNWIND => NULL; IF RepeatType # repType THEN BEGIN OPEN calForm.row5.menuTable, CalSupport; IF RepeatType = None THEN UpdateButtons[ NIL, buttons[ R2I[ repType]-1]] ELSE UpdateButtons[ buttons[ R2I[ RepeatType]-1], buttons[ R2I[ repType]-1]]; RepeatType _ repType; END ELSE BEGIN -- undo selection OPEN calForm.row5.menuTable, CalSupport; UpdateButtons[ buttons[ R2I[ repType]-1], NIL]; RepeatType _ None; END; END; -- ChangeRepetitionSelection ChangeGroupSelection: PUBLIC ENTRY PROCEDURE [ groupIndex: INT] = BEGIN <> ENABLE UNWIND => NULL; lookAhead: REF RopeSets.RopeSetEl _ NIL; newGroup: Hickory.Group; lookAhead _ RopeSets.MoveRover[ calForm.row6.groupHead, Right, groupIndex, TRUE]; IF lookAhead = NIL THEN RETURN; newGroup _ lookAhead.Value; IF NOT RopeSets.IsValueInSet[ newGroup, curSelection.groups] THEN BEGIN <> OPEN calForm.row6; CalSupport.SetButton[ menuTable.buttons[ groupIndex]]; curSelection.groups _ RopeSets.InsertValueIntoSet[ newGroup, curSelection.groups]; END ELSE BEGIN -- undo selection OPEN calForm.row6; CalSupport.ClearButton[ menuTable.buttons[ groupIndex]]; curSelection.groups _ RopeSets.DeleteValueFromSet[ newGroup, curSelection.groups]; END; END; -- ChangeGroupSelection ScrollGroupMenu: PUBLIC ENTRY PROCEDURE [ dir: RopeSets.Direction] = BEGIN <> OPEN calForm.row6; ENABLE UNWIND => NULL; gr: REF RopeSets.RopeSetEl; IF RopeSets.IsSetEmpty[ groups] THEN RETURN; groupHead _ RopeSets.MoveRover[ rover: groupHead, dir: dir, howFar: menuTable.cols, passLast: FALSE]; gr _ groupHead; FOR i: INT IN [ 0..menuTable.cols) DO IF gr # NIL THEN BEGIN Buttons.ReLabel[ menuTable.buttons[ i], gr.Value, FALSE]; IF RopeSets.IsValueInSet[ gr.Value, curSelection.groups] THEN CalSupport.SetButton[ menuTable.buttons[ i]] ELSE CalSupport.ClearButton[ menuTable.buttons[ i]]; gr _ gr.Next; END ELSE BEGIN Buttons.ReLabel[ menuTable.buttons[ i], " ", FALSE]; -- erase CalSupport.ClearButton[ menuTable.buttons[ i]]; END; ENDLOOP; END; -- ScrollGroupMenu <> TranslateSelection: PUBLIC INTERNAL PROCEDURE [ editedEv: REF Hickory.EventTuple _ NIL] RETURNS [ evList: Hickory.EventList, groups: Hickory.GroupSet] = BEGIN -- scopes for EXITS and ERROR: a Pain... <> OPEN calForm; ENABLE BEGIN UNWIND => NULL; END; -- Enable BEGIN -- scope for exits text, place: Rope.ROPE; events: LIST OF EventDescriptor _ NIL; repetition: RepetitionDescriptor; keepUntil: BasicTime.GMT _ BasicTime.nullGMT; first: BOOLEAN; events _ GetEventTimes[ curSelection.date, row2.txtViewer]; text _ ViewerTools.GetContents[ row3.txtViewer]; IF Rope.Equal[ text, ""] THEN GOTO noText; place _ ViewerTools.GetContents[ calForm.row4.txtViewer]; IF Rope.Equal[ place, ""] THEN place _ NIL; repetition _ GetRepetition[ row5.txtViewer, row7.txtViewers[1], curSelection.repetition]; groups _ GetGroups[ row6.txtViewer, curSelection.groups]; keepUntil _ GetKeepUntil[ row7.txtViewers[2]]; evList _ NIL; IF events = NIL THEN GOTO noEvents; first _ TRUE; FOR l: LIST OF EventDescriptor _ events, l.rest UNTIL l = NIL DO ev: Hickory.EventTuple; IF editedEv # NIL AND first THEN ev.Key _ editedEv.Key -- already in hickory ELSE ev.Key _ NIL; -- it's a really new hickory event first _ FALSE; ev.EventTime _ l.first.EventTime; ev.Duration _ l.first.Duration / 60; -- in minutes ev.Text _ text; ev.Place _ place; ev.RepeatType _ repetition.RepeatType; ev.RepeatTime _ repetition.RepeatTime; ev.RepeatUntil _ repetition.RepeatUntil; ev.KeepUntil _ keepUntil; ev.Protection _ curSelection.protection; ev.Remind _ curSelection.reminder; evList _ CONS[ ev, evList]; ENDLOOP; RETURN[ evList, groups]; EXITS noEvents => BEGIN CalSupport.DisplayMsg[ "No event times & durations were specified!"]; ERROR SyntaxError; END; noText => BEGIN CalSupport.DisplayMsg[ "No text for event was specified!"]; ERROR SyntaxError; END; END; END; -- TranslateSelection GetGroups: INTERNAL PROCEDURE [ txtViewer: ViewerClasses.Viewer, groups: Hickory.GroupSet] RETURNS [ moreGroups: Hickory.GroupSet] = BEGIN <> <> st: IO.STREAM _ IO.RIS[ ViewerTools.GetContents[ txtViewer]]; g: Rope.ROPE; ch: CHAR; BreakProc: IO.BreakProc = BEGIN RETURN[ SELECT char FROM IN [ IO.NUL..IO.SP), ',, ';, ': => sepr, ENDCASE => other]; END; -- BreakProc moreGroups _ groups; DO ENABLE IO.EndOfStream => EXIT; [] _ IO.SkipWhitespace[ st]; g _ IO.GetTokenRope[ stream: st, breakProc: BreakProc].token; moreGroups _ RopeSets.InsertValueIntoSet[ g, moreGroups]; ch _ IO.GetChar[ st]; -- separator consumed ENDLOOP; RETURN[ moreGroups]; END; -- GetGroups GetRepetition: INTERNAL PROCEDURE [ txt1, txt2: ViewerClasses.Viewer, rep: RepetitionDescriptor] RETURNS [ newRep: RepetitionDescriptor] = BEGIN BEGIN repRope: Rope.ROPE _ ViewerTools.GetContents[ txt1]; newRep _ rep; IF newRep.RepeatType # None THEN IF NOT Rope.Equal[ repRope, ""] THEN CalSupport.DisplayMsg[ "Warning: repetition time in text viewer ignored!"] ELSE NULL ELSE IF NOT Rope.Equal[ repRope, ""] THEN BEGIN newRep.RepeatType _ Complicated; newRep.RepeatTime _ repRope; END; repRope _ ViewerTools.GetContents[ txt2]; -- repeatUntil.. IF repRope = NIL OR Rope.Equal[ repRope, ""] THEN newRep.RepeatUntil _ BasicTime.nullGMT ELSE newRep.RepeatUntil _ LOOPHOLE[ Tempus.Parse[ repRope ! Tempus.Unintelligible => GOTO badTimeFormat].time]; RETURN[ newRep]; EXITS badTimeFormat => BEGIN CalSupport.DisplayMsg[ "Tempus could not parse repeat until specification!"]; ERROR SyntaxError; END; END; END; -- GetRepetition GetKeepUntil: INTERNAL PROCEDURE[ txtViewer: ViewerClasses.Viewer] RETURNS [ time: BasicTime.GMT _ BasicTime.nullGMT] = BEGIN BEGIN r: Rope.ROPE _ ViewerTools.GetContents[ txtViewer]; IF r = NIL OR Rope.Equal[ r, ""] THEN RETURN[ BasicTime.nullGMT]; time _ LOOPHOLE[ Tempus.Parse[ r ! Tempus.Unintelligible => GOTO badTimeFormat].time]; RETURN[ time]; EXITS badTimeFormat => BEGIN CalSupport.DisplayMsg[ "Tempus could not parse keep until specification!"]; ERROR SyntaxError; END; END; END; -- GetKeepUntil GetEventTimes: INTERNAL PROCEDURE [ date: Date, txtViewer: ViewerClasses.Viewer] RETURNS [ eventList: LIST OF EventDescriptor _ NIL] = BEGIN BEGIN <> <> r: Rope.ROPE _ ViewerTools.GetContents[ txtViewer]; st: IO.STREAM _ IO.RIS[ r]; startTime, endTime, baseTime: BasicTime.GMT; ch: CHAR; -- lookahead auxTime: BasicTime.Unpacked; IF Rope.Equal[ r, ""] THEN GOTO noTimes; BEGIN OPEN auxTime; year _ date.Year; month _ date.Month; day _ date.Day; hour _ 0; minute _ 0; second _ 0; END; -- OPEN baseTime _ BasicTime.Pack[ auxTime]; DO EOF: BOOLEAN _ FALSE; [] _ IO.SkipWhitespace[ st]; [ startTime, ch] _ GetTime[ st, baseTime]; IF NOT EOF AND ch = ' THEN BEGIN ch _ IO.GetChar[ st ! IO.EndOfStream => { EOF _ TRUE; CONTINUE} ]; [] _ IO.SkipWhitespace[ st]; [ endTime, ch] _ GetTime[ st, startTime]; END ELSE endTime _ startTime; IF NOT EOF THEN ch _ IO.GetChar[ st ! IO.EndOfStream => { EOF _ TRUE; CONTINUE}]; -- consume separator eventList _ ExpandEvList[ startTime, endTime, eventList]; IF IO.EndOf[ st] OR EOF THEN EXIT; ENDLOOP; RETURN[ eventList]; EXITS noTimes => BEGIN CalSupport.DisplayMsg[ "No event start time specified!"]; ERROR SyntaxError; END; END; END; -- GetEventTimes GetTime: INTERNAL PROCEDURE [ st: IO.STREAM, baseTime: BasicTime.GMT] RETURNS [ time: BasicTime.GMT, nextChar: CHAR]= BEGIN BEGIN <> r: Rope.ROPE; BreakProc: IO.BreakProc = BEGIN RETURN[ SELECT char FROM ', '; => sepr, ENDCASE => other]; END; -- BreakProc r _ IO.GetTokenRope[ st, BreakProc ! IO.EndOfStream => CONTINUE].token; nextChar _ IO.GetChar[ st ! IO.EndOfStream => CONTINUE]; time _ Tempus.Parse[ rope: r, baseTime: baseTime ! Tempus.Unintelligible => GOTO badTimeFormat].time; RETURN[ time, nextChar]; EXITS badTimeFormat => BEGIN CalSupport.DisplayMsg[ "Tempus could not parse time!"]; ERROR SyntaxError; END; END; END; -- GetTime ExpandEvList: INTERNAL PROCEDURE [ startTime, endTime: BasicTime.GMT, evl: LIST OF EventDescriptor] RETURNS [ newEvl: LIST OF EventDescriptor] = BEGIN BEGIN <> <> start, end, time: BasicTime.Unpacked; evDescr: EventDescriptor; IF BasicTime.Period[ startTime, endTime] = 0 THEN BEGIN evDescr.Duration _ 0; evDescr.EventTime _ startTime; newEvl _ CONS[ evDescr, NIL]; RETURN[ newEvl]; END ELSE IF BasicTime.Period[ startTime, endTime] < 0 THEN GOTO badInterval; start _ BasicTime.Unpack[ startTime]; end _ BasicTime.Unpack[ endTime]; newEvl _ evl; WHILE start.day # end.day DO evDescr.EventTime _ startTime; time _ start; time.hour _ 23; time.minute _ 59; time.second _ 59; -- end of start day evDescr.Duration _ BasicTime.Period[ startTime, BasicTime.Pack[ time]]; newEvl _ CONS[ evDescr, newEvl]; start.hour _ 0; start.minute _ 0; start.second _ 0; startTime _ Tempus.Adjust[ days: 1, baseTime: BasicTime.Pack[ start], precisionOfResult: minutes].time; start _ BasicTime.Unpack[ startTime]; ENDLOOP; <> evDescr.EventTime _ startTime; evDescr.Duration _ BasicTime.Period[ startTime, endTime]; IF evDescr.Duration > 0 THEN newEvl _ CONS[ evDescr, newEvl]; RETURN[ newEvl]; EXITS badInterval => BEGIN CalSupport.DisplayMsg[ "StartTime > EndTime ??"]; ERROR SyntaxError; END; END; END; -- ExpandEvList END.