From ActivityOwnerWiki
'mark_task_complete.mmbas: mark and log tasks done and advance repeating tasks
'07Feb10 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
'#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 t.Task.StartDate=DateAdd(units,inc,t.Task.StartDate)
If Not datefixed And hasstart Then t.Task.StartDate=DateAdd(units,inc,Date)-lead
If sdd And Not hasstart Then t.Task.StartDate=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)
t.Task.StartDate=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
t.Task.StartDate=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
t.Task.StartDate=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
