diff --git a/src/ce_dcd.pas b/src/ce_dcd.pas index 76ebbeda..c9586295 100644 --- a/src/ce_dcd.pas +++ b/src/ce_dcd.pas @@ -10,7 +10,7 @@ uses windows, {$ENDIF} ce_common, ce_writableComponent, ce_interfaces, ce_observer, ce_synmemo, - ce_stringrange; + ce_stringrange, ce_projutils; type @@ -202,6 +202,9 @@ begin // folds := TStringList.Create; try + fold := ce_projutils.projectSourcePath(project); + if fold.dirExists and (folds.IndexOf(fold) = -1) then + folds.Add(fold); for i:= 0 to fProj.sourcesCount-1 do begin fold := fProj.sourceAbsolute(i).extractFilePath; diff --git a/src/ce_libmaneditor.pas b/src/ce_libmaneditor.pas index d91924b2..4bf78dcb 100644 --- a/src/ce_libmaneditor.pas +++ b/src/ce_libmaneditor.pas @@ -9,8 +9,8 @@ uses Menus, ComCtrls, Buttons, LazFileUtils, fphttpclient, StdCtrls, fpjson, jsonparser, ce_widget, ce_interfaces, ce_ceproject, ce_dmdwrap, ce_common, ce_dialogs, - ce_sharedres, process, ce_dubproject, ce_observer, ce_dlang, ce_libman, - ce_projutils, ce_dsgncontrols, ce_stringrange; + ce_sharedres, process, ce_dubproject, ce_observer, ce_libman, + ce_projutils, ce_dsgncontrols; type @@ -63,12 +63,10 @@ type procedure btnMoveUpClick(Sender: TObject); procedure btnMoveDownClick(Sender: TObject); procedure ListEdited(Sender: TObject; Item: TListItem; var value: string); - procedure ListSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean - ); + procedure ListSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); private fProj: ICECommonProject; fFreeProj: ICECommonProject; - fModStart: boolean; procedure updateButtonsState; procedure projNew(project: ICECommonProject); procedure projChanged(project: ICECommonProject); @@ -78,8 +76,6 @@ type procedure projCompiled(project: ICECommonProject; success: boolean); function itemForRow(row: TListItem): TLibraryItem; procedure RowToLibrary(row: TListItem; added: boolean = false); - function sourceRoot(project: ICECommonProject): string; - procedure lexFindToken(const token: PLexToken; out stop: boolean); // procedure dataToGrid; protected @@ -528,7 +524,7 @@ begin row.Data := LibMan.libraries.Add; row.Caption:= nme; row.SubItems.Clear; - nme := sourceRoot(prj as ICECommonProject); + nme := projectSourcePath(prj as ICECommonProject); row.SubItems.Add(nme); row.SubItems.Add(nme); row.SubItems.Add(prj.filename); @@ -562,7 +558,7 @@ begin row.Caption := nme; row.SubItems.Clear; row.SubItems.Add(prj.outputFilename); - row.SubItems.Add(sourceRoot(prj as ICECommonProject)); + row.SubItems.Add(projectSourcePath(prj as ICECommonProject)); row.SubItems.Add(prj.filename); row.SubItems.Add(enableStr[true]); row.Selected:=true; @@ -668,7 +664,7 @@ begin // str := TStringList.Create; try - root := sourceRoot(fProj); + root := projectSourcePath(fProj); if root.isEmpty then begin dlgOkInfo('the static library can not be registered because its source files have no common folder'); @@ -867,114 +863,4 @@ begin Libman.updateAfterAddition(itm); end; -function TCELibManEditorWidget.sourceRoot(project: ICECommonProject): string; -var - i, j: integer; - mnme: string; - path: string; - base: string; - fldn: array of string; - lst: TStringList; - srcc: TStringList; - toks: TLexTokenList; - rng: TStringRange = (ptr: nil; pos: 0; len: 0); - sym: boolean; -begin - - // 1 source, same folder - if project.sourcesCount = 1 then - begin - base := project.basePath; - path := project.sourceAbsolute(0); - if path.extractFilePath = base then - exit(base); - end; - - lst := TStringList.Create; - srcc := TStringList.Create; - toks := TLexTokenList.Create; - try - // get module name and store the parent.parent.parent... dir - for i := 0 to project.sourcesCount-1 do - begin - sym := true; - path := project.sourceAbsolute(i); - if not hasDlangSyntax(path.extractFileExt) then - continue; - fModStart := false; - srcc.LoadFromFile(path); - lex(srcc.Text, toks, @lexFindToken, [lxoNoComments]); - mnme := getModuleName(toks); - if path.extractFileName.stripFileExt = 'package' then - mnme := mnme + '.p'; - toks.Clear; - setLength(fldn, 0); - rng.init(mnme); - while true do - begin - setLength(fldn, length(fldn) + 1); - fldn[high(fldn)] := rng.takeUntil(['.', #0]).yield; - if rng.empty then - break - else - rng.popFront; - end; - for j:= high(fldn)-1 downto 0 do - begin - path := path.extractFileDir; - if path.extractFileName <> fldn[j] then - begin - sym := false; - break; - end - end; - if sym then - begin - path := path.extractFileDir; - lst.Add(path); - end; - end; - deleteDups(lst); - if project.sourcesCount = 0 then - result := '' - else - begin - result := lst[0]; - if FilenameIsAbsolute(result) then - result := expandFilenameEx(GetCurrentDir, result); - end; - if ((project.sourcesCount > 1) and (lst.Count > 1)) - or (not sym) then - begin - lst.Clear; - for j := 0 to project.sourcesCount-1 do - begin - path := project.sourceAbsolute(j); - if hasDlangSyntax(path.extractFileExt) then - lst.Add(path); - end; - result := commonFolder(lst); - result := result.extractFileDir; - end; - finally - srcc.Free; - lst.Free; - toks.Free; - end; -end; - -procedure TCELibManEditorWidget.lexFindToken(const token: PLexToken; out stop: boolean); -begin - if (token^.kind = ltkKeyword) and (token^.data = 'module') then - begin - fModStart := true; - exit; - end; - if fModStart and (token^.kind = ltkSymbol) and (token^.data = ';') then - begin - stop := true; - fModStart := false; - end; -end; - end. diff --git a/src/ce_projutils.pas b/src/ce_projutils.pas index 0a6c1d03..d2c472d7 100644 --- a/src/ce_projutils.pas +++ b/src/ce_projutils.pas @@ -4,12 +4,20 @@ unit ce_projutils; interface uses - Classes, SysUtils, - ce_ceproject, ce_dubproject, ce_interfaces, ce_common, ce_observer, ce_synmemo; + Classes, SysUtils, fpjson, LazFileUtils, + ce_interfaces, ce_common, ce_observer, ce_synmemo, + ce_dlang, ce_stringrange; type TCEProjectFileFormat = (pffNone, pffCe, pffDub); + TLexNameCallback = class + private + fModStart: boolean; + public + procedure lexFindToken(const token: PLexToken; out stop: boolean); + end; + (** * Loads either a DUB or a CE project. If the filename is invalid or if it * doesn't points to a valid project, nil is returned, otherwise a project. @@ -33,8 +41,19 @@ function projectFormat(const filename: string): TCEProjectFileFormat; *) procedure saveModifiedProjectFiles(project: ICECommonProject); +(** + * Returns the root of the project sources. + *) +function projectSourcePath(project: ICECommonProject): string; + implementation +uses + ce_ceproject, ce_dubproject; + +var + clbck: TLexNameCallback; + function isProject(const filename: string): boolean; var ext: string; @@ -113,5 +132,134 @@ begin end; end; +procedure TLexNameCallback.lexFindToken(const token: PLexToken; out stop: boolean); +begin + if (token^.kind = ltkKeyword) and (token^.data = 'module') then + begin + fModStart := true; + exit; + end; + if fModStart and (token^.kind = ltkSymbol) and (token^.data = ';') then + begin + stop := true; + fModStart := false; + end; +end; + +function projectSourcePath(project: ICECommonProject): string; +var + i, j: integer; + mnme: string; + path: string; + base: string; + fldn: array of string; + lst: TStringList; + srcc: TStringList; + toks: TLexTokenList; + pdb: TCEDubProject; + jsn: TJSONArray; + rng: TStringRange = (ptr: nil; pos: 0; len: 0); + sym: boolean; +begin + + result := ''; + + if clbck.isNil then + clbck := TLexNameCallback.Create; + + // 1 source, same folder + if project.sourcesCount = 1 then + begin + base := project.basePath; + path := project.sourceAbsolute(0); + if path.extractFilePath = base then + exit(base); + end; + + // DUB sourcePath + if project.getFormat = pfDUB then + begin + pdb := TCEDubProject(project.getProject); + if pdb.json.findArray('sourcePath', jsn) and (jsn.Count = 1) then + exit(project.filename.extractFilePath + jsn.Strings[0]); + end; + + lst := TStringList.Create; + srcc := TStringList.Create; + toks := TLexTokenList.Create; + try + // get module name and store the parent.parent.parent... dir + for i := 0 to project.sourcesCount-1 do + begin + sym := true; + path := project.sourceAbsolute(i); + if not hasDlangSyntax(path.extractFileExt) then + continue; + clbck.fModStart := false; + srcc.LoadFromFile(path); + lex(srcc.Text, toks, @clbck.lexFindToken, [lxoNoComments]); + mnme := getModuleName(toks); + if path.extractFileName.stripFileExt = 'package' then + mnme := mnme + '.p'; + toks.Clear; + setLength(fldn, 0); + rng.init(mnme); + while true do + begin + setLength(fldn, length(fldn) + 1); + fldn[high(fldn)] := rng.takeUntil(['.', #0]).yield; + if rng.empty then + break + else + rng.popFront; + end; + for j:= high(fldn)-1 downto 0 do + begin + path := path.extractFileDir; + if path.extractFileName <> fldn[j] then + begin + sym := false; + break; + end + end; + if sym then + begin + path := path.extractFileDir; + lst.Add(path); + end; + end; + deleteDups(lst); + if project.sourcesCount = 0 then + result := '' + else + begin + result := lst[0]; + if FilenameIsAbsolute(result) then + result := expandFilenameEx(GetCurrentDir, result); + end; + // Use common directory + if ((project.sourcesCount > 1) and (lst.Count > 1)) + or (not sym) then + begin + lst.Clear; + for j := 0 to project.sourcesCount-1 do + begin + path := project.sourceAbsolute(j); + if hasDlangSyntax(path.extractFileExt) then + lst.Add(path); + end; + result := commonFolder(lst); + result := result.extractFileDir; + end; + finally + srcc.Free; + lst.Free; + toks.Free; + end; +end; + + +finalization + clbck.Free; end.