Mark task complete-DEV.mmbas

From ActivityOwnerWiki
Jump to: navigation, search
'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