Mark task complete-DEV.mmbas

'mark_task_complete.mmbas: mark and log tasks done and advance repeating tasks '04Feb11 http://creativecommons.org/licenses/by-nc-nd/3.0/ 'http://wiki.activityowner.com/index.php?Title=Mark_Task_Complete 'recent changes '07Feb09 -- change version check frequency to 30 by default '10Feb09 -- error trapping, organize options '11Feb09 -- allow completed and reference text to be international, move version check to end, error trap '13Feb09 -- make sure configuration map has new completed and reference text '13Feb09 -- fix bug on floating complete topic '15Feb09 -- speed up option loading '16Feb09 -- save maps when not using dashboard '25Feb09 -- delete relationships from completed tasks moved to completed topic '26Feb09 -- Fix bug -- not marking non-repeat items done from dashboard if not moved (speeded up with code change in ao_common.mmbas) '03Mar09 -- take out english-specific hard coding, rely on configuration map '14Apr09 -- Add "ongoing" category '18Apr09 -- Add deleteoriginal configuration option '19Apr09 -- change version check strategy '03May09 -- add each3weeks '01Aug09 -- make map saving optional (not recommended, but improves compatibility with some other add-ins) '30Dec09 -- close hidden maps to avoid multicomputer conflicts '30Dec09 -- debug '05Feb10 -- fix run time error when used in catalyst '07Feb10 -- add check icon to items marked complete '04Feb11 -- adapt to MM9 date handling bugs '#uses "ao_common.mmbas" Option Explicit Type myoptiontype logbasename As String completedtext As String referencetext As String logname As String movetocomplete As Boolean storecompleteinproject As Boolean storeinresult As Boolean mapcalendar As Boolean setduetoday As Boolean logdone As Boolean savedb As Boolean deleteoriginal As Boolean savemaps As Boolean End Type Public Const advancecodetext ="Advance Codes" Public Const daycodetext = "Day Codes" Sub Main Const ProgramVersion = "20100207" Const VersionCheckLink="http://activityowner.com/installers/versioncheck.php" Const configmapname = "ao\CompletedConfig.mmap" Const maxselected 			= 100 Dim DefaultOptions As myoptiontype Dim opt As myoptiontype Dim localopt As myoptiontype Dim configdoc As Document Dim isdb As Boolean Dim t As Topic Dim tt As Topic Dim redo As Boolean Dim selected(maxselected) As Topic Dim doccurrent As Document Dim i As Integer Dim scount As Integer Dim tmap As Document Dim rawmap As Document Debug.Clear Set doccurrent = ActiveDocument Set configdoc 	=getmap(configmapname) If configdoc Is Nothing Then MsgBox "Configuration Map not created. Contact ActivityOwner. Exiting Program." End End If ' set tasks to be completed scount= doccurrent.Selection.Count isdb		   = f_IsADashboardMap(doccurrent) For i=1 To scount Set selected(i)	= doccurrent.Selection.Item(i) Next Upgrade(configdoc) DefaultOptions = LoadDefaultOptions(configdoc) doccurrent.Activate If Not isdb Then opt=LoadLocalOptions(DefaultOptions,doccurrent) ' 'loop through tasks to be completed For i = 1 To scount Set t=selected(i) redo=advancetask(t,False,configdoc) 'determine if it is a repeating task If Not isdb Then If opt.logdone Then Set tmap=getmap(opt.logname) copytocalendarlog tmap, t 'copy to completed Log End If		If opt.mapcalendar Then copytoRefcalendarlog ActiveDocument, t, opt.referencetext If Not redo Then t.Task.Complete=100 If opt.setduetoday Then	t.Task.DueDate=Date End If		If opt.movetocomplete Then If redo Then copytocompletedtopic t, doccurrent, opt Else movetocompletedtopic t, doccurrent, opt End If		End If		If redo Then advancetask(t,True,configdoc) If Not redo Then If opt.deleteoriginal Then t.Delete Else 'isdb For Each tt In doccurrent.Range(mmRangeAllTopics) If isclone(tt,t) Then If redo Then tt.Icons.AddStockIcon(mmStockIconCheck) Else tt.Icons.AddStockIcon(mmStockIconCheck) tt.Task.Complete=100 If opt.setduetoday Then t.Task.DueDate=Date End If			End If		Next Set t= followedhyperlink(t,doccurrent) If Not (t Is Nothing) Then Set rawmap=t.Document opt=LoadLocalOptions(DefaultOptions,rawmap) If opt.logdone Then Set tmap=getmap(opt.logname) copytocalendarlog tmap, t 'copy to completed Log End If			If opt.mapcalendar Then copytoRefcalendarlog t.Document, t, opt.referencetext If Not redo Then t.Task.Complete=100 If opt.movetocomplete Then If redo Then copytocompletedtopic t, t.Document, opt Else If opt.setduetoday Then t.Task.DueDate=Date movetocompletedtopic t, t.Document, opt End If			End If			If redo Then advancetask(t,True,configdoc) If Not redo Then If opt.deleteoriginal Then t.Delete If Not rawmap.ExternalDocument.IsExternal And opt.savemaps Then rawmap.Save Set rawmap=Nothing End If	End If Next ' If isdb Then doccurrent.Activate 'On Error Resume Next If (Not doccurrent.ExternalDocument.IsExternal) And (opt.savemaps Or (isdb And opt.savedb)) Then doccurrent.Save If opt.logdone And opt.savemaps Then tmap.Save

On Error GoTo 0 Set doccurrent = Nothing Set tmap=Nothing Set t = Nothing For i=1 To scount Set selected(i)=Nothing Next VersionCheck VersionCheckLink, "Mark_Task_Complete", ProgramVersion, configdoc Set configdoc = Nothing CloseHiddenMaps PlaySoundchirp End Sub Function LoadDefaultOptions(ByRef configdoc As Document) As myoptiontype Dim optionbranch As Topic Set optionbranch=createmainbranch("options",configdoc) With LoadDefaultOptions .logbasename 			= getoption("log-map-base-name",configdoc,optionbranch) .logname 				=.logbasename & Year(Date) & "-" & Month(Date) & ".mmap" .referencetext         =getoption("referencetext",configdoc,optionbranch) .completedtext			=getoption("completedtext", configdoc,optionbranch) .movetocomplete			=optiontrue("move-complete-to-branch",configdoc,optionbranch) 'move completed tasks to "complete" branch or floating Topic .storecompleteinproject	=optiontrue("store-complete-in-project",configdoc,optionbranch) 	'store completed tasks in each project instead of floating topic .storeinresult			=optiontrue("store-in-result",configdoc,optionbranch)	'store in result if possible .logdone				=optiontrue("copy-completed-to-log-map",configdoc,optionbranch) .mapcalendar			=optiontrue("copy-completed-to-calendar-branch",configdoc,optionbranch) .savedb					=optiontrue("save-dashboards",configdoc,optionbranch) 'save time by not saving dashboard after each use .setduetoday	       =optiontrue("setduetoday",configdoc,optionbranch)   'set duedate to today completed tasks .deleteoriginal			=optiontrue("delete-original",configdoc,optionbranch) .savemaps				=optiontrue("save-maps",configdoc,optionbranch) End With Set optionbranch=Nothing End Function Function LoadLocalOptions(ByRef DefaultOptions As myoptiontype, ByRef currentdoc As Document) As myoptiontype Dim rnote As String Dim rbranch As Topic Set rbranch = findmainbranch(DefaultOptions.referencetext,currentdoc) LoadLocalOptions=DefaultOptions If Not rbranch Is Nothing Then rnote=rbranch.Notes.Text If Not rnote="" Then With LoadLocalOptions .movetocomplete			=optionlocal("move-complete-to-branch",rnote,DefaultOptions.movetocomplete) .storecompleteinproject	=optionlocal("store-complete-in-project",rnote,DefaultOptions.storecompleteinproject) .storeinresult			=optionlocal("store-in-result",rnote,DefaultOptions.storeinresult) .logdone				=optionlocal("copy-completed-to-log-map",rnote,DefaultOptions.logdone) .mapcalendar			=optionlocal("copy-completed-to-calendar-branch",rnote,DefaultOptions.mapcalendar) .savedb					=optionlocal("save-dashboards",rnote,DefaultOptions.savedb) .setduetoday	       =optionlocal("setduetoday",rnote,DefaultOptions.setduetoday) .deleteoriginal 		=optionlocal("delete-original",rnote,DefaultOptions.deleteoriginal) End With End If End If Debug.Print LoadLocalOptions.storecompleteinproject End Function Function optionlocal(ByRef setting, ByRef rnotes As String, oDefault As Boolean) As Boolean 'future use to override default settings by looking at text in a note in map If InStr(rnotes,setting)>0 Then If InStr(rnotes,setting&"=0")>0 Then Debug.Print "false it" optionlocal=False ElseIf InStr(rnotes,setting&"=1")>0 Then optionlocal=True Else optionlocal=True End If	Else optionlocal=oDefault End If End Function Function advancetask(ByRef t As Topic, ByRef changedates As Boolean, configdoc As Document) As Boolean Const sdd = False		'set due date even if no due date in place Dim codetopic As Topic Dim units As String Dim lead As Integer Dim inc As Integer Dim datefixed As Boolean Dim hasstart As Boolean Dim hasdue As Boolean Dim i As Integer Dim m As Integer Dim d As Integer Dim cats As String Dim a As Topic cats=LCase(t.Task.Categories) advancetask=False If Len(cats)>0 Then 'don't bother with searching for repeat codes if categories are blank Set a = createmainbranch(advancecodetext,configdoc) For Each codetopic In a.AllSubTopics If InStr(cats,codetopic.Text)>0 Then advancetask=True If changedates Then m=i datefixed=(codetopic.AllSubTopics(3).Text="-1") hasstart=t.Task.StartDate>0 hasdue =t.Task.DueDate>0 units=codetopic.AllSubTopics.Item(1).Text inc = Val(codetopic.AllSubTopics.Item(2).Text) lead = Val(codetopic.AllSubTopics.Item(3).Text)

If datefixed    And hasdue 	Then	t.Task.DueDate=DateAdd(units,inc,t.Task.DueDate) If Not datefixed And hasdue 	Then	t.Task.DueDate=DateAdd(units,inc,Date) If sdd			 And Not hasdue Then	t.Task.DueDate=DateAdd(units,inc,Date)

If datefixed 	 And hasstart 	Then	setstartdate t,DateAdd(units,inc,t.Task.StartDate) If Not datefixed And hasstart	Then	setstartdate t,DateAdd(units,inc,Date)-lead If sdd 			 And Not hasstart Then	setstartdate t,DateAdd(units,inc,Date)-lead

If Not hasstart And Not hasdue And Not sdd Then MsgBox("You should Set either an initial start Date Or an initial due Date") t.Icons.AddStockIcon(mmStockIconRedo) End If		   	Exit Function End If		Next

'If advance codes not found, look for day of week code Set a=createmainbranch(daycodetext,configdoc) For Each codetopic In a.AllSubTopics If InStr(LCase(cats),LCase(codetopic.Text))>0 Then advancetask=True If changedates Then d=Val(Trim(codetopic.Notes.Text)) If d>0 Then t.Task.DueDate=IIf(Weekday(Date)<=1,Date+d-Weekday(Date),Date+d-Weekday(Date)+7) setstartdate t,t.Task.DueDate-3 t.Icons.AddStockIcon(mmStockIconRedo) End If	       	End If	        	Exit Function End If       Next

'if day of week code not found, look for end of codes If InStr(LCase(cats),getoption("endofmonthcode",configdoc))>0 Or InStr(LCase(cats),getoption("endofquartercode",configdoc))>0  Then t.Icons.AddStockIcon(mmStockIconRedo) advancetask=True If changedates Then If InStr(cats,getoption("endofmonthcode",configdoc))>0 Then If t.Task.DueDate>0 Then t.Task.DueDate=DateAdd("m",2,t.Task.DueDate)-Day(t.Task.DueDate)-1 Else If sdd Then t.Task.DueDate=DateAdd("m",2,Date)-Day(Date)-1 End If				   	If t.Task.StartDate>0 Then setstartdate t,DateAdd("m",2,t.Task.StartDate)-Day(t.Task.StartDate)-1 End If				   ElseIf InStr(cats,getoption("endofquartercode",configdoc))>0 Then If t.Task.DueDate>0 Then t.Task.DueDate=DateAdd("m",(4-(Month(t.Task.DueDate) Mod 3) Mod 12),t.Task.DueDate)-Day(t.Task.DueDate) Else If sdd Then t.Task.DueDate=DateAdd("m",(4-(Month(Now) Mod 3) Mod 12),Now)-Day(Now) End If				       If t.Task.StartDate>0 Then setstartdate t,DateAdd("m",(4-(Month(t.Task.StartDate) Mod 3) Mod 12),t.Task.StartDate)-Day(t.Task.StartDate) End If				End If			 End If		End If	End If End Function Sub movetocompletedtopic(ByRef t As Topic, ByRef doccurrent As Document, ByRef opt As myoptiontype) Dim r As Relationship Dim completedtopic As Topic If Not t Is Nothing Then If Not t.IsCentralTopic Then Set completedtopic=createcompletedtopic(doccurrent, t, opt) If Not completedtopic Is Nothing Then completedtopic.SubTopics(True).Insert(t) For Each r In t.AllRelationships r.Delete Next completedtopic.Collapsed =True Set completedtopic=Nothing Else MsgBox "Completed topic not found/created" End If		End If	Else MsgBox "topic is empty" End If End Sub Sub copytocompletedtopic(ByRef t As Topic, ByRef doccurrent As Document, opt As myoptiontype) Dim completedtopic As Topic Dim tt As Topic If Not t.IsCentralTopic Then Set completedtopic=createcompletedtopic(doccurrent, t, opt) Set tt= completedtopic.AddSubTopic("") tt.Xml = t.Xml tt.Task.DueDate=Date tt.Task.Complete=100 completedtopic.Collapsed =True Set completedtopic=Nothing End If End Sub Function createcompletedtopic(ByRef doccurrent As Document, ByRef donetask As Topic, ByRef opt As myoptiontype) As Topic 'this function finds or creates a floating completed topic or a topic under the parent result or project depending on the options chosen Dim t As Topic Dim p As Topic Dim picon As Icon If Not opt.storecompleteinproject Then For Each t In doccurrent.AllFloatingTopics If LCase(t.Text)=LCase(opt.completedtext) Then t.Icons.AddStockIcon(mmStockIconNoEntry) Set createcompletedtopic=t End If		Next If createcompletedtopic Is Nothing Then Set createcompletedtopic=doccurrent.AllFloatingTopics.Add createcompletedtopic.Text=opt.completedtext createcompletedtopic.Icons.AddStockIcon(mmStockIconNoEntry) End If	Else Set p=donetask While Not p.IsCentralTopic 'jump out when found or at central Set p=p.ParentTopic For Each picon In p.Icons If picon.Name="CustomIcon-2051436099" Then Exit While End If				If picon.Name="CustomIcon--1181845906" And opt.storeinresult Then Exit While End If			Next Wend For Each t In p.AllSubTopics If LCase(t.Text)=LCase(opt.completedtext) Then 'how to avoid false positives here? Set createcompletedtopic=t Exit Function End If		Next If createcompletedtopic Is Nothing Then Set createcompletedtopic=p.AddSubTopic(opt.completedtext) createcompletedtopic.Icons.AddStockIcon(mmStockIconNoEntry) End If	End If	Set t=Nothing Set p=Nothing Set picon=Nothing End Function Sub Upgrade(ByRef configdoc As Document) 'Adds new branches and keywords to existing mark_task_complete_config.mmap. Change "lastupgrade" entry to avoid doing twice. Const currentversion="20090801" Dim a As Topic Dim lastupgrade As String Dim RunUpgrade As Boolean lastupgrade = getoption("lastupgrade",configdoc) If lastupgrade="" Then lastupgrade="0" RunUpgrade=True ElseIf Eval(lastupgrade) < currentversion Then 'do not want to eval("") RunUpgrade=True End If	If RunUpgrade Then '		configdoc.CentralTopic.Text = "Mark Task Complete Configuration Map" If MsgBox("Mark_task_complete needs to make some upgrades to your Configuration Map. This will take a minute.",vbOkCancel)=vbCancel Then End 'OPTIONS--- createoption "log-map-base-name",      "ao\Completed",    configdoc createoption "completedtext",   "Completed", configdoc createoption "referencetext",   "Reference", configdoc createoption "move-complete-to-branch", "1", configdoc createoption "store-complete-in-project", "1", configdoc createoption "store-in-result", "1", configdoc createoption "copy-completed-to-log-map", "1", configdoc createoption "copy-completed-to-calendar-branch", "1", configdoc createoption "save-dashboards", "1", configdoc createoption "setduetoday", "0", configdoc createoption "versioncheckfrequency", "30", configdoc 'check version weekly createoption "lastversioncheck", Str(Date), configdoc createoption "endofmonthcode", "endofmonth", configdoc createoption "endofquartercode", "endofquarter", configdoc createoption "delete-original", "0", configdoc createoption "save-maps", "1", configdoc

'		Set a = createmainbranch("Visit http://wiki.activityowner.com/index.php?title=Mark_Task_Complete for explanation of configuration options and how to setup repeating tasks",configdoc) a.CreateHyperlink("http://wiki.activityowner.com/index.php?title=Mark_Task_Complete")

Set a = createmainbranch(advancecodetext,configdoc) a.Notes.Text="Categories keywords used to advance tasks. 1st entry is units, 2nd entry tells how much to advance, 3rd entry tells how many units to start before due date. -1 = advance from duedate instead of done date (e.g. for mortgage)" addtriplet a, "daily",  			"d", "1", 		"0", 	"20090105.1", lastupgrade  'keyword, units, increment, lead time, added with upgrade, lastupgrade addtriplet a, "everytwo",  		"d", "2", 		"1", 	"20090105.1", lastupgrade addtriplet a, "weekly",  			"d", "7", 		"3", 	"20090105.1", lastupgrade addtriplet a, "eachweek",  		"d", "7", 		"-1", 	"20090105.1", lastupgrade addtriplet a, "monthly",  			"m", "1", 		"10", 	"20090105.1", lastupgrade addtriplet a, "eachmonth", 		"m", "1", 		"-1", 	"20090105.1", lastupgrade addtriplet a, "biannual",  		"m", "6", 		"30", 	"20090105.1", lastupgrade addtriplet a, "yearly",   			"m", "12",		"30", 	"20090105.1", lastupgrade addtriplet a, "eachyear", 			"m", "12",		"-1", 	"20090105.1", lastupgrade addtriplet a, "quarterly",			"m", "3",		"30", 	"20090105.1", lastupgrade addtriplet a, "eachquarter",		"m", "3",		"-1", 	"20090105.1", lastupgrade addtriplet a, "everyotherweek", 	"d", "14", 		"7", 	"20090105.1", lastupgrade addtriplet a, "everythreedays", 	"d", "3",		"1", 	"20090105.1", lastupgrade addtriplet a, "everyfivedays",  	"d", "5", 		"2", 	"20090105.1", lastupgrade addtriplet a, "everyothermonth", 	"m", "2",		"7", 	"20090105.1", lastupgrade addtriplet a, "every3weeks",     	"d", "21",		"7", 	"20090105.1", lastupgrade addtriplet a, "every2weeks",    	"d", "14", 		"7", 	"20090105.1", lastupgrade addtriplet a, "each2weeks",     	"d", "14",		"-1", 	"20090105.1", lastupgrade addtriplet a, "each3weeks",     	"d", "21",		"-1", 	"20090503", lastupgrade addtriplet a, "fortnightly",   	"d", "14",		"7", 	"20090105.1", lastupgrade addtriplet a, "eachfortnight",  	"d", "14",		"-1", 	"20090105.1", lastupgrade addtriplet a, "ongoing",           "d", "0",       "0",    "20090414" , lastupgrade

Set a=createmainbranch(daycodetext,configdoc) addkeyword a, "sunday","1", "20090303", lastupgrade addkeyword a, "monday","2", "20090303", lastupgrade addkeyword a, "tuesday","3", "20090303", lastupgrade addkeyword a, "wednesday","4", "20090303", lastupgrade addkeyword a, "thursday","5", "20090303", lastupgrade addkeyword a, "friday","6", "20090303", lastupgrade addkeyword a, "saturday","7", "20090303", lastupgrade

'---		checkforduplicates(configdoc) 'Mark map as upgraded setoption "lastupgrade", currentversion, configdoc If configdoc.IsModified Then configdoc.Save Set a=Nothing MsgBox "Configuration Update complete" End If End Sub