diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas index b53b4f9a..1ab815e3 100644 --- a/src/ce_dubproject.pas +++ b/src/ce_dubproject.pas @@ -60,6 +60,7 @@ type procedure loadFromFile(const aFilename: string); procedure saveToFile(const aFilename: string); // + procedure activate; function inGroup: boolean; procedure inGroup(value: boolean); function getFormat: TCEProjectFormat; @@ -145,6 +146,11 @@ end; {$ENDREGION --------------------------------------------------------------------} {$REGION ICECommonProject: project props ---------------------------------------} +procedure TCEDubProject.activate; +begin + subjProjFocused(fProjectSubject, self as ICECommonProject); +end; + function TCEDubProject.inGroup: boolean; begin exit(fInGroup); @@ -252,6 +258,8 @@ var saver: TMemoryStream; str: string; begin + if aFilename <> fFilename then + inGroup(false); saver := TMemoryStream.Create; try fFilename := aFilename; diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 72f0f055..bd09e91c 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -31,6 +31,8 @@ type function inGroup: boolean; // flag the project as grouped procedure inGroup(value: boolean); + // in a context of a group, activates the project + procedure activate; // indicates the project format function getFormat: TCEProjectFormat; // returns an untyped object that can be casted using getFormat() @@ -303,15 +305,23 @@ type // add a project to the gtoup; procedure addProject(aProject: ICECommonProject); // open a group of project. - procedure openGroup(aFilename: string); + procedure openGroup(const fname: string); // save the group to a file. - procedure saveGroup(aFilename: string); + procedure saveGroup(const fname: string); // close a group a initialize a new one procedure closeGroup; // indicates wether one of the project is modified or if the group is changed function groupModified: boolean; // indicates the group filename function groupFilename: string; + // indicates the count of project in the group + function projectCount: integer; + // returns the nth project + function getProject(index: Integer): ICECommonProject; + // tries to find the project named fname. + function findProject(const fname: string): ICECommonProject; + // selects the nth project + procedure selectProject(index: Integer); end; diff --git a/src/ce_main.lfm b/src/ce_main.lfm index b410dd2b..8565d62c 100644 --- a/src/ce_main.lfm +++ b/src/ce_main.lfm @@ -3034,6 +3034,42 @@ object CEMainForm: TCEMainForm end object MenuItem86: TMenuItem Action = actProjAddToGroup + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0033000000330000003300000033000000330000003300000033000000330000 + 00330000002F00000000000000000000000000000000000000004498D1F24397 + D1FF4094D0FF3F92CFFF3F92CFFF4093D0FF4193D1FF4193D1FF4194D1FF4194 + D1FF4295CFEF00000012000000000000000000000000000000004498D2FF449A + D3FFAAF4FFFF92F1FFFF94F1FFFF9AF4FFFF9EF7FFFF9FF7FFFF9FF7FFFFB1FD + FFFF6DBDEDFF3175A573000000000000000000000000000000004397D1FF62B8 + E3FF7ECCEDFF81E6FFFF87E8FFFF26A786FF007F38FF007F3BFF007F3CFF0081 + 3BFF25A082FF368CD1D2000000330000003300000033000000234095D0FF86D7 + F4FF4AA7DBFFE2FFFFFFE9FFFFFF007F39FF16EBABFF00E39DFF00E49FFF00E8 + 9FFF008039FFC2B1B0FFB3AFABFFAFAEABFFB0AFADFFA4A4A2C03E93D0FFB1F6 + FFFF4DA7DCFF388CCEFF4190D9FF00823BFF47E8BCFF00D699FF00D79CFF007C + 3DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB0B0ADFF3D92CFFFBBF3 + FFFF72DAFBFF6CCCF3FF74D0FFFF008139FF75EAD0FF4BEAD0FF00C59AFF00C8 + 9CFF007A34FFFFFFFFFFFEFCFDFFFCFCFCFFFFFFFFFFAEAEABFF3B92CFFFC6F5 + FFFF6BD8FAFF6FDAFCFF77DFFFFF008037FF93EDE0FF007B36FF88E5DCFF86E6 + DDFF007932FFFFFDFFFFFAF7F8FFF7F6F6FFFFFFFFFFADADABFF3B92CFFFD5F7 + FFFF5FD1F9FFB6EBFEFFE2FCFFFF44B188FF007E35FFFFFFFFFF007933FF0079 + 32FFFFFDFFFFFCF6F8FFF5F3F3FFF4F3F3FFFFFFFFFFADADABFF3D94D0FFDCFD + FFFFD8F9FFFFDBFBFFFF388FD1FF3993D9FFC2B2AEFFFFFFFFFFFFF6FAFFFFF6 + F9FFF8F3F4FFF1F0EFFFEFEFEEFFEFEFEEFFFFFFFFFFADADABFF4398D2B03D94 + D0FF3B92CFFF3D94D0FF4097D2E400000000BAB0A9FFFFFFFFFFEFEDEDFFEFED + EDFFF6F6F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAEAEABFF000000000000 + 000000000000000000000000000000000000B7B0A9FFFFFFFFFFE8E7E8FFE8E7 + E7FFFFFFFFFFCBCBCAFFA7A7A4FFA5A5A3FFFFFFFFFFAFAFADFF000000000000 + 000000000000000000000000000000000000B2AFAAFFFFFFFFFFE5E4E3FFE5E4 + E2FFFFFFFFFFA7A7A4FFEBEBEAFFFFFFFFFFE9E9E9FFB0B0AEAC000000000000 + 000000000000000000000000000000000000AFAEABFFFFFFFFFFE0E0DFFFDFDF + DEFFFFFFFFFFA5A5A3FFFFFFFFFFE8E8E8FFAFAFACA700000000000000000000 + 000000000000000000000000000000000000B0AFADFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFE9E9E9FFAEAEACA70000000000000000000000000000 + 000000000000000000000000000000000000B3B3B1B0B0B0ADFFAEAEACFFADAD + ABFFAEAEABFFAFAFADFFB0B0AEAC000000000000000000000000 + } end object MenuItem29: TMenuItem Caption = '-' @@ -3479,17 +3515,203 @@ object CEMainForm: TCEMainForm object MenuItem81: TMenuItem Caption = '-' end + object MenuItem87: TMenuItem + Action = actProjSelUngrouped + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 00000000000000000000000000000000001200000025000000330000002E0000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF000000 + 0000000000120000002500000033326E987A3E8BC1C84195D1FF3892D1ED0000 + 00330000003300000033000000330000003300000023FFFFFF00FFFFFF000000 + 002F326F997C3D8AC1C74092CEFF54ADDEFF66C4EDFF78E0FEFF3591D1FFBBB2 + AAFFB0AEABFFADADABFFAEAEABFFAFAFADFFA4A4A2C0FFFFFF00FFFFFF004295 + CEEF58B0DFFF6DC9EFFF7FE2FDFF7EE3FEFF7ADEFCFF7EE1FFFF308CCDFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB0B0ADFFFFFFFF00FFFFFF004094 + CFFF92F1FFFF85E7FFFF80E1FDFF7ADEFBFF77DBFBFF83E1FFFF308ACBFFFFFF + FBFFFFFFFDFFFCFCFCFFFCFCFCFFFFFFFFFFAEAEABFFFFFFFF00FFFFFF003E92 + CEFF9AF0FFFF83E4FDFF7EDFFCFF7ADDFBFF76DAFAFF89E2FEFF48A8DDFF70AE + D9FFFFFCF8FFF9F6F6FFF7F6F6FFFFFFFFFFADADABFFFFFFFF00FFFFFF003E92 + CEFFA3F1FFFF82E3FCFF7EDFFCFF7ADDFBFF76DAFAFF71D9FBFF9DE8FFFF2A89 + CBFFFFFBF6FFF6F4F3FFF4F3F3FFFFFFFFFFADADABFFFFFFFF00FFFFFF003D92 + CEFFADF3FFFF81E3FCFF7EDFFCFF7ADDFBFF76DAFAFF6FD8FAFFABEBFFFF2B89 + CCFFFFF8F1FFF2F1EFFFEFF0EEFFFFFFFFFFADADABFFFFFFFF00FFFFFF003C92 + CEFFB6F6FFFF80E3FCFF7DDFFCFF7ADDFBFF76DAFAFF6ED7FAFFB9EFFFFF2A89 + CCFFFCF2EDFFEEECEBFFEBEAEAFFFFFFFFFFADADABFFFFFFFF00FFFFFF003C91 + CEFFC0F8FFFF7FE2FCFF7DDFFCFF7ADDFBFF75DAFAFF6DD7FAFFC6F3FFFF2989 + CBFFFFF9F4FFFFFFFFFFFFFFFFFFFFFFFFFFAEAEABFFFFFFFF00FFFFFF003B91 + CEFFC9F9FFFF7EE2FCFF7CDEFCFF78DCFBFF72D9FAFF6AD6FAFFD2F6FFFF2888 + CBFFFFFFFFFFCDCBC9FFA4A4A2FFFFFFFFFFAFAFADFFFFFFFF00FFFFFF003A91 + CEFFD2FCFFFF7AE2FCFF77DDFCFF7FDFFBFF9BE6FDFFB3EDFFFFD4F9FFFF2688 + CBFFFFFFFFFFA7A5A2FFFFFFFFFFE9E9E9FFB0B0AEACFFFFFF00FFFFFF003991 + CFFFE9FFFFFFAFF0FFFFCEF7FFFFDAFAFFFFC4ECFCFF8CCAECFF5FAEE0FF82BD + E6FFFFFFFFFFFFFFFFFFE9E9E9FFAFAFADA700000000FFFFFF00FFFFFF003C93 + D0FFE9FFFFFFA8DAF3FF7BBDE4FF4398D2FF408EC7FF6E9CBCFF90A5B2FFBAAF + A6FFB5ADA6FFB5AFA9FFB5B1ADA40000000000000000FFFFFF00FFFFFF004297 + D2FF3B93D0FF62ADDCFF93CDEDFFBBE7FAFFD8FCFFFFD6FCFFFFD3FBFFFFD1FB + FFFFD3FCFFFF2E91D5FF000000000000000000000000FFFFFF00FFFFFF00459A + D3EF4498D2FF4197D1FF3F95D1FF3D94D0FF3B93D0FF3A92D0FF3A92D0FF3A93 + D0FF3C94D1FF3E97D3EE000000000000000000000000FFFFFF00 + } + end object MenuItem82: TMenuItem Action = actProjNewGroup + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 0000000000330000000000000033000000000000003300000000000000330000 + 000000000033000000000000003300000000FFFFFF00FFFFFF00FFFFFF000000 + 003389898AFF0000003389898AFF0000003389898AFF0000003389898AFF0000 + 003389898AFF0000003389898AFF00000033FFFFFF00FFFFFF00FFFFFF008989 + 8AFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFF89898AFFFFFFFF00FFFFFF00FFFFFF000000 + 0033FFFFFFFFFDFDFDFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFC + FCFFFCFCFCFFFDFDFDFFFFFFFFFF00000033FFFFFF00FFFFFF00FFFFFF008989 + 8AFFFFFFFFFFFAF9F9FFF9F8F8FFF9F8F8FFF9F8F8FFF9F8F8FFF9F8F8FFF9F8 + F8FFF9F8F8FFFAF9F9FFFFFFFFFF89898AFFFFFFFF00FFFFFF00FFFFFF000000 + 0033FFFFFFFFF6F6F6FFF6F6F6FFF6F6F6FFF6F6F6FFF6F6F6FFF6F6F6FFF6F6 + F6FFF6F6F6FFF6F6F6FFFFFFFFFF00000033FFFFFF00FFFFFF00FFFFFF008989 + 8AFFFFFFFFFFF4F4F3FFF4F4F3FFF4F4F3FFF4F4F3FFF4F4F3FFF4F4F3FFF4F4 + F3FFF4F4F3FFF4F4F3FFFFFFFFFF89898AFFFFFFFF00FFFFFF00FFFFFF000000 + 0033FFFFFFFFF2F1F0FFF2F1F0FFF2F1F0FFF2F1F0FFF2F1F0FFF2F1F0FFF2F1 + F0FFF2F1F0FFF2F1F0FFFFFFFFFF00000033FFFFFF00FFFFFF00FFFFFF008989 + 8AFFFFFFFFFFEFEFEEFFEFEFEEFFEFEFEEFFEFEFEEFFEFEFEEFFEFEFEEFFEFEF + EEFFEEEEEDFFEEEFEEFFFFFFFFFF89898AFFFFFFFF00FFFFFF00FFFFFF000000 + 0033FFFFFFFFEDEBEAFFEDECEBFFEDECEBFFEDECEBFFEDECEBFFECEBEAFFECEB + E9FFEBEAE9FFECEAE9FFFFFFFFFF00000033FFFFFF00FFFFFF00FFFFFF008989 + 8AFFFFFFFFFFE9E9E8FFEAEAE9FFEAEAE9FFEAEAE9FFE9E9E8FFF4F4F2FFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFF89898AFFFFFFFF00FFFFFF00FFFFFF000000 + 0033FFFFFFFFE7E6E5FFE8E7E6FFE8E7E6FFE8E7E6FFE6E5E4FFFFFFFFFF9191 + 91FFFFFFFFFF929292FFFFFFFFFF00000033FFFFFF00FFFFFF00FFFFFF008989 + 8AFFFFFFFFFFE3E3E2FFE4E4E3FFE4E5E4FFE4E4E3FFE3E3E2FFFFFFFFFFFFFF + FFFFE6E6E4FFFFFFFFFFE0E0E0AB89898AFFFFFFFF00FFFFFF00FFFFFF000000 + 0033FFFFFFFFE0DFDDFFE0DFDEFFE0DFDEFFE0DFDEFFDFDEDCFFFFFFFFFF9191 + 91FFFFFFFFFFDDDDDDA789898AFF00000000FFFFFF00FFFFFF00FFFFFF008989 + 8AFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFE0E0E0AB89898AFF0000000000000000FFFFFF00FFFFFF00FFFFFF00A5A5 + A53889898AFF0000000089898AFF0000000089898AFF0000000089898AFF0000 + 000089898AFF000000000000000000000000FFFFFF00FFFFFF00 + } end object MenuItem83: TMenuItem Action = actProjOpenGroup + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 00000000000000000000000000000000001200000025000000330000002E0000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF000000 + 0000000000120000002500000033326E987A3E8BC1C84195D1FF3892D1ED0000 + 00330000003300000033000000330000003300000023FFFFFF00FFFFFF000000 + 002F326F997C3D8AC1C74092CEFF54ADDEFF66C4EDFF78E0FEFF3591D1FFBBB2 + AAFFB0AEABFFADADABFFAEAEABFFAFAFADFFA4A4A2C0FFFFFF00FFFFFF004295 + CEEF58B0DFFF6DC9EFFF7FE2FDFF7EE3FEFF7ADEFCFF7EE1FFFF308CCDFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB0B0ADFFFFFFFF00FFFFFF004094 + CFFF92F1FFFF85E7FFFF80E1FDFF7ADEFBFF77DBFBFF83E1FFFF308ACBFFFFFF + FBFFFFFFFDFFFCFCFCFFFCFCFCFFFFFFFFFFAEAEABFFFFFFFF00FFFFFF003E92 + CEFF9AF0FFFF83E4FDFF7EDFFCFF7ADDFBFF76DAFAFF89E2FEFF48A8DDFF70AE + D9FFFFFCF8FFF9F6F6FFF7F6F6FFFFFFFFFFADADABFFFFFFFF00FFFFFF003E92 + CEFFA3F1FFFF82E3FCFF7EDFFCFF7ADDFBFF76DAFAFF71D9FBFF9DE8FFFF2A89 + CBFFFFFBF6FFF6F4F3FFF4F3F3FFFFFFFFFFADADABFFFFFFFF00FFFFFF003D92 + CEFFADF3FFFF81E3FCFF7EDFFCFF7ADDFBFF76DAFAFF6FD8FAFFABEBFFFF2B89 + CCFFFFF8F1FFF2F1EFFFEFF0EEFFFFFFFFFFADADABFFFFFFFF00FFFFFF003C92 + CEFFB6F6FFFF80E3FCFF7DDFFCFF7ADDFBFF76DAFAFF6ED7FAFFB9EFFFFF2A89 + CCFFFCF2EDFFEEECEBFFEBEAEAFFFFFFFFFFADADABFFFFFFFF00FFFFFF003C91 + CEFFC0F8FFFF7FE2FCFF7DDFFCFF7ADDFBFF75DAFAFF6DD7FAFFC6F3FFFF2989 + CBFFFFF9F4FFFFFFFFFFFFFFFFFFFFFFFFFFAEAEABFFFFFFFF00FFFFFF003B91 + CEFFC9F9FFFF7EE2FCFF7CDEFCFF78DCFBFF72D9FAFF6AD6FAFFD2F6FFFF2888 + CBFFFFFFFFFFCDCBC9FFA4A4A2FFFFFFFFFFAFAFADFFFFFFFF00FFFFFF003A91 + CEFFD2FCFFFF7AE2FCFF77DDFCFF7FDFFBFF9BE6FDFFB3EDFFFFD4F9FFFF2688 + CBFFFFFFFFFFA7A5A2FFFFFFFFFFE9E9E9FFB0B0AEACFFFFFF00FFFFFF003991 + CFFFE9FFFFFFAFF0FFFFCEF7FFFFDAFAFFFFC4ECFCFF8CCAECFF5FAEE0FF82BD + E6FFFFFFFFFFFFFFFFFFE9E9E9FFAFAFADA700000000FFFFFF00FFFFFF003C93 + D0FFE9FFFFFFA8DAF3FF7BBDE4FF4398D2FF408EC7FF6E9CBCFF90A5B2FFBAAF + A6FFB5ADA6FFB5AFA9FFB5B1ADA40000000000000000FFFFFF00FFFFFF004297 + D2FF3B93D0FF62ADDCFF93CDEDFFBBE7FAFFD8FCFFFFD6FCFFFFD3FBFFFFD1FB + FFFFD3FCFFFF2E91D5FF000000000000000000000000FFFFFF00FFFFFF00459A + D3EF4498D2FF4197D1FF3F95D1FF3D94D0FF3B93D0FF3A92D0FF3A92D0FF3A93 + D0FF3C94D1FF3E97D3EE000000000000000000000000FFFFFF00 + } end object MenuItem84: TMenuItem Action = actProjSaveGroup + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0033000000330000003300000033000000330000000800000008000000330000 + 0033000000330000003300000033000000330000003300000000976C1496B782 + 18FFB68014FFB37A06FFD7CFD2FFD8CEC9FF6C676653593A0053D9CFCEFFD5CA + C3FFD4CAC4FFD6CFD2FFB37A06FFB68014FFB78218FF976C1496B78218FFF6CD + 8BFFF2C67DFFF0C171FFFAF7FBFFFFFFFFFF4C4848FF989392FFFFFFFFFFF7EF + EAFFF6EFEBFFF9F6FAFFF0C171FFF2C67DFFF6CD8BFFB78218FFB68116FFF3CA + 87FFEDBC6DFFEBB761FFF8F5F7FFFFFFFFFF4A4541FF948C88FFFFFFFFFFF1E8 + E0FFF0E7E0FFF7F4F7FFEBB761FFEDBC6DFFF3CA87FFB68116FFB68116FFF1CB + 89FFE9B762FFE7B257FFF9F8FBFFFDF7F2FF877F79FF4A4441FFFEF7F2FFEEE3 + D8FFEDE2D9FFF8F7FBFFE8B257FFE9B762FFF1CB89FFB68116FFB68116FFF3CC + 8EFFE8B25AFFE7AE51FFFCFFFFFFECE0D7FFF1E4DAFFF1E5DAFFEDE0D5FFEADD + D3FFE9DED5FFFBFFFFFFE7AE51FFE8B25AFFF3CC8EFFB68116FFB68115FFF3CE + 94FFE6AE51FFE5AB4BFFE6C9A4FFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFDFF + FFFFFEFFFFFFE6C9A4FFE5AC4BFFE6AE51FFF3CE94FFB68115FFB68115FFF3D0 + 9AFFE5A845FFE3A640FFE2A136FFE29E2FFFE19D2DFFE19D2CFFE19D2CFFE19D + 2DFFE29E2FFFE2A136FFE3A640FFE5A845FFF3D09AFFB68115FFB68114FFF4D4 + A0FFE1A136FFF2DEB7FFFCFFFFFFFBFFFDFFFBFFFCFFFBFFFDFFFBFFFDFFFBFF + FDFFFBFFFDFFFBFFFFFFF2DEB7FFE1A136FFF4D4A0FFB68114FFB68014FFF6D8 + A7FFE09C27FFFBFFFFFFFCFBF3FFFCF9EFFFFBF8EEFFFCFAF0FFFCFAF0FFFBF9 + EEFFF9F8EDFFFAF9F1FFFAFEFEFFE09B27FFF6D8A7FFB68014FFB68014FFF8DC + B0FFE0981CFFFBFBF8FF79787BFFA2A0A2FFFCF6EAFF797879FFA3A1A3FFA09F + A1FFFAF4E9FF9D9DA0FFF9F9F6FFE0981CFFF8DCB0FFB68014FFB68113FFFCE3 + BCFF9B6104FFFDFCF9FFFDF5E8FFFEF4E7FFFBF2E5FFFCF2E5FFFBF2E5FFFBF2 + E5FFFAF1E3FFF9F1E5FFFCFAF7FF9A6104FFFCE3BCFFB68113FFB68012FFFEE9 + C6FF714100FFFFFFFFFF79797AFF7A7A7AFFA2A1A1FF9F9F9FFFF6ECDEFF7777 + 77FFA1A1A1FF9E9FA0FFFFFFFFFF704100FFFEE9C6FFB68012FFB68012FFFDEC + D1FFDA8600FFFFFFFFFFF1E5D8FFF2E5D8FFF2E5D7FFF0E3D6FFEFE2D5FFF1E4 + D7FFF1E4D6FFEFE3D6FFFFFFFFFFDA8600FFFDECD1FFB68012FFB78115FFFFEC + CDFFFCE7C3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFCE7C3FFFFECCDFFB78115FFB782187CB781 + 14FFB57E0FFFB57C0BFFB57C09FFB57C09FFB57C09FFB57C09FFB57C09FFB57C + 09FFB57C09FFB57C09FFB57C0BFFB57E0FFFB78114FFB782187C + } end object MenuItem85: TMenuItem Action = actProjSaveGroupAs + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000002C0000 + 0033000000330000003300000033000000330000003300000033000000330000 + 00330000003300000033000000330000002C0000000000000000B3811AE1B781 + 14FFB57E10FFB57D0CFFB67C0BFFB67C0AFFB57C0AFFB67D0AFFB77D0BFFB77E + 0BFFB77E0CFFB67F10FFB78114FFB3811AE1BB871E00BB871F00B78115FFFEE9 + C7FFFBE4BDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFE7BCFFFFEAC6FFB78115FFBB861D00BB871F00B67F12FFFBE9 + CFFFD88500FFFFFFFFFF797B7FFFA2A4A5FFFFFCF3FF828180FF425C72FF385A + 80FF3784DDFFEB8D00FFFFECCCFFB78011FFBB861C00BC871D00B67F12FFFAE4 + C1FFDB8D0AFFFEFFFFFFFDF7EBFFFFF8EAFFFFF7E9FFFFFDEBFF507C9CFF7BA3 + B5FF86D2FFFF1F60A2FFFFEBB6FFBE830DFFC0871600C2891600B68013FFF7DE + B5FFDC9317FFFFFFFFFF787879FF7A7979FFA4A2A1FFABA39FFF3AABF2FFA1ED + FFFF9ADEFEFF0998FFFF2366A9FFCA8604FF0000000971747E00B68014FFF5D9 + AAFFDF9822FFFFFFFFFFF1E6D9FFF2E6D9FFF2E6D7FFF6E6D6FFCED9DBFF1D6F + C5FF39C4FFFF1DABFFFF7EA3C4FF7C7878FF3B3B3A5674767000B68114FFF4D4 + A2FFE29F31FFE9E1E2FFFEFFFFFFFEFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFF1B74D0FFACDBF4FF928782FFC1C0BAFF797B71FF00000033B68115FFF3D1 + 99FFE3A740FFE2A336FFE19F2EFFE19E2BFFE19E2BFFE29F2CFFE3A02CFFE8A3 + 2DFFF1A830FF817F83FFE9E9E8FF898B83FFAC7BA7FF9969CBFFB68115FFF3CE + 93FFE5AB48FFEED7B6FFF5F3F7FFF5F1F4FFF7F3F6FFFBF8FAFFFCF8FAFFF9F6 + F9FFF2D9B4FFEEAE40FF7A8185FFE0B1E4FFCB96C7FFAE7DCEFFB68116FFF3CB + 8CFFE7AE4EFFF5F4F8FFF0E9E4FFF1E9E2FFF8EFE8FF8A847FFF88817EFFF8F0 + EBFFF7F5F9FFEAAF4BFFF6CD7DFFBC87E4FFBE8ADAFFAC7BCF00B68116FFF1C8 + 87FFE8B258FFF6F5F7FFEEE2D9FFEFE3D9FFFFFAF5FF5C5752FF48423FFFFFFB + F7FFF7F6F8FFE9B257FFF2C880FFB68100FFBE8AEC00AB7BDF00B68116FFF2CA + 85FFEBB962FFF8F8FBFFE9DCD1FFEBDDD1FFFFFFFCFF958B83FF4A443FFFFFFF + FFFFFAF9FCFFEBB962FFF2CA83FFB6810FFFBB860F00BC880D00B78218FFF6CC + 89FFF2C274FFFFFFFFFFFEFDFCFFFFFEFCFFFFFEF9FF93887EFF4A433DFFFFFF + FFFFFFFFFFFFF2C274FFF6CC89FFB78217FFBB861C00BB871C00B9851CC5B781 + 16FFB37A06FFD6CFD1FFD4C9C3FFD4C9C1FFD8CCC5FFE3D7D02B4A433D00DFD4 + CEFFD8D1D2FFB37A06FFB78116FFB9851CC5BB871F00BB871F00 + } + end + object MenuItem88: TMenuItem + Action = actProjGroupCompile end end object MenuItem8: TMenuItem @@ -3929,6 +4151,12 @@ object CEMainForm: TCEMainForm object MenuItem44: TMenuItem Caption = '-' end + object MenuItem89: TMenuItem + Action = actProjGroupCompile + end + object MenuItem90: TMenuItem + Caption = '-' + end object MenuItem45: TMenuItem Action = actProjRun Bitmap.Data = { @@ -4432,6 +4660,19 @@ object CEMainForm: TCEMainForm OnExecute = actProjAddToGroupExecute OnUpdate = updateProjectBasedAction end + object actProjSelUngrouped: TAction + Category = 'Project' + Caption = 'Select ungrouped project' + ImageIndex = 9 + OnExecute = actProjSelUngroupedExecute + OnUpdate = updateProjectBasedAction + end + object actProjGroupCompile: TAction + Category = 'Project' + Caption = 'Compile project group' + ImageIndex = 21 + OnExecute = actProjGroupCompileExecute + end end object imgList: TImageList left = 64 diff --git a/src/ce_main.pas b/src/ce_main.pas index 29175881..11d90b82 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -48,6 +48,8 @@ type actFileRun: TAction; actFileDscanner: TAction; actFileRunOut: TAction; + actProjGroupCompile: TAction; + actProjSelUngrouped: TAction; actProjAddToGroup: TAction; actProjNewGroup: TAction; actProjOpenGroup: TAction; @@ -163,6 +165,10 @@ type MenuItem84: TMenuItem; MenuItem85: TMenuItem; MenuItem86: TMenuItem; + MenuItem87: TMenuItem; + MenuItem88: TMenuItem; + MenuItem89: TMenuItem; + MenuItem90: TMenuItem; mnuLayout: TMenuItem; mnuItemMruFile: TMenuItem; mnuItemMruProj: TMenuItem; @@ -180,12 +186,14 @@ type procedure actFileSaveCopyAsExecute(Sender: TObject); procedure actNewGroupExecute(Sender: TObject); procedure actProjAddToGroupExecute(Sender: TObject); + procedure actProjGroupCompileExecute(Sender: TObject); procedure actProjNewDubJsonExecute(Sender: TObject); procedure actProjNewGroupExecute(Sender: TObject); procedure actProjNewNativeExecute(Sender: TObject); procedure actProjOpenGroupExecute(Sender: TObject); procedure actProjSaveGroupAsExecute(Sender: TObject); procedure actProjSaveGroupExecute(Sender: TObject); + procedure actProjSelUngroupedExecute(Sender: TObject); procedure actSetRunnableSwExecute(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure MenuItem77Click(Sender: TObject); @@ -255,7 +263,8 @@ type fMultidoc: ICEMultiDocHandler; fScCollectCount: Integer; fUpdateCount: NativeInt; - fProjectInterface: ICECommonProject; + fProject: ICECommonProject; + fFreeProj: ICECommonProject; fDubProject: TCEDubProject; fNativeProject: TCENativeProject; fProjMru: TCEMRUProjectList; @@ -281,6 +290,8 @@ type fRunProjAfterCompArg: boolean; fRunProjAfterCompile: boolean; + fIsCompilingGroup: boolean; + fGroupCompilationCnt: integer; fFirstShown: boolean; fProjFromCommandLine: boolean; fInitialized: boolean; @@ -679,13 +690,10 @@ var begin if aSource is TCEMainForm then begin - itf := TCEMainForm(aSource).fProjectInterface; - if itf = nil then exit; - fProject := itf.filename; + itf := TCEMainForm(aSource).fFreeProj; + if itf <> nil then + fProject := itf.filename; fProjectGroup := getProjectGroup.groupFilename; - // reload from group - if itf.inGroup and fProjectGroup.fileExists then - fProject := ''; end else inherited; end; @@ -702,7 +710,7 @@ begin dst := TCEMainForm(aDestination); if dst.fProjFromCommandLine then exit; - itf := dst.fProjectInterface; + itf := dst.fProject; if (itf <> nil) and (itf.filename = fProject) and (itf.filename.fileExists) then exit; if fProject.isNotEmpty and fProject.fileExists then @@ -710,9 +718,9 @@ begin dst.openProj(fProject); hdl := getMultiDocHandler; if assigned(hdl) then - mem := hdl.findDocument(dst.fProjectInterface.filename); + mem := hdl.findDocument(dst.fProject.filename); if mem.isNotNil then - if dst.fProjectInterface.getFormat = pfNative then + if dst.fProject.getFormat = pfNative then mem.Highlighter := LfmSyn else mem.Highlighter := JsSyn; @@ -1332,7 +1340,7 @@ begin // see: http://forum.lazarus.freepascal.org/index.php/topic,30616.0.htm if fAppliOpts.reloadLastDocuments then LoadLastDocsAndProj; - if fProjectInterface = nil then + if fProject = nil then newNativeProj; DockMaster.ResetSplitters; @@ -1392,14 +1400,19 @@ var begin canClose := false; SaveLastDocsAndProj; - if (fProjectInterface <> nil) and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fFreeProj <> nil) then + begin + if fFreeProj.modified and + (dlgFileChangeClose(fFreeProj.filename) = mrCancel) then + exit; + fFreeProj.getProject.Free; + fFreeProj := nil; + end; for i := fMultidoc.documentCount-1 downto 0 do if not fMultidoc.closeDocument(i) then exit; if fProjectGroup.groupModified then if (dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel) then exit; canClose := true; - closeProj; fProjectGroup.closeGroup; end; @@ -1410,7 +1423,7 @@ end; procedure TCEMainForm.updateProjectBasedAction(sender: TObject); begin - TAction(sender).Enabled := fProjectInterface <> nil; + TAction(sender).Enabled := fProject <> nil; end; procedure TCEMainForm.updateDocEditBasedAction(sender: TObject); @@ -1548,11 +1561,13 @@ end; {$REGION ICEProjectObserver ----------------------------------------------------} procedure TCEMainForm.projNew(aProject: ICECommonProject); begin - fProjectInterface := aProject; - case fProjectInterface.getFormat of - pfNative: fNativeProject := TCENativeProject(fProjectInterface.getProject); - pfDub: fDubProject := TCEDubProject(fProjectInterface.getProject); - end; + fProject := aProject; + case fProject.getFormat of + pfNative: fNativeProject := TCENativeProject(fProject.getProject); + pfDub: fDubProject := TCEDubProject(fProject.getProject); + end; + if not fProject.inGroup then + fFreeProj := aProject; end; procedure TCEMainForm.projChanged(aProject: ICECommonProject); @@ -1562,9 +1577,11 @@ end; procedure TCEMainForm.projClosing(aProject: ICECommonProject); begin - if fProjectInterface <> aProject then + if aProject = fFreeProj then + fFreeProj := nil; + if fProject <> aProject then exit; - fProjectInterface := nil; + fProject := nil; fDubProject := nil; fNativeProject := nil; showProjTitle; @@ -1572,12 +1589,17 @@ end; procedure TCEMainForm.projFocused(aProject: ICECommonProject); begin - fProjectInterface := aProject; - case fProjectInterface.getFormat of - pfNative: fNativeProject := TCENativeProject(fProjectInterface.getProject); - pfDub: fDubProject := TCEDubProject(fProjectInterface.getProject); - end; - showProjTitle; + fProject := aProject; + case fProject.getFormat of + pfNative: fNativeProject := TCENativeProject(fProject.getProject); + pfDub: fDubProject := TCEDubProject(fProject.getProject); + end; + if not fProject.inGroup then + fFreeProj := aProject + else if (fProject = fFreeProj) and (fProject.inGroup) then + fFreeProj := nil; + + showProjTitle; end; procedure TCEMainForm.projCompiling(aProject: ICECommonProject); @@ -1588,21 +1610,38 @@ procedure TCEMainForm.projCompiled(aProject: ICECommonProject; success: boolean) var runArgs: string = ''; runprev: boolean = true; + i: integer; begin - if fRunProjAfterCompile and assigned(fProjectInterface) then + if not fIsCompilingGroup then begin - if not success then - runprev := dlgYesNo('last build failed, continue and run ?') = mrYes; - if runprev then + if fRunProjAfterCompile and assigned(fProject) then begin - if fRunProjAfterCompArg and - not InputQuery('Execution arguments', '', runargs) then - runargs := ''; - fProjectInterface.run(runargs); + if not success then + runprev := dlgYesNo('last build failed, continue and run ?') = mrYes; + if runprev then + begin + if fRunProjAfterCompArg and + not InputQuery('Execution arguments', '', runargs) then + runargs := ''; + fProject.run(runargs); + end; + end; + fRunProjAfterCompile := false; + fRunProjAfterCompArg := false; + end + else begin + fGroupCompilationCnt += 1; + if (fGroupCompilationCnt = fProjectGroup.projectCount) then + begin + for i:= 0 to fProjectGroup.projectCount-1 do + if not fProjectGroup.getProject(i).compiled then + begin + fMsgs.message('error, the project group is not fully compiled', nil, amcAll, amkErr); + exit; + end; + fMsgs.message('the project group is successfully compiled', nil, amcAll, amkInf); end; end; - fRunProjAfterCompile := false; - fRunProjAfterCompArg := false; end; {$ENDREGION} @@ -1767,11 +1806,11 @@ end; procedure TCEMainForm.actProjOpenContFoldExecute(Sender: TObject); begin - if fProjectInterface = nil then exit; - if not fProjectInterface.filename.fileExists then exit; + if fProject = nil then exit; + if not fProject.filename.fileExists then exit; // DockMaster.GetAnchorSite(fExplWidg).Show; - fExplWidg.expandPath(fProjectInterface.filename.extractFilePath); + fExplWidg.expandPath(fProject.filename.extractFilePath); end; procedure TCEMainForm.actFileNewExecute(Sender: TObject); @@ -1833,10 +1872,10 @@ end; procedure TCEMainForm.actFileAddToProjExecute(Sender: TObject); begin if fDoc.isNil then exit; - if fProjectInterface = nil then exit; - if fProjectInterface.filename = fDoc.fileName then exit; + if fProject = nil then exit; + if fProject.filename = fDoc.fileName then exit; // - if fProjectInterface.getFormat = pfNative then + if fProject.getFormat = pfNative then begin if fDoc.fileName.fileExists and not fDoc.isTemporary then fNativeProject.addSource(fDoc.fileName) @@ -1999,8 +2038,8 @@ begin exit; if fRunnableDestination.isNotEmpty then begin - if not fAlwaysUseDest and assigned(fProjectInterface) - and not fProjectInterface.isSource(fDoc.fileName) then + if not fAlwaysUseDest and assigned(fProject) + and not fProject.isSource(fDoc.fileName) then exit; if FilenameIsAbsolute(fRunnableDestination) then begin @@ -2421,13 +2460,13 @@ end; procedure TCEMainForm.actProjCompileExecute(Sender: TObject); begin - fProjectInterface.compile; + fProject.compile; end; procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject); begin fRunProjAfterCompile := true; - fProjectInterface.compile; + fProject.compile; end; procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); @@ -2437,17 +2476,17 @@ end; procedure TCEMainForm.actProjRunExecute(Sender: TObject); begin - if fProjectInterface.binaryKind <> executable then + if fProject.binaryKind <> executable then begin dlgOkInfo('Non executable projects cant be run'); exit; end; - if (not fProjectInterface.targetUpToDate) then if + if (not fProject.targetUpToDate) then if dlgYesNo('The project output is not up-to-date, rebuild ?') = mrYes then - fProjectInterface.compile; - if fProjectInterface.outputFilename.fileExists - or (fProjectInterface.getFormat = pfDub) then - fProjectInterface.run; + fProject.compile; + if fProject.outputFilename.fileExists + or (fProject.getFormat = pfDub) then + fProject.run; end; procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject); @@ -2455,7 +2494,7 @@ var runargs: string = ''; begin if InputQuery('Execution arguments', '', runargs) then - fProjectInterface.run(runargs); + fProject.run(runargs); end; {$ENDREGION} @@ -2617,49 +2656,50 @@ end; {$REGION project ---------------------------------------------------------------} procedure TCEMainForm.showProjTitle; begin - if (fProjectInterface <> nil) and fProjectInterface.filename.fileExists then - caption := format('Coedit - %s', [shortenPath(fProjectInterface.filename, 30)]) + if (fProject <> nil) and fProject.filename.fileExists then + caption := format('Coedit - %s', [shortenPath(fProject.filename, 30)]) else caption := 'Coedit'; end; procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo); begin - if fProjectInterface = nil then exit; - if fProjectInterface.filename <> aEditor.fileName then exit; + if fProject = nil then exit; + if fProject.filename <> aEditor.fileName then exit; // - aEditor.saveToFile(fProjectInterface.filename); - openProj(fProjectInterface.filename); + aEditor.saveToFile(fProject.filename); + openProj(fProject.filename); end; procedure TCEMainForm.closeProj; begin - if fProjectInterface = nil then exit; + if fProject = nil then exit; // - if not fProjectInterface.inGroup then + if fProject = fFreeProj then begin - fProjectInterface.getProject.Free; - fProjectInterface := nil; - fNativeProject := nil; - fDubProject := nil; + fProject.getProject.Free; + fFreeProj := nil; end; + fProject := nil; + fNativeProject := nil; + fDubProject := nil; showProjTitle; end; procedure TCEMainForm.actProjNewDubJsonExecute(Sender: TObject); begin - if (fProjectInterface <> nil) and not fProjectInterface.inGroup - and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProject <> nil) and not fProject.inGroup + and fProject.modified and + (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; closeProj; newDubProj; end; procedure TCEMainForm.actProjNewNativeExecute(Sender: TObject); begin - if (fProjectInterface <> nil) and not fProjectInterface.inGroup - and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProject <> nil) and not fProject.inGroup + and fProject.modified and + (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; closeProj; newNativeProj; end; @@ -2668,7 +2708,7 @@ procedure TCEMainForm.newNativeProj; begin fNativeProject := TCENativeProject.Create(nil); fNativeProject.Name := 'CurrentProject'; - fProjectInterface := fNativeProject as ICECommonProject; + fProject := fNativeProject as ICECommonProject; showProjTitle; end; @@ -2678,18 +2718,18 @@ begin fDubProject.json.Add('name', ''); fDubProject.beginModification; fDubProject.endModification; - fProjectInterface := fDubProject as ICECommonProject; + fProject := fDubProject as ICECommonProject; showProjTitle; end; procedure TCEMainForm.saveProj; begin - fProjectInterface.saveToFile(fProjectInterface.filename); + fProject.saveToFile(fProject.filename); end; procedure TCEMainForm.saveProjAs(const aFilename: string); begin - fProjectInterface.saveToFile(aFilename); + fProject.saveToFile(aFilename); showProjTitle; end; @@ -2701,28 +2741,26 @@ begin else newNativeProj; // - fProjectInterface.loadFromFile(aFilename); + fProject.loadFromFile(aFilename); showProjTitle; end; procedure TCEMainForm.mruProjItemClick(Sender: TObject); begin - if (fProjectInterface <> nil) and not fProjectInterface.inGroup and - fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProject <> nil) and not fProject.inGroup and + fProject.modified and + (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; openProj(TMenuItem(Sender).Hint); end; procedure TCEMainForm.actProjCloseExecute(Sender: TObject); begin - if (fProjectInterface <> nil) and not fProjectInterface.inGroup and - fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProject <> nil) and not fProject.inGroup and + fProject.modified and + (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; closeProj; end; -//TODO-cprojectgroup: handle filename change when grouped - procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject); begin with TSaveDialog.Create(nil) do @@ -2735,15 +2773,15 @@ end; procedure TCEMainForm.actProjSaveExecute(Sender: TObject); begin - if fProjectInterface = nil then exit; - if fProjectInterface.filename.isNotEmpty then saveProj + if fProject = nil then exit; + if fProject.filename.isNotEmpty then saveProj else actProjSaveAs.Execute; end; procedure TCEMainForm.actProjOpenExecute(Sender: TObject); begin - if (fProjectInterface <> nil) and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProject <> nil) and fProject.modified and + (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; with TOpenDialog.Create(nil) do try if execute then openProj(filename); @@ -2756,7 +2794,7 @@ procedure TCEMainForm.actProjOptsExecute(Sender: TObject); var win: TControl = nil; begin - if assigned(fProjectInterface) then case fProjectInterface.getFormat of + if assigned(fProject) then case fProject.getFormat of pfDub: win := DockMaster.GetAnchorSite(fDubProjWidg); pfNative: win := DockMaster.GetAnchorSite(fPrjCfWidg); end @@ -2770,11 +2808,11 @@ end; procedure TCEMainForm.actProjSourceExecute(Sender: TObject); begin - if fProjectInterface = nil then exit; - if not fProjectInterface.filename.fileExists then exit; + if fProject = nil then exit; + if not fProject.filename.fileExists then exit; // - openFile(fProjectInterface.filename); - if fProjectInterface.getFormat = pfNative then + openFile(fProject.filename); + if fProject.getFormat = pfNative then fDoc.Highlighter := LfmSyn else fDoc.Highlighter := JsSyn; @@ -2782,12 +2820,19 @@ end; procedure TCEMainForm.actProjOptViewExecute(Sender: TObject); begin - if fProjectInterface = nil then exit; - dlgOkInfo(fProjectInterface.getCommandLine); + if fProject = nil then exit; + dlgOkInfo(fProject.getCommandLine); end; procedure TCEMainForm.actProjOpenGroupExecute(Sender: TObject); begin + if (fProject <> nil) and not fProject.inGroup and + fProject.modified then + begin + if dlgFileChangeClose(fProject.filename) = mrCancel then + exit; + fProject.getProject.Free; + end; if fProjectGroup.groupModified then begin if dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel then @@ -2822,6 +2867,12 @@ begin fProjectGroup.saveGroup(fProjectGroup.groupFilename); end; +procedure TCEMainForm.actProjSelUngroupedExecute(Sender: TObject); +begin + if fFreeProj <> nil then + fFreeProj.activate; +end; + procedure TCEMainForm.actNewGroupExecute(Sender: TObject); begin if fProjectGroup.groupModified then @@ -2834,11 +2885,28 @@ end; procedure TCEMainForm.actProjAddToGroupExecute(Sender: TObject); begin - if fProjectInterface = nil then + if fFreeProj = nil then exit; - if fProjectInterface.inGroup then + if fFreeProj.inGroup then exit; - fProjectGroup.addProject(fProjectInterface); + fProjectGroup.addProject(fFreeProj); + fFreeProj := nil; +end; + +procedure TCEMainForm.actProjGroupCompileExecute(Sender: TObject); +var + i: integer; +begin + if fProjectGroup.projectCount = 0 then + exit; + fGroupCompilationCnt := 0; + fIsCompilingGroup := true; + fMsgs.message('start compiling a project group...', nil, amcAll, amkInf); + for i:= 0 to fProjectGroup.projectCount-1 do + begin + fProjectGroup.getProject(i).activate; + fProject.compile; + end; end; procedure TCEMainForm.actProjNewGroupExecute(Sender: TObject); diff --git a/src/ce_nativeproject.pas b/src/ce_nativeproject.pas index 9d5ab2d6..38c1d3ea 100644 --- a/src/ce_nativeproject.pas +++ b/src/ce_nativeproject.pas @@ -89,6 +89,7 @@ type function addConfiguration: TCompilerConfiguration; procedure getOpts(const aList: TStrings); // + procedure activate; procedure inGroup(value: boolean); function inGroup: boolean; function getFormat: TCEProjectFormat; @@ -189,6 +190,11 @@ begin fInGroup:=value; end; +procedure TCENativeProject.activate; +begin + subjProjFocused(fProjectSubject, self as ICECommonProject); +end; + function TCENativeProject.getFormat: TCEProjectFormat; begin exit(pfNative); @@ -252,6 +258,8 @@ var i: NativeInt; begin beginUpdate; + if aFilename <> fFilename then + inGroup(false); oldBase := fBasePath; fBasePath := aFilename.extractFilePath; // diff --git a/src/ce_projgroup.lfm b/src/ce_projgroup.lfm index a9d38539..7219bbd4 100644 --- a/src/ce_projgroup.lfm +++ b/src/ce_projgroup.lfm @@ -1,20 +1,20 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget Left = 866 - Height = 240 + Height = 268 Top = 277 Width = 561 Caption = 'Project group' - ClientHeight = 240 + ClientHeight = 268 ClientWidth = 561 inherited Back: TPanel - Height = 240 + Height = 268 Width = 561 - ClientHeight = 240 + ClientHeight = 268 ClientWidth = 561 inherited Content: TPanel - Height = 240 + Height = 268 Width = 561 - ClientHeight = 240 + ClientHeight = 268 ClientWidth = 561 object Panel1: TPanel[0] Left = 4 @@ -78,12 +78,11 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget end object lstProj: TListView[1] Left = 4 - Height = 202 + Height = 200 Top = 34 Width = 553 Align = alClient AutoSort = False - AutoWidthLastColumn = True BorderSpacing.Around = 4 Columns = < item @@ -99,11 +98,7 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget item AutoSize = True Caption = 'Configuration' - Width = 94 - end - item - Caption = 'Location' - Width = 369 + Width = 463 end> GridLines = True ReadOnly = True @@ -112,6 +107,52 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget ViewStyle = vsReport OnDblClick = lstProjDblClick end + object Panel2: TPanel[2] + Left = 4 + Height = 26 + Top = 238 + Width = 553 + Align = alBottom + BorderSpacing.Around = 4 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 553 + TabOrder = 2 + object btnFreeFocus: TBitBtn + Left = 497 + Height = 26 + Hint = 'Put the focus on the ungrouped project' + Top = 0 + Width = 28 + Align = alRight + Layout = blGlyphBottom + OnClick = btnFreeFocusClick + Spacing = 0 + TabOrder = 0 + end + object StaticText1: TStaticText + Left = 2 + Height = 22 + Top = 2 + Width = 493 + Align = alClient + BorderSpacing.Around = 2 + BorderStyle = sbsSunken + TabOrder = 1 + end + object btnAddUnfocused: TBitBtn + Left = 525 + Height = 26 + Hint = 'Put the ungrouped project in the group' + Top = 0 + Width = 28 + Align = alRight + Layout = blGlyphBottom + OnClick = btnAddUnfocusedClick + Spacing = 0 + TabOrder = 2 + end + end end end inherited contextMenu: TPopupMenu diff --git a/src/ce_projgroup.pas b/src/ce_projgroup.pas index 6d68947f..82dab972 100644 --- a/src/ce_projgroup.pas +++ b/src/ce_projgroup.pas @@ -5,7 +5,7 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, ExtCtrls, Menus, - Buttons, dialogs, ComCtrls, + Buttons, dialogs, ComCtrls, StdCtrls, ce_widget, ce_common, ce_interfaces, ce_writableComponent, ce_observer, ce_nativeproject, ce_dubproject, ce_anyprojloader, ce_sharedres; @@ -29,37 +29,40 @@ type (** * Collection that handles several project at once. *) - TProjectGroup = class(TWritableLfmTextComponent, ICEProjectGroup) + TProjectGroup = class(TWritableLfmTextComponent, ICEProjectGroup, IFPObserver) private - fIndex: integer; + fProjectIndex: integer; fItems: TCollection; fModified: boolean; fOnChanged: TNotifyEvent; procedure setItems(value: TCollection); - procedure setIndex(value: integer); + procedure setProjectIndex(value: integer); function getItem(index: integer): TProjectGroupItem; procedure doChanged; // - procedure addProject(aProject: ICECommonProject); - procedure openGroup(aFilename: string); - procedure saveGroup(aFilename: string); - procedure closeGroup; - function groupModified: boolean; - function groupFilename: string; - function singleServiceName: string; + procedure FPOObservedChanged(ASender : TObject; Operation : + TFPObservedOperation; Data : Pointer); protected procedure afterLoad; override; procedure afterSave; override; published property items: TCollection read fItems write setItems; - property index: integer read fIndex write setIndex; + property projectIndex: integer read fProjectIndex write setProjectIndex; public constructor create(aOwner: TComponent); override; destructor destroy; override; // - function projectCount: Integer; + function singleServiceName: string; + procedure addProject(aProject: ICECommonProject); + procedure openGroup(const fname: string); + procedure saveGroup(const fname: string); + procedure closeGroup; + function groupModified: boolean; + function groupFilename: string; + function projectCount: integer; function getProject(ix: Integer): ICECommonProject; - function findProject(aFilename: string): ICECommonProject; + function findProject(const fname: string): ICECommonProject; + procedure selectProject(ix: Integer); // function addItem(const fname: string): TProjectGroupItem; property item[ix: integer]: TProjectGroupItem read getItem; default; @@ -74,11 +77,17 @@ type TCEProjectGroupWidget = class(TCEWidget, ICEProjectObserver) BtnAddProj: TBitBtn; + btnAddUnfocused: TBitBtn; btnMoveDown: TBitBtn; btnMoveUp: TBitBtn; + btnFreeFocus: TBitBtn; btnRemProj: TBitBtn; lstProj: TListView; Panel1: TPanel; + Panel2: TPanel; + StaticText1: TStaticText; + procedure btnAddUnfocusedClick(Sender: TObject); + procedure btnFreeFocusClick(Sender: TObject); procedure BtnAddProjClick(Sender: TObject); procedure btnMoveDownClick(Sender: TObject); procedure btnMoveUpClick(Sender: TObject); @@ -86,6 +95,7 @@ type procedure lstProjDblClick(Sender: TObject); private fPrevProj: ICECommonProject; + fFreeProj: ICECommonProject; fProjSubj: TCEProjectSubject; // procedure projNew(aProject: ICECommonProject); @@ -115,6 +125,7 @@ constructor TProjectGroup.create(aOwner: TComponent); begin inherited; fItems := TCollection.Create(TProjectGroupItem); + fItems.FPOAttachObserver(self); EntitiesConnector.addSingleService(self); end; @@ -135,21 +146,28 @@ begin exit(TProjectGroupItem(fItems.Items[index])); end; -procedure tProjectGroup.doChanged; +procedure TProjectGroup.FPOObservedChanged(ASender: TObject; + Operation: TFPObservedOperation; Data : Pointer); +begin + if operation = ooChange then + fModified := true; +end; + +procedure TProjectGroup.doChanged; begin if assigned(fOnChanged) then fOnChanged(self); end; -procedure TProjectGroup.setIndex(value: integer); +procedure TProjectGroup.setProjectIndex(value: integer); begin if value < 0 then value := 0 else if value > fItems.Count-1 then value := fItems.Count-1; - if fIndex <> value then + if fProjectIndex <> value then begin - fIndex := value; + fProjectIndex := value; fModified := true; end; end; @@ -168,30 +186,30 @@ begin result.fFilename := fname; end; -function TProjectGroup.projectCount: Integer; -begin - exit(fItems.Count); -end; - function TProjectGroup.getProject(ix: Integer): ICECommonProject; begin item[ix].lazyLoad; exit(item[ix].fProj); end; -function TProjectGroup.findProject(aFilename: string): ICECommonProject; +function TProjectGroup.findProject(const fname: string): ICECommonProject; var i: integer; begin result := nil; for i := 0 to projectCount-1 do - if SameFileName(item[i].fFilename, aFilename) then + if SameFileName(item[i].fFilename, fname) then begin item[i].lazyLoad; exit(item[i].fProj); end; end; +procedure TProjectGroup.selectProject(ix: Integer); +begin + setProjectIndex(ix); +end; + procedure TProjectGroup.afterLoad; begin inherited; @@ -218,21 +236,19 @@ begin TProjectGroupItem(it).fFilename := aProject.filename; TProjectGroupItem(it).fProj := aProject; aProject.inGroup(true); - fIndex := it.Index; + fProjectIndex := it.Index; doChanged; end; -//TODO-cprojectgroup: flag 'modified' not set when item deleted or pos exchanged from GUI - -procedure TProjectGroup.openGroup(aFilename: string); +procedure TProjectGroup.openGroup(const fname: string); begin - loadFromFile(aFilename); + loadFromFile(fname); doChanged; end; -procedure TProjectGroup.saveGroup(aFilename: string); +procedure TProjectGroup.saveGroup(const fname: string); begin - saveToFile(aFilename); + saveToFile(fname); end; procedure TProjectGroup.closeGroup; @@ -240,7 +256,7 @@ begin fItems.Clear; fFilename:= ''; fModified:=false; - fIndex := -1; + fProjectIndex := -1; doChanged; end; @@ -263,6 +279,11 @@ begin exit(Filename); end; +function TProjectGroup.projectCount: integer; +begin + exit(fItems.Count); +end; + function TProjectGroup.singleServiceName: string; begin exit('ICEProjectGroup'); @@ -294,6 +315,8 @@ begin AssignPng(btnMoveDown, 'arrow_down'); AssignPng(BtnAddProj, 'document_add'); AssignPng(btnRemProj, 'document_delete'); + AssignPng(btnFreeFocus, 'pencil'); + AssignPng(btnAddUnfocused, 'document_add'); projectGroup.onChanged:= @handleChanged; fProjSubj:= TCEProjectSubject.Create; end; @@ -315,6 +338,8 @@ end; procedure TCEProjectGroupWidget.projNew(aProject: ICECommonProject); begin fPrevProj := aProject; + if not aProject.inGroup then + fFreeProj := aProject; end; procedure TCEProjectGroupWidget.projChanged(aProject: ICECommonProject); @@ -325,11 +350,26 @@ end; procedure TCEProjectGroupWidget.projClosing(aProject: ICECommonProject); begin fPrevProj := nil; + if aProject = fFreeProj then + begin + fFreeProj := nil; + updateList; + end; end; procedure TCEProjectGroupWidget.projFocused(aProject: ICECommonProject); begin fPrevProj := aProject; + if not aProject.inGroup then + begin + fFreeProj := aProject; + updateList; + end + else if (aProject = fFreeProj) and (aProject.inGroup) then + begin + fFreeProj := nil; + updateList; + end; end; procedure TCEProjectGroupWidget.projCompiling(aProject: ICECommonProject); @@ -357,6 +397,21 @@ begin end; end; +procedure TCEProjectGroupWidget.btnFreeFocusClick(Sender: TObject); +begin + if fFreeProj <> nil then + subjProjFocused(fProjSubj, fFreeProj); +end; + +procedure TCEProjectGroupWidget.btnAddUnfocusedClick(Sender: TObject); +begin + if fFreeProj = nil then + exit; + projectGroup.addProject(fFreeProj); + fFreeProj := nil; + updateList; +end; + procedure TCEProjectGroupWidget.btnMoveDownClick(Sender: TObject); begin if lstProj.ItemIndex = -1 then exit; @@ -387,19 +442,17 @@ begin if lstProj.ItemIndex = -1 then exit; TProjectGroupItem(lstProj.Selected.Data).lazyLoad; - if fPrevProj <> nil then - subjProjClosing(fProjSubj, fPrevProj); subjProjFocused(fProjSubj, TProjectGroupItem(lstProj.Selected.Data).project); - if projectGroup.index <> lstProj.ItemIndex then - projectGroup.index := lstProj.ItemIndex; + if projectGroup.projectIndex <> lstProj.ItemIndex then + projectGroup.projectIndex := lstProj.ItemIndex; end; procedure TCEProjectGroupWidget.handleChanged(sender: TObject); begin updateList; - if (projectGroup.index <> -1) and (projectGroup.index <> lstProj.ItemIndex) then + if (projectGroup.projectIndex <> -1) and (projectGroup.projectIndex <> lstProj.ItemIndex) then begin - lstProj.ItemIndex := projectGroup.index; + lstProj.ItemIndex := projectGroup.projectIndex; lstProjDblClick(nil); end; end; @@ -419,12 +472,18 @@ begin p := projectGroup.item[i]; p.lazyLoad; Data:= p; - Caption := p.fFilename.extractFileName; + case p.project.getFormat of + pfNative: Caption := p.fFilename.extractFileName; + pfDub: Caption := TCEDubProject(p.project.getProject).json.Strings['name']; + end; SubItems.Add(typeStr[p.fProj.getFormat]); SubItems.Add(p.fProj.configurationName(p.fProj.getActiveConfigurationIndex)); - SubItems.Add(p.fFilename.extractFilePath); end; end; + if fFreeProj <> nil then + StaticText1.Caption:= 'Free standing: ' + shortenPath(fFreeProj.filename, 30) + else + StaticText1.Caption:= 'No free standing project'; end; {$ENDREGION}