diff --git a/.gitattributes b/.gitattributes index 0696a90a0c..07e8ad5518 100644 --- a/.gitattributes +++ b/.gitattributes @@ -28,7 +28,6 @@ designer/bookmark.lrs svneol=native#text/pascal designer/controlselection.pp svneol=native#text/pascal designer/customeditor.pp svneol=native#text/pascal designer/designer.pp svneol=native#text/pascal -designer/designerwidget.pp svneol=native#text/pascal designer/filesystem.pp svneol=native#text/pascal designer/jitforms.pp svneol=native#text/pascal designer/lazarus_control_images.lrs svneol=native#text/pascal @@ -36,7 +35,6 @@ designer/objectinspector.pp svneol=native#text/pascal designer/propedits.pp svneol=native#text/pascal designer/scalecompsdlg.pp svneol=native#text/pascal designer/sizecompsdlg.pp svneol=native#text/pascal -designer/widgetstack.pp svneol=native#text/pascal examples/bitbtnform.pp svneol=native#text/pascal examples/bitbutton.pp svneol=native#text/pascal examples/checkbox.pp svneol=native#text/pascal diff --git a/designer/designerwidget.pp b/designer/designerwidget.pp deleted file mode 100644 index c936336f2f..0000000000 --- a/designer/designerwidget.pp +++ /dev/null @@ -1,47 +0,0 @@ -{ /*************************************************************************** - designerwidget.pp - Designer Widget Stack - ------------------- - Implements a widget list created by TDesigner. - - - Initial Revision : Sat May 10 23:15:32 CST 1999 - - - ***************************************************************************/ - -/*************************************************************************** - * * - * This program is free software; you can redistribute it and/or modify * - * it under the terms of the GNU General Public License as published by * - * the Free Software Foundation; either version 2 of the License, or * - * (at your option) any later version. * - * * - ***************************************************************************/ -} -unit designerwidget; - -{$mode objfpc} - -interface - -uses - classes, controls; - -type - - TDesignerWidget = class(TObject) - private - FWidget: TControl; - public - procedure AddWidget(wcontrol: TControl); - end; - -implementation - -procedure AddWidget(wcontrol: TControl); -begin -end; - - -end. - diff --git a/designer/widgetstack.pp b/designer/widgetstack.pp deleted file mode 100644 index 16aea4fade..0000000000 --- a/designer/widgetstack.pp +++ /dev/null @@ -1,60 +0,0 @@ -{ /*************************************************************************** - widgetstack.pp - Designer Widget Stack - ------------------- - Implements a widget list created by TDesigner. - - - Initial Revision : Sat May 10 23:15:32 CST 1999 - - - ***************************************************************************/ - -/*************************************************************************** - * * - * This program is free software; you can redistribute it and/or modify * - * it under the terms of the GNU General Public License as published by * - * the Free Software Foundation; either version 2 of the License, or * - * (at your option) any later version. * - * * - ***************************************************************************/ -} -unit widgetstack; - -{$mode objfpc} - -interface - -uses - classes, designerwidget; - -type - - TWidgetStack = class(TObject) - public - procedure AddControl(widget:TDesignerWidget); - function GetControlByName(const wname: string):TDesignerWidget; - function GetControlByIndex(const windex: integer):TDesignerWidget; - function GetControlCount:integer; - end; - - implementation - - procedure AddControl(widget:TDesignerWidget); - begin - end; - - function GetControlByName(const wname: string):TDesignerWidget; - begin - end; - - function GetControlByIndex(const windex: integer):TDesignerWidget; - begin - end; - - function GetControlCount:integer; - begin - end; - - - end. - diff --git a/ide/compiler.pp b/ide/compiler.pp index 97c9a81db7..77c98e31d3 100644 --- a/ide/compiler.pp +++ b/ide/compiler.pp @@ -254,6 +254,10 @@ function TCompiler.GetSourcePosition(Line: string; var Filename:string; var CaretXY: TPoint; var MsgType: TErrorType): boolean; {This assumes the line will have the format (123,45) : + +ToDo: parse format: +(456) : in line (123) + } var StartPos, EndPos: integer; begin @@ -270,18 +274,37 @@ begin while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos); if EndPos>length(Line) then exit; CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1); - // read column - StartPos:=EndPos+1; - EndPos:=StartPos; - while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos); - if EndPos>length(Line) then exit; - CaretXY.X:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1); - // read error type - StartPos:=EndPos+2; - while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos); - if EndPos>length(Line) then exit; - MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos)); - Result:=true; + if Line[EndPos]=',' then begin + // format: (123,45) : + // read column + StartPos:=EndPos+1; + EndPos:=StartPos; + while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos); + if EndPos>length(Line) then exit; + CaretXY.X:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1); + // read error type + StartPos:=EndPos+2; + while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos); + if EndPos>length(Line) then exit; + MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos)); + Result:=true; + end else if Line[EndPos]=')' then begin + // (456) : in line (123) + // read error type + StartPos:=EndPos+2; + while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos); + if EndPos>length(Line) then exit; + MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos)); + // read second linenumber (more useful) + while (EndPos<=length(Line)) and (Line[EndPos]<>'(') do inc(EndPos); + if EndPos>length(Line) then exit; + StartPos:=EndPos+1; + EndPos:=StartPos; + while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos); + if EndPos>length(Line) then exit; + CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1); + Result:=true; + end; end; @@ -289,6 +312,9 @@ end. { $Log$ + Revision 1.12 2001/04/04 12:20:34 lazarus + MG: added add to/remove from project, small bugfixes + Revision 1.11 2001/03/31 13:35:22 lazarus MG: added non-visual-component code to IDE and LCL diff --git a/ide/ideprocs.pp b/ide/ideprocs.pp index f8e5cae73a..4c1aab5fbb 100644 --- a/ide/ideprocs.pp +++ b/ide/ideprocs.pp @@ -14,8 +14,50 @@ const // ToDo: find the constant in the fpc units. EndOfLine:shortstring={$IFDEF win32}#13+{$ENDIF}#10; - +function FilenameIsAbsolute(TheFilename: string):boolean; +function DirectoryExists(DirectoryName: string): boolean; +function ForceDirectory(DirectoryName: string): boolean; implementation +function FilenameIsAbsolute(TheFilename: string):boolean; +begin + DoDirSeparators(TheFilename); + {$IFDEF win32} + // windows + Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and + (upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\')); + {$ELSE} + Result:=(TheFilename<>'') and (TheFilename[1]='/'); + {$ENDIF} +end; + +function DirectoryExists(DirectoryName: string): boolean; +var sr: TSearchRec; +begin + if FindFirst(DirectoryName,faAnyFile,sr)=0 then + Result:=((sr.Attr and faDirectory)>0) + else + Result:=false; + FindClose(sr); +end; + +function ForceDirectory(DirectoryName: string): boolean; +var i: integer; + Dir: string; +begin + DoDirSeparators(DirectoryName); + i:=1; + while i<=length(DirectoryName) do begin + if DirectoryName[i]=OSDirSeparator then begin + Dir:=copy(DirectoryName,1,i-1); + if not DirectoryExists(Dir) then begin + Result:=CreateDir(Dir); + if not Result then exit; + end; + end; + end; + Result:=true; +end; + end. diff --git a/ide/main.pp b/ide/main.pp index 1a6eedf9ec..af6abf5f15 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -32,7 +32,7 @@ uses CodeTools, MsgView, NewProjectDlg, Process, IDEComp, AbstractFormEditor, FormEditor, CustomFormEditor, ObjectInspector, ControlSelection, PropEdits, UnitEditor, CompilerOptions, EditorOptions, EnvironmentOpts, TransferMacros, - KeyMapping, ProjectOpts; + KeyMapping, ProjectOpts, IDEProcs; const Version_String = '0.7'; @@ -86,6 +86,8 @@ type itmProjectOpen: TMenuItem; itmProjectSave: TMenuItem; itmProjectSaveAs: TMenuItem; + itmProjectAddTo: TMenuItem; + itmProjectRemoveFrom: TMenuItem; itmProjectViewSource: TMenuItem; itmProjectBuild: TMenuItem; itmProjectRun: TMenuItem; @@ -146,6 +148,8 @@ type procedure mnuOpenProjectClicked(Sender : TObject); procedure mnuSaveProjectClicked(Sender : TObject); procedure mnuSaveProjectAsClicked(Sender : TObject); + procedure mnuAddToProjectClicked(Sender : TObject); + procedure mnuRemoveFromProjectClicked(Sender : TObject); procedure mnuViewProjectSourceClicked(Sender : TObject); procedure mnuBuildProjectClicked(Sender : TObject); procedure mnuRunProjectClicked(Sender : TObject); @@ -221,6 +225,8 @@ type function DoSaveProject(SaveAs:boolean):TModalResult; function DoCloseProject:TModalResult; function DoOpenProjectFile(AFileName:string):TModalResult; + function DoAddActiveUnitToProject: TModalResult; + function DoRemoveFromProjectDialog: TModalResult; function DoBuildProject: TModalResult; function SomethingOfProjectIsModified: boolean; function DoCreateProjectForProgram(ProgramFilename @@ -290,7 +296,7 @@ var implementation uses - ViewUnit_dlg, ViewForm_dlg, Math,LResources, Designer; + ViewUnit_dlg, Math, LResources, Designer; { TMainIDE } @@ -961,6 +967,20 @@ begin mnuProject.Add(CreateSeperator); + itmProjectAddTo := TMenuItem.Create(Self); + itmProjectAddTo.Name:='itmProjectAddTo'; + itmProjectAddTo.Caption := 'Add active unit to Project'; + itmProjectAddTo.OnClick := @mnuAddToProjectClicked; + mnuProject.Add(itmProjectAddTo); + + itmProjectRemoveFrom := TMenuItem.Create(Self); + itmProjectRemoveFrom.Name:='itmProjectRemoveFrom'; + itmProjectRemoveFrom.Caption := 'Remove from Project'; + itmProjectRemoveFrom.OnClick := @mnuRemoveFromProjectClicked; + mnuProject.Add(itmProjectRemoveFrom); + + mnuProject.Add(CreateSeperator); + itmProjectViewSource := TMenuItem.Create(Self); itmProjectViewSource.Name:='itmProjectViewSource'; itmProjectViewSource.Caption := 'View Source'; @@ -1440,6 +1460,16 @@ begin DoSaveProject(true); end; +procedure TMainIDE.mnuAddToProjectClicked(Sender : TObject); +begin + DoAddActiveUnitToProject; +end; + +procedure TMainIDE.mnuRemoveFromProjectClicked(Sender : TObject); +begin + DoRemoveFromProjectDialog; +end; + procedure TMainIDE.mnuViewProjectSourceClicked(Sender : TObject); begin DoOpenMainUnit(false); @@ -2178,7 +2208,7 @@ end; function TMainIDE.DoViewUnitsAndForms(OnlyForms: boolean): TModalResult; var UnitList: TList; i, ProgramNameStart, ProgramNameEnd:integer; - MainUnitName, Ext: string; + MainUnitName, Ext, DlgCaption: string; MainUnitInfo, AnUnitInfo: TUnitInfo; MainUnitIndex: integer; Begin @@ -2223,7 +2253,11 @@ Begin end; end; end; - if ShowViewUnitsDlg(UnitList,true)=mrOk then begin + if OnlyForms then + DlgCaption:='View forms' + else + DlgCaption:='View units'; + if ShowViewUnitsDlg(UnitList,true,DlgCaption)=mrOk then begin for i:=0 to UnitList.Count-1 do begin if TViewUnitsEntry(UnitList[i]).Selected then begin AnUnitInfo:=Project.Units[TViewUnitsEntry(UnitList[i]).ID]; @@ -2617,6 +2651,102 @@ writeln('[TMainIDE.DoCreateProjectForProgram] END'); Result:=mrOk; end; +function TMainIDE.DoAddActiveUnitToProject: TModalResult; +var + ActiveSourceEditor:TSourceEditor; + ActiveUnitInfo:TUnitInfo; + s, ShortUnitName: string; + UnitNameStart, UnitNameEnd: integer; +begin + Result:=mrCancel; + GetCurrentUnit(ActiveSourceEditor,ActiveUnitInfo); + if ActiveUnitInfo<>nil then begin + if ActiveUnitInfo.IsPartOfProject=false then begin + if ActiveUnitInfo.Filename<>'' then + s:='"'+ActiveUnitInfo.Filename+'"' + else + s:='"'+SourceNotebook.Notebook.Pages[SourceNotebook.Notebook.PageIndex] + +'"'; + if (Project.ProjectType in [ptProgram, ptApplication]) + and (ActiveUnitInfo.UnitName<>'') + and (Project.IndexOfUnitWithName(ActiveUnitInfo.UnitName,true)>=0) then begin + MessageDlg('Unable to add '+s+' to project, because there is already a ' + +'unit with the same name in the project.',mtInformation,[mbOk],0); + end else begin + if MessageDlg('Add '+s+' to project?',mtConfirmation,[mbOk,mbCancel],0) + =mrOk then + begin + ActiveUnitInfo.IsPartOfProject:=true; + if (ActiveUnitInfo.UnitName<>'') + and (Project.ProjectType in [ptProgram, ptApplication]) then begin + ShortUnitName:=FindUnitNameInSource(ActiveUnitInfo.Source.Source, + UnitNameStart,UnitNameEnd); + if ShortUnitName='' then ShortUnitName:=ActiveUnitInfo.UnitName; + if (ShortUnitName<>'') then + AddToProgramUsesSection(Project.Units[Project.MainUnit].Source + ,ShortUnitName,''); + end; + Project.Modified:=true; + end; + end; + end else begin + if ActiveUnitInfo.Filename<>'' then + s:='The file "'+ActiveUnitInfo.Filename+'"' + else + s:='The file "' + +SourceNotebook.Notebook.Pages[SourceNotebook.Notebook.PageIndex] + +'"'; + s:=s+' is already part of the project.'; + MessageDlg(s,mtInformation,[mbOk],0); + end; + end else begin + Result:=mrOk; + end; +end; + +function TMainIDE.DoRemoveFromProjectDialog: TModalResult; +var UnitList: TList; + i:integer; + AName: string; + AnUnitInfo: TUnitInfo; +Begin + UnitList:=TList.Create; + try + for i:=0 to Project.UnitCount-1 do begin + AnUnitInfo:=Project.Units[i]; + if (AnUnitInfo.IsPartOfProject) and (i<>Project.MainUnit) then begin + AName:=AnUnitInfo.FileName; + if (AName='') and (AnUnitInfo.Loaded) then begin + AName:=SourceNotebook.NoteBook.Pages[AnUnitInfo.EditorIndex]; + end; + if AName<>'' then + UnitList.Add(TViewUnitsEntry.Create(AName,i,false)); + end; + end; + if ShowViewUnitsDlg(UnitList,true,'Remove from project')=mrOk then begin + for i:=0 to UnitList.Count-1 do begin + if TViewUnitsEntry(UnitList[i]).Selected then begin + AnUnitInfo:=Project.Units[TViewUnitsEntry(UnitList[i]).ID]; + AnUnitInfo.IsPartOfProject:=false; + if (Project.MainUnit>=0) + and (Project.ProjectType in [ptProgram, ptApplication]) then begin + if (AnUnitInfo.UnitName<>'') then + RemoveFromProgramUsesSection( + Project.Units[Project.MainUnit].Source,AnUnitInfo.UnitName); + if (AnUnitInfo.FormName<>'') then + Project.RemoveCreateFormFromProjectFile( + 'T'+AnUnitInfo.FormName,AnUnitInfo.FormName); + UpdateMainUnitSrcEdit; + end; + end; + end; + end; + finally + UnitList.Free; + end; + Result:=mrOk; +end; + function TMainIDE.DoBuildProject: TModalResult; var ActiveSrcEdit: TSourceEditor; begin @@ -3015,20 +3145,6 @@ end; function TMainIDE.DoJumpToCompilerMessage(Index:integer; FocusEditor: boolean): boolean; - - function FilenameIsAbsolute(TheFilename: string):boolean; - begin - DoDirSeparators(TheFilename); - {$IFDEF linux} - Result:=(TheFilename<>'') and (TheFilename[1]='/'); - {$ELSE} - // windows - Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and - (upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\')); - {$ENDIF} - end; - -// TMainIDE.DoJumpToCompilerMessage var MaxMessages: integer; Filename, Ext: string; CaretXY: TPoint; @@ -3257,8 +3373,8 @@ end. { ============================================================================= $Log$ - Revision 1.87 2001/04/03 12:14:43 lazarus - MG: added project options + Revision 1.88 2001/04/04 12:20:34 lazarus + MG: added add to/remove from project, small bugfixes Revision 1.86 2001/03/31 13:35:22 lazarus MG: added non-visual-component code to IDE and LCL diff --git a/ide/project.pp b/ide/project.pp index e3110e4710..f071bc89bc 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -20,7 +20,6 @@ ***************************************************************************/ } - unit project; {$mode objfpc}{$H+} @@ -33,7 +32,7 @@ interface uses Classes, SysUtils, LCLLinux, XMLCfg, LazConf, CompilerOptions, FileCtrl, - CodeTools, Forms, Controls, EditorOptions, Dialogs; + CodeTools, Forms, Controls, EditorOptions, Dialogs, IDEProcs; type //--------------------------------------------------------------------------- @@ -1331,20 +1330,6 @@ begin end; procedure TProject.OnLoadSaveFilename(var AFilename:string; Load:boolean); - - function FilenameIsAbsolute(TheFilename: string):boolean; - begin - DoDirSeparators(TheFilename); - {$IFDEF linux} - Result:=(TheFilename='') or (TheFilename[1]='/'); - {$ELSE} - // windows - Result:=(length(TheFilename)<3) or (copy(TheFilename,1,2)='\\') - or ((upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\')); - {$ENDIF} - end; - -// OnLoadSaveFilename var ProjectPath:string; begin ProjectPath:=ExtractFilePath(ProjectFile); @@ -1397,6 +1382,9 @@ end. { $Log$ + Revision 1.19 2001/04/04 12:20:34 lazarus + MG: added add to/remove from project, small bugfixes + Revision 1.18 2001/03/29 12:38:59 lazarus MG: new environment opts, ptApplication bugfixes diff --git a/ide/viewunit_dlg.pp b/ide/viewunit_dlg.pp index 7af7106927..c0661251fe 100644 --- a/ide/viewunit_dlg.pp +++ b/ide/viewunit_dlg.pp @@ -49,7 +49,8 @@ type end; -function ShowViewUnitsDlg(Entries: TList; MultiSelect: boolean): TModalResult; +function ShowViewUnitsDlg(Entries: TList; MultiSelect: boolean; + Caption: string): TModalResult; // Entries is a list of TViewUnitsEntry(s) @@ -57,12 +58,13 @@ implementation function ShowViewUnitsDlg(Entries: TList; - MultiSelect: boolean): TModalResult; + MultiSelect: boolean; Caption: string): TModalResult; var ViewUnits: TViewUnits; i: integer; begin ViewUnits:=TViewUnits.Create(Application); try + ViewUnits.Caption:=Caption; ViewUnits.ListBox.Visible:=false; ViewUnits.ListBox.MultiSelect:=MultiSelect; with ViewUnits.ListBox.Items do begin @@ -169,6 +171,9 @@ initialization end. { $Log$ + Revision 1.8 2001/04/04 12:20:34 lazarus + MG: added add to/remove from project, small bugfixes + Revision 1.7 2001/03/08 15:59:06 lazarus IDE bugfixes and viewunit/forms functionality