[Gambas-devel] Re: [Gambas-user] Re: BIG BUG in gb 1.9.19
José L. Redrejo Rodríguez
jredrejo at ...96...
Fri Sep 2 16:31:03 CEST 2005
After checking all the "Scan" appearances in the IDE, these are the four
files that have to be replaced in the gambas2 dir, instead of those
contained in the 1.9.19 sources tree.
I haven't found any bug else with these modifications.
Regards.
El vie, 02-09-2005 a las 13:53 +0000, jredrejo at ...96... escribió:
> The attached file has to be replaced too. It fixes a bug when clicking the btnGoto in the IDE.
> Benoît has used the Scan variable in a good part of the IDE and now it has a lot of conflicts with the new scan instruction.
>
> Danielcampos at ...282... wrote :
>
> > Hi all:
> >
> > I recommend to not use Gambas-1.9.19, the IDE is absolutely broken, even using
> > Fabien's patch. Keep Gambas-1.9.18 in safe place!
> >
> > I think it is moment to stop that run to nowhere at full speed, and leave time
> > to fix all that is done in developement version. It is full of bugs, and each
> > time it is more difficult to collaborate in the project with that continous
> > changes without having any tool like cvs or subversion. No way to continue
> > improving things in that way, I can not guess every time what will be the next
> > change that will break all! :-((
> >
> >
> > Regards,
> >
> > Daniel Campos
> >
> > -------------------------------------------------------------
> > NetCourrier, votre bureau virtuel sur Internet : Mail, Agenda, Clubs,
> > Toolbar...
> > Web/Wap : www.netcourrier.com
> > Téléphone/Fax : 08 92 69 00 21 (0,34 € TTC/min)
> > Minitel: 3615 NETCOURRIER (0,16 € TTC/min)
> >
> >
> >
> > -------------------------------------------------------
> > SF.Net email is Sponsored by the Better Software Conference & EXPO
> > September 19-22, 2005 * San Francisco, CA * Development Lifecycle Practices
> > Agile & Plan-Driven Development * Managing Projects & Teams * Testing
> > & QA
> > Security * Process Improvement & Measurement * http://www.sqe.com/bsce5sf
> > _______________________________________________
> > Gambas-devel mailing list
> > Gambas-devel at lists.sourceforge.net
> > https://lists.sourceforge.net/lists/listinfo/gambas-devel
>
> ____________________________________________
> Servicio WebMail de CiberUNED http://www.uned.es
-------------- next part --------------
A non-text attachment was scrubbed...
Name: FForm.class
Type: application/x-java
Size: 33719 bytes
Desc: not available
URL: <http://lists.gambas-basic.org/pipermail/user/attachments/20050902/b5421c71/attachment.bin>
-------------- next part --------------
' Gambas module file
PUBLIC ProjectTree AS TreeView
PUBLIC ProjectMessage AS Label
PUBLIC ActiveForm AS Object
PUBLIC Path AS String
PUBLIC Name AS String
PUBLIC Dir AS String
PUBLIC ReadOnly AS Boolean
PUBLIC Title AS String
PUBLIC Startup AS String
PUBLIC Libraries AS String[]
PUBLIC Arguments AS String
PUBLIC KeepDebugInfo AS Boolean
PUBLIC ControlPublic AS Boolean
PUBLIC MajorVersion AS Integer
PUBLIC MinorVersion AS Integer
PUBLIC ReleaseVersion AS Integer
PUBLIC SnapToGrid AS Boolean
PUBLIC ShowGrid AS Boolean
PUBLIC Snap AS Integer
PUBLIC Localize AS Boolean
PUBLIC ComponentFromType AS Collection
PUBLIC Description AS String
PUBLIC Icon AS String
PUBLIC Systems AS String[]
PUBLIC Menus AS Collection
PUBLIC Groups AS Collection
PUBLIC Prefix AS Boolean
PUBLIC TabSize AS Integer
PUBLIC Version AS String
PUBLIC ExecPath AS String
PUBLIC TileGrid AS Picture
PUBLIC Running AS Boolean
PUBLIC Recent AS NEW String[]
PRIVATE CONST MAX_RECENT AS Integer = 24
PUBLIC CONST FORM_MAGIC AS String = "# Gambas Form File 1.0"
PUBLIC CONST PROJECT_MAGIC AS String = "# Gambas Project File 1.0"
PUBLIC CONST DEFAULT_FONT AS String = "Monospace,10"
PUBLIC Files AS NEW Collection
PUBLIC AboutToQuit AS Boolean
PUBLIC Positions AS NEW String[]
PUBLIC CONST MAX_ICON_SIZE AS Integer = 2048
PUBLIC EXAMPLES_DIR AS String
PUBLIC RPMBUILD_PROG AS String
PRIVATE CONST IMAGE_DIR AS String = "img/16"
PRIVATE CONST KEY_MODULE AS String = "$M"
PRIVATE CONST KEY_CLASS AS String = "$C"
PUBLIC CONST KEY_FORM AS String = "$F"
PUBLIC CONST KEY_MISC AS String = "$O"
PRIVATE CONST CLASS_AUTH_CAR AS String = "abcdefghijklmnopqrstuvwxyz0123456789"
PRIVATE CONST FILE_AUTH_CAR AS String = "abcdefghijklmnopqrstuvwxyz0123456789-.+_"
PRIVATE CONST PROJECT_FILE AS String = ".project"
PRIVATE $bGetSource AS Boolean
PRIVATE $bDisplayForm AS Boolean
PRIVATE TMP_FILE AS String '= "/tmp/.gambas.ver"
PRIVATE OUTPUT_FILE AS String '= "/tmp/.gambas.out"
PRIVATE $sBrowser AS String
PUBLIC SUB Main()
DIM sPath AS String
DIM hGambas AS FGambas
TMP_FILE = Temp$()
OUTPUT_FILE = Temp$()
'CLASSES_FILE = Temp$()
EXAMPLES_DIR = System.Path &/ "share/gambas" & System.Version & "/examples"
'Config = NEW Config '(User.Home &/ ".gambas")
Application.Tooltip.Enabled = Settings["/ShowTooltip", TRUE]
'Application.Font = Font["10"]
InitVersion
LoadRecent
FMain.Load
FGambas.Load
'FOutput.Load(Workspace)
'FDebug.Load(Workspace)
'FIconTool.Load(Workspace)
'FFormStack.Load(Workspace)
'FExplorer.Load(Workspace)
IF Application.Args.Count >= 2 THEN
sPath = Application.Args[1]
ENDIF
DO
IF Not sPath THEN sPath = FWelcome.Run()
'sPath = User.Home &/ "gambas/test/gambas"
IF sPath THEN
Project.Open(sPath)
ELSE
FMain.Close
RETURN
ENDIF
IF Project.Name THEN BREAK
sPath = ""
LOOP
INC Application.Busy
FProperty.Show
FToolBox.Show
'FFormStack.Load
IF Settings["/ShowMascot", TRUE] THEN
FGambas.Show
ENDIF
FMain.UpdateRecentMenu
FMain.Show
DEC Application.Busy
IF Settings["/ShowTipOnStartup", TRUE] THEN
FTips.Run
ENDIF
END
PRIVATE SUB InitVersion()
DIM sVer AS String
Version = "?"
'SHELL "gbx" & System.Version & " -V > " & TMP_FILE 'WAIT
'sVer = File.Load(TMP_FILE)
'KILL TMP_FILE
SHELL "gbx" & System.Version & " -V" TO sVer
Version = Trim(Mid$(sVer, InStr(sVer, "-") + 1))
END
PUBLIC FUNCTION Open(sDir AS String) AS Boolean
DIM sOldPath AS String
DIM sOldName AS String
sOldPath = Project.Path
sOldName = Project.Name
IF CloseProject() THEN RETURN TRUE
IF Exist(sDir &/ ".lock") THEN
IF Message.Warning(("BE CAREFUL! This project seems to be already opened.\n\nOpening the same project twice can crash the IDE\nand lead to data loss."), ("Open after all"), ("Do not open")) = 2 THEN
RETURN TRUE
ENDIF
TRY KILL sDir &/ ".lock"
ENDIF
ReadOnly = NOT Access(sDir, gb.write)
Path = sDir &/ PROJECT_FILE
Name = File.Name(sDir)
Project.Dir = sDir
ReadProject
Refresh
AddRecent(sDir)
FMain.OnProjectChange
FFind.OnProjectChange
'FExplorer.ProjectChange
FDebug.Clear
TRY File.Save(sDir &/ ".lock", "")
IF ReadOnly THEN Message.Warning(("This project is read-only."))
SetMessage(("OK"))
RETURN
CATCH
IF Error.Text THEN
Message.Error(("Cannot open project file :\n") & sDir & "\n\n" & Error.Text & "\n" & Error.Where)
ENDIF
Path = sOldPath
Project.Dir = File.Dir(Path)
Name = sOldName
IF Path THEN ReadProject
RETURN TRUE
END
PUBLIC SUB CloseAll()
DIM hForm AS Object
FOR EACH hForm IN Files
hForm.Close
NEXT
END
PRIVATE FUNCTION CloseProject() AS Boolean
DIM hForm AS Object
DIM bModif AS Boolean
'IF Len(Path) = 0 THEN RETURN
IF Running THEN
FDebug.Stop
'WAIT 0.5
ENDIF
FOR EACH hForm IN Files
IF hForm.IsModified() THEN
bModif = TRUE
BREAK
ENDIF
NEXT
IF bModif THEN
IF FSave.Run(AboutToQuit) THEN RETURN TRUE
ENDIF
FFind.Close
INC Application.Busy
FOR EACH hForm IN Files
hForm.Delete
NEXT
Files.Clear
ActiveForm = NULL
DEC Application.Busy
IF NOT AboutToQuit THEN FProperty.HideAll
TRY KILL Project.Dir &/ ".lock"
RETURN FALSE
END
PUBLIC FUNCTION Close() AS Boolean
DIM hForm AS Form
DIM iInd AS Integer
DIM sLig AS String
AboutToQuit = TRUE
IF CloseProject() THEN
AboutToQuit = FALSE
RETURN TRUE
ENDIF
'FDebug.Close
'FOR EACH hForm IN Windows
' TRY hForm.Close
'NEXT
'FOR EACH hForm IN Windows
' TRY hForm.Delete
'NEXT
' FToolBox.Delete
' FExplorer.Delete
' FFind.Delete
' FGambas.Delete
' FIconTool.Delete
' FDebug.Delete
' FProperty.Delete
CComponent.Exit
END
PRIVATE PROCEDURE AddDir(cDir AS String[])
DIM sDir AS String
DIM sFile AS String
DIM sIcon AS String
DIM sPath AS String
DIM sKey AS String
DIM bShow AS Boolean
DIM sExt AS String
DIM sParent AS String
DIM hPict AS Picture
DIM aFile AS NEW String[]
DIM bAllowForm AS Boolean
bAllowForm = AllowForm()
sDir = cDir[0]
FOR EACH sFile IN Dir(sDir, "*")
IF IsDir(sDir &/ sFile) THEN aFile.Add("D" & sFile)
NEXT
FOR EACH sFile IN Dir(sDir, "*")
IF NOT IsDir(sDir &/ sFile) THEN aFile.Add("F" & sFile)
NEXT
aFile.Sort
FOR EACH sFile IN aFile
sFile = Mid$(sFile, 2)
sPath = sDir &/ sFile
sKey = sPath
sParent = sDir
WITH Stat(sPath)
IF .Hidden THEN CONTINUE
bShow = FALSE
IF .Type = gb.Directory THEN
cDir.Add(sPath)
sIcon = IMAGE_DIR &/ "close.png"
IF sDir = Project.Dir THEN
sParent = KEY_MISC
ENDIF
bShow = TRUE
ELSE
'IF InStr(.Perm.User & .Perm.Group & .Perm.Other, "x") THEN CONTINUE
sExt = Lower(File.Ext(sFile))
IF sDir = Project.Dir THEN
sParent = KEY_MISC
ENDIF
SELECT CASE sExt
CASE "form", "class", "module"
IF sParent = KEY_MISC THEN
sIcon = IMAGE_DIR &/ sExt & ".png"
bShow = TRUE
IF sExt = "form" THEN
sParent = KEY_FORM
IF NOT bAllowForm THEN sIcon = ""
ELSE IF sExt = "class" THEN
sParent = KEY_CLASS
IF $bDisplayForm THEN
IF NOT bAllowForm THEN
IF Exist(sDir &/ File.BaseName(sFile) & ".form") THEN
sIcon = ""
ENDIF
ENDIF
ELSE
IF Exist(sDir &/ File.BaseName(sFile) & ".form") THEN
sIcon = ""
ENDIF
ENDIF
ELSE IF sExt = "module" THEN
sParent = KEY_MODULE
ENDIF
sFile = File.BaseName(sFile)
ELSE
sIcon = IMAGE_DIR &/ "unknown.png"
ENDIF
CASE "jpg", "jpeg", "xpm", "bmp", "png", "gif"
IF .Size > MAX_ICON_SIZE THEN
sIcon = IMAGE_DIR &/ "image.png"
ELSE
sIcon = sPath
ENDIF
CASE "svg"
sIcon = IMAGE_DIR &/ "image.png"
CASE "pot"
IF sParent = KEY_MISC THEN
sIcon = ""
ENDIF
CASE "gambas"
CONTINUE
CASE ELSE
sIcon = ""
IF Right$(sFile, 1) <> "~" THEN
IF sFile <> Project.Name OR sParent <> KEY_MISC THEN
sIcon = IMAGE_DIR &/ "unknown.png"
ENDIF
ENDIF
END SELECT
ENDIF
IF Len(sIcon) THEN
IF Left$(sIcon) = "/" THEN
hPict = NEW Picture
TRY hPict.Load(sIcon)
ELSE
hPict = Picture[sIcon]
ENDIF
WITH ProjectTree.Add(sKey, sFile, hPict, sParent)
IF bShow THEN
ProjectTree[sKey].MoveParent
ProjectTree.Item.Expanded = TRUE
ENDIF
END WITH
ENDIF
END WITH
NEXT
END
PRIVATE SUB SelectKey(sKey AS String)
IF NOT ProjectTree.Exist(sKey) THEN
IF Right$(sKey, 6) = ".class" THEN
sKey = Left$(sKey, -6) & ".form"
ENDIF
ENDIF
TRY ProjectTree[sKey].Selected = TRUE
TRY ProjectTree[sKey].EnsureVisible
END
PUBLIC PROCEDURE Refresh(OPTIONAL bReset AS Boolean)
DIM sFile AS String
DIM cDir AS NEW String[]
DIM sDir AS String
DIM sKey AS String
DIM sKeyReset AS String
$bDisplayForm = Settings["/DisplayForm"]
IF NOT bReset THEN
sKeyReset = ProjectTree.Key
ENDIF
WITH ProjectTree
.Clear()
sKey = Project.Dir
.Add(sKey, Name, Picture["img/16/gambas.png"]).Expanded = TRUE
cDir.Add(Project.Dir)
.Add(KEY_CLASS, ("Classes"), Picture["img/16/close.png"], sKey)
IF AllowForm() THEN
.Add(KEY_FORM, ("Forms"), Picture["img/16/close.png"], sKey)
ENDIF
.Add(KEY_MODULE, ("Modules"), Picture["img/16/close.png"], sKey)
.Add(KEY_MISC, ("Data"), Picture["img/16/close.png"], sKey)
'$bGetSource = TRUE
REPEAT
AddDir(cDir)
cDir.Remove(0)
$bGetSource = FALSE
UNTIL cDir.Count = 0
'.Sort()
END WITH
IF sKeyReset THEN sKey = sKeyReset
TRY ProjectTree[sKey].EnsureVisible
DefineStartup(Startup, TRUE)
WITH ProjectTree
.MoveFirst
WHILE .Available
.Current.Expanded = .Current.Children > 0
.MoveNext
WEND
END WITH
'STOP
FMain.Title = ("Project") & " - " & Name & If(ReadOnly, " [" & ("Read only") & "]", "")
END
PUBLIC FUNCTION IsEditor(hFile AS Object) AS Boolean
RETURN Object.Type(hFile) = "FEditor"
END
PUBLIC FUNCTION IsForm(hFile AS Object) AS Boolean
IF hFile THEN RETURN Object.Type(hFile) = "FForm"
END
PUBLIC FUNCTION LoadFile(sPath AS String) AS Object
DIM hForm AS Object
'DIM hActive AS Object
INC Application.Busy
hForm = Files[sPath]
IF Not hForm THEN
'PRINT "Load: "; sPath
'hActive = ActiveForm
SELECT CASE Lower(File.Ext(sPath))
CASE "module", "class"
hForm = NEW FEditor(sPath)
CASE "form"
IF AllowForm() THEN hForm = NEW FForm(sPath)
CASE "png", "gif", "jpg", "jpeg", "bmp", "xpm"
hForm = NEW FIconEditor(sPath)
CASE ELSE
hForm = NEW FTextEditor(sPath)
END SELECT
Files[sPath] = hForm
ENDIF
DEC Application.Busy
RETURN hForm
CATCH
DEC Application.Busy
Message.Error(("Cannot open file.") & "\n\n" & Error.Text & "\n" & Error.Where)
END
PUBLIC FUNCTION FindPath(sClass AS String) AS String
DIM sPath AS String
DIM aDir AS String[]
DIM iInd AS Integer
aDir = Dir(Project.Dir)
iInd = aDir.Find(sClass & ".class", gb.Text)
IF iInd >= 0 THEN RETURN Project.Dir &/ aDir[iInd]
iInd = aDir.Find(sClass & ".module", gb.Text)
IF iInd >= 0 THEN RETURN Project.Dir &/ aDir[iInd]
'PRINT "FindPath: "; sClass; " ?"
END
PUBLIC SUB OpenFile(sPath AS String, OPTIONAL iLine AS Integer)
DIM hForm AS Object
IF InStr(sPath, "/") = 0 THEN sPath = FindPath(sPath)
IF Not Exist(sPath) THEN
Message.Warning("File not found!")
Project.Refresh
RETURN
ENDIF
'IF File.Ext(sPath) = "form" THEN
' FProperty.Show
' FToolBox.Show
'ENDIF
LoadFile(sPath)
hForm = Files[sPath]
IF NOT hForm THEN RETURN
hForm.Show
IF Object.Type(hForm) = "FEditor" THEN
hForm.Editor.SetFocus
ENDIF
IF iLine THEN hForm.GotoCenter(iLine, 0)
END
PUBLIC FUNCTION ExistForm(sName AS String) AS Boolean
RETURN Dir(Project.Dir, "*.form").Find(sName & ".form", gb.Text) >= 0
END
PUBLIC SUB OpenForm(sName AS String)
DIM sPath AS String
sPath = Project.Dir &/ sName & ".form"
IF Exist(sPath) THEN OpenFile(sPath)
END
PRIVATE FUNCTION AddMessage(sVoid AS String) AS String
DIM hFic AS File
DIM sLig AS String
IF Stat(OUTPUT_FILE).Size = 0 THEN
SetMessage(sVoid)
RETURN
ELSE
OPEN OUTPUT_FILE FOR READ AS #hFic
WHILE Not Eof(hFic)
LINE INPUT #hFic, sLig
'ProjectMessage.Add(sLig)
WEND
CLOSE #hFic
ENDIF
'ProjectMessage.Index = ProjectMessage.Count - 1
'SetMessage(sLig)
RETURN sLig
END
PRIVATE SUB CompileError(sMsg AS String)
DIM iPos AS Integer
DIM sFile AS String
DIM iLine AS Integer
iPos = InStr(sMsg, ":")
'if iPos = 0 then return
sFile = Left$(sMsg, iPos - 1)
sMsg = Mid$(sMsg, iPos + 1)
iPos = InStr(sMsg, ":")
'if iPos = 0 then return
iLine = Val(Left$(sMsg, iPos - 1))
'if iLine = 0 then return
sFile = File.Dir(Path) &/ File.Name(sFile)
SetMessage(File.BaseName(sFile) & "." & CStr(iLine) & ": " & Trim(Mid$(sMsg, iPos + 1)))
OpenFile(sFile, iLine)
FGambas.Animate("Depressive")
Message.Warning(Trim(Mid$(sMsg, iPos + 1)) & "\n" & Subst(("at line &1 in &2"), CStr(iLine), File.Name(sFile)))
OpenFile(sFile, iLine)
CATCH
END
PUBLIC FUNCTION Quote(sPath AS String) AS String
DIM sQuote AS String
DIM iInd AS Integer
DIM sCar AS String
sPath = SConv$(sPath)
FOR iInd = 1 TO Len(sPath)
sCar = Mid$(sPath, iInd, 1)
IF InStr("0123456789abcdefghijklmnopqrstuvwxyz.-/_~", LCase(sCar)) = 0 THEN
sCar = "\\" & sCar
ENDIF
sQuote = sQuote & sCar
NEXT
RETURN sQuote
END
PUBLIC FUNCTION Escape(sStr AS String) AS String
DIM sRes AS String
DIM iInd AS Integer
DIM sCar AS String
DIM iPos AS Integer
FOR iInd = 1 TO Len(sStr)
sCar = Mid$(sStr, iInd, 1)
iPos = InStr("'\"\\\n\r\t", sCar)
IF iPos THEN sCar = "\\" & Mid$("'\"\\nrt", iPos, 1)
sRes = sRes & sCar
NEXT
RETURN sRes
END
PUBLIC SUB Process_Read()
DIM sLig AS String
LINE INPUT #LAST, sLig
PRINT sLig
END
PUBLIC SUB DeleteCompiledFiles()
DIM sFile AS String
EXEC ["rm", "-rf", Project.Dir &/ ".gambas"] WAIT
IF Exist(Project.Dir &/ ".lang") THEN
FOR EACH sFile IN Dir(Project.Dir &/ ".lang", "*.pot")
TRY KILL Project.Dir &/ ".lang" &/ sFile
NEXT
ENDIF
END
PUBLIC FUNCTION GetCompileCommand(bAll AS Boolean, bNoDebug AS Boolean, bIDE AS Boolean) AS String
DIM sExec AS String
sExec = System.Path &/ "bin/gbc" & System.Version & " "
IF bAll THEN sExec = sExec & "-a "
IF NOT bNoDebug THEN sExec = sExec & "-g "
IF Localize THEN sExec = sExec & "-t "
IF ControlPublic THEN sExec = sExec & "-p "
'sExec = sExec & "-c " & Quote(CLASSES_FILE) & " " & Quote(Project.Dir) & " > " & OUTPUT_FILE & " 2>&1"
IF bIDE THEN
sExec = sExec & Quote(Project.Dir)
sExec = sExec & " > " & OUTPUT_FILE & " 2>&1"
ENDIF
RETURN sExec
END
PUBLIC FUNCTION Compile(OPTIONAL bAll AS Boolean, OPTIONAL bNoDebug AS Boolean) AS Boolean
DIM sExec AS String
DIM sRes AS String
DIM sDir AS String
IF Project.ReadOnly THEN RETURN
IF Project.Running THEN RETURN 'TRUE
IF LockIt() THEN RETURN TRUE
sDir = Project.Dir
Save
SetMessage(("Compiling project") & " " & Project.Name & "...")
IF bAll THEN
CleanUpProject
DeleteCompiledFiles
WriteProject
ENDIF
sExec = GetCompileCommand(bAll, bNoDebug, TRUE)
SHELL sExec WAIT
'Stat(OUTPUT_FILE)
sRes = AddMessage(("Nothing to do."))
IF sRes THEN
IF sRes <> "OK" THEN
UnlockIt()
CompileError(sRes)
RETURN TRUE
ELSE
IF Localize THEN
TRY MKDIR sDir &/ ".lang"
SHELL "msgcat " & Quote(sDir) &/ ".lang/*.pot > " & Quote(sDir &/ ".lang/.pot") & " 2>/dev/null" WAIT
ENDIF
SetMessage(("OK"))
FGambas.Animate("Happy")
ENDIF
ENDIF
UnlockIt()
END
PRIVATE FUNCTION CheckRunning(OPTIONAL bCompileAll AS Boolean) AS Boolean
IF Project.Running THEN RETURN
IF Compile(bCompileAll) THEN RETURN TRUE
IF CheckStartupClass() THEN RETURN TRUE
END
PUBLIC SUB Run(OPTIONAL bCompileAll AS Boolean, OPTIONAL iDebug AS Integer)
IF CheckRunning(bCompileAll) THEN RETURN
IF iDebug = 1 THEN
FDebug.Step
ELSE IF iDebug = 2 THEN
FDebug.Forward
ELSE IF iDebug = 3 THEN
FDebug.ReturnFrom
ELSE
FDebug.Run
ENDIF
END
PUBLIC SUB Forward()
IF CheckRunning() THEN RETURN
FDebug.Forward
END
PUBLIC SUB ReturnFrom()
IF CheckRunning() THEN RETURN
FDebug.ReturnFrom
END
PUBLIC SUB RunUntil(hForm AS FEditor, iLine AS Integer)
IF CheckRunning() THEN RETURN
FDebug.RunUntil(hForm, iLine)
END
PUBLIC SUB Step()
IF Compile() THEN RETURN
IF CheckStartupClass() THEN RETURN
FDebug.Step
END
PUBLIC SUB Save()
DIM hForm AS Object
INC Application.Busy
FOR EACH hForm IN Files
IF Object.Type(hForm) = "FEditor" THEN
IF hForm.Save(TRUE) THEN BREAK
ELSE
IF hForm.Save() THEN BREAK
ENDIF
NEXT
DEC Application.Busy
END
PUBLIC SUB Insert(sName AS String, sType AS String, OPTIONAL sTemplate AS String, OPTIONAL bNoRefresh AS Boolean)
DIM sPath AS String
DIM sData AS String
sPath = Project.Dir &/ File.BaseName(sName) & "." & sType
IF Exist(sPath) THEN
Message.Warning(("File already exists."))
RETURN
ENDIF
File.Save(sPath, sTemplate)
IF Not bNoRefresh THEN Refresh
OpenFile(sPath)
END
PUBLIC SUB InsertFile(sName AS String, sDir AS String, OPTIONAL sTemplate AS String)
DIM sPath AS String
DIM sData AS String
sPath = sDir &/ sName
IF Len(sTemplate) THEN
IF Exist(sPath) THEN
Message.Warning(("File already exists."))
RETURN
ENDIF
SHELL "cp " & Quote(sTemplate) & " " & Quote(sPath) WAIT
IF Not Exist(sPath) THEN
Message.Error(("Cannot copy template file."))
RETURN
ENDIF
ENDIF
Refresh
RefreshLibrary
OpenFile(sPath)
END
PUBLIC SUB InsertDirectory(sPath AS String)
IF Exist(sPath) THEN
Message.Warning(("Directory already exists."))
RETURN
ENDIF
MKDIR sPath
Refresh
END
PUBLIC SUB Activate(hForm AS Object)
DIM sType AS String
'PRINT Application.ActiveWindow
'TRY PRINT Application.ActiveWindow.Name
'IF Application.ActiveWindow <> hForm THEN RETURN
'IF File.Ext(hForm.Path) = "class" THEN
' IF Exist(File.Dir(hForm.Path) &/ File.BaseName(hForm.Path) & ".form" THEN
IF AboutToQuit THEN RETURN
IF Not hForm THEN RETURN
SelectKey(hForm.Path)
IF ActiveForm = hForm THEN RETURN
ActiveForm = hForm
IF Object.Type(hForm) = "FIconEditor" THEN
FIconTool.Raise
ELSE
FIconTool.Hide
ENDIF
FProperty.RefreshAll
FFormStack.RefreshAll
' IF Object.Type(hForm) = "FTextEditor" THEN
' FFind.SetTextOnly(TRUE)
' ELSE IF Object.Type(hForm) = "FEditor" THEN
' FFind.SetTextOnly(FALSE)
' ENDIF
END
PUBLIC SUB Deactivate(hForm AS Object)
IF ActiveForm <> hForm THEN RETURN
SELECT CASE Object.Type(hForm)
CASE "FIconEditor"
FIconTool.Hide
CASE "FForm"
FProperty.HideAll
FFormStack.HideAll
END SELECT
END
PUBLIC FUNCTION NewProject(sDir AS String, OPTIONAL aOption AS String[]) AS Boolean
DIM sName AS String
DIM iInd AS Integer
DIM sPath AS String
DIM sOption AS String
sName = File.Name(sDir)
MKDIR sDir
sPath = sDir &/ PROJECT_FILE
IF aOption THEN sOption = aOption.Join("\n")
File.Save(sPath, PROJECT_MAGIC & "\nProject=" & sName & "\n" & sOption)
'BrowseForm.AddProject(sDir)
RETURN
CATCH
Message.Warning(("Cannot create project!") & "\n\n" & Error.Text)
RETURN TRUE
END
PUBLIC FUNCTION CopyProject(sSrc AS String, sDst AS String) AS Boolean
DIM sName AS String
DIM iInd AS Integer
DIM sPath AS String
DIM sOut AS String
sOut = Temp$
SHELL "cp -r " & Quote(sSrc) & " " & Quote(sDst) & " 2> " & Quote(sOut) WAIT
sOut = File.Load(sOut)
IF sOut THEN Error.Raise(sOut)
RETURN
CATCH
Message.Warning(("Cannot copy project!") & "\n\n" & Error.Text)
RETURN TRUE
END
PUBLIC FUNCTION MakeExecutable(OPTIONAL bDoNotIncVersion AS Boolean, OPTIONAL bSilent AS Boolean) AS Boolean
DIM sExec AS String
IF NOT bSilent THEN
Dialog.Title = ("Make executable")
Dialog.Path = ExecPath
Dialog.Filter = [("Gambas executable files") & " (*.gambas)", ("All files") & " (*)"]
IF NOT Exist(Dialog.Path) THEN
Dialog.Path = Project.Dir &/ Project.Name
ENDIF
IF Dialog.SaveFile() THEN RETURN TRUE
ExecPath = Dialog.Path
ENDIF
IF Compile(TRUE, NOT KeepDebugInfo) THEN RETURN TRUE
IF CheckStartupClass() THEN RETURN TRUE
SetMessage(("Making executable..."))
sExec = System.Path &/ "bin/gba" & System.Version & " " & Quote(Project.Dir) & " > " & OUTPUT_FILE & " 2>&1"
'PRINT sExec
SHELL sExec WAIT
IF ExecPath <> (Project.Dir &/ Project.Name & ".gambas") THEN
TRY KILL ExecPath
TRY RENAME Project.Dir &/ Project.Name AS ExecPath
ENDIF
'Stat(OUTPUT_FILE)
AddMessage(("Nothing to do."))
Compile(TRUE, FALSE)
IF Not bDoNotIncVersion THEN INC ReleaseVersion
WriteProject
END
PUBLIC FUNCTION GetClasses(OPTIONAL bFullPath AS Boolean) AS String[]
DIM sFile AS String
DIM aClass AS NEW String[]
DIM bStop AS Boolean
FOR EACH sFile IN Dir(Project.Dir, "*.module")
IF bFullPath THEN
aClass.Add(Project.Dir &/ sFile)
ELSE
aClass.Add(File.BaseName(sFile))
ENDIF
NEXT
FOR EACH sFile IN Dir(Project.Dir, "*.class")
IF bFullPath THEN
aClass.Add(Project.Dir &/ sFile)
ELSE
aClass.Add(File.BaseName(sFile))
ENDIF
NEXT
aClass.Sort
RETURN aClass
END
PUBLIC SUB ReadProject()
DIM hFic AS File
DIM sLig AS String
DIM iPos AS Integer
DIM sKey AS String
DIM sVal AS String
DIM cVer AS String[]
DIM sElt AS String
DIM iElt AS Integer
DIM aMissing AS NEW String[]
DIM sMsg AS String
Libraries = NEW String[]
Title = ""
TabSize = Settings["/DefaultTabSize", 2]
Arguments = ""
MajorVersion = 0
MinorVersion = 0
ReleaseVersion = 1
SnapToGrid = TRUE
ShowGrid = TRUE
Snap = Settings["/DefaultGridResolution", 8]
ControlPublic = FALSE
KeepDebugInfo = FALSE
Localize = FALSE
Description = ""
Icon = ""
Systems = NEW String[]
Menus = NEW Collection
Groups = NEW Collection
Prefix = FALSE
ExecPath = Project.Dir &/ Project.Name & ".gambas"
OPEN Path FOR READ AS hFic
WHILE Not Eof(hFic)
LINE INPUT #hFic, sLig
sLig = Trim(sLig)
IF Len(sLig) = 0 THEN CONTINUE
IF Left$(sLig, 1) = "#" THEN CONTINUE
iPos = InStr(sLig, "=")
IF iPos = 0 THEN CONTINUE
sKey = Lower$(Trim(Left$(sLig, iPos - 1)))
sVal = Trim(Mid$(sLig, iPos + 1))
SELECT sKey
CASE "title"
Title = sVal
CASE "startup"
DefineStartup(sVal, TRUE)
CASE "library"
IF CComponent.All.Exist(sVal) THEN
Libraries.Add(sVal)
ELSE
aMissing.Add(sVal)
ENDIF
CASE "tabsize"
TabSize = Val(sVal)
CASE "argument"
IF Arguments THEN Arguments = Arguments & "\n"
Arguments = Arguments & sVal
CASE "version"
cVer = Split(sVal, ".")
TRY MajorVersion = Val(cVer[0])
TRY MinorVersion = Val(cVer[1])
TRY ReleaseVersion = Val(cVer[2])
CASE "snaptogrid"
SnapToGrid = Val(sVal) <> 0
CASE "showgrid"
ShowGrid = Val(sVal) <> 0
CASE "snapx", "snap"
Snap = Val(sVal)
CASE "localize"
Localize = Val(sVal) <> 0
' CASE "language"
' Language = sVal
CASE "keepdebuginfo"
KeepDebugInfo = Val(sVal) <> 0
CASE "controlpublic"
ControlPublic = Val(sVal) <> 0
CASE "description"
Description = Replace(sVal, "\\n", "\n")
CASE "icon"
Icon = sVal
CASE "systems"
Systems = Split(sVal, ",")
CASE "menus"
iElt = 0
FOR EACH sElt IN Split(sVal, ",")
IF iElt >= Systems.Count THEN BREAK
Menus[Systems[iElt]] = sElt
INC iElt
NEXT
CASE "groups"
iElt = 0
FOR EACH sElt IN Split(sVal, ",")
IF iElt >= Systems.Count THEN BREAK
Groups[Systems[iElt]] = sElt
INC iElt
NEXT
CASE "prefix"
Prefix = Val(sVal)
CASE "execpath"
ExecPath = sVal
END SELECT
WEND
CLOSE hFic
IF aMissing.Count THEN
sMsg = Subst(("Some components are missing: &1"), aMissing.Join(", "))
IF Message.Error(sMsg, ("Continue"), ("Cancel")) = 2 THEN
Error.Raise("")
ENDIF
ENDIF
'Libraries.Sort
FMain.UpdateTranslate
RefreshLibrary
'TileGrid = NEW Picture
'TileGrid.Type = Picture.Bitmap
'TileGrid.Resize(SnapX, SnapY)
'Draw.Begin(TileGrid)
'Draw.FillColor = Color.
'Draw.End
END
PUBLIC SUB WriteProject()
DIM hFic AS File
DIM sLib AS String
DIM sSys AS String
DIM sElt AS String
DIM sPath AS String
DIM sArg AS String
DIM iKey AS Integer
DIM iCount AS Integer
DIM hComp AS CComponent
IF Project.ReadOnly THEN RETURN
OPEN Path & ".tmp" FOR CREATE AS hFic
PRINT #hFic, PROJECT_MAGIC
PRINT #hFic, "Project="; Name
IF Title THEN PRINT #hFic, "Title="; Title
IF Description THEN PRINT #hFic, "Description="; Replace(Description, "\n", "\\n")
IF Icon THEN PRINT #hFic, "Icon="; Icon
IF Startup THEN PRINT #hFic, "Startup="; Startup
'IF StackSize THEN PRINT #hFic, "Stack="; CStr(StackSize)
PRINT #hFic, "TabSize="; CStr(TabSize)
FOR EACH sArg IN Split(Arguments, "\n")
PRINT #hFic, "Argument="; sArg
NEXT
PRINT #hFic, "Version="; CStr(MajorVersion) & "." & CStr(MinorVersion) & "." & CStr(ReleaseVersion)
' FOR iKey = 1 TO 1000
' FOR EACH sLib IN Libraries
' IF CComponent.All[sLib].SortKey = iKey THEN
' PRINT #hFic, "Library="; sLib
' INC iCount
' ENDIF
' NEXT
' IF iCount = Libraries.Count THEN BREAK
' NEXT
FOR EACH hComp IN CComponent.All
IF Libraries.Find(hComp.Key) >= 0 THEN
PRINT #hFic, "Library="; hComp.Key
ENDIF
NEXT
PRINT #hFic, "SnapToGrid="; If(SnapToGrid, "1", "0")
PRINT #hFic, "ShowGrid="; If(ShowGrid, "1", "0")
PRINT #hFic, "Snap="; CStr(Snap)
PRINT #hFic, "Localize="; If(Localize, "1", "0")
'PRINT #hFic, "Language="; Language
PRINT #hFic, "KeepDebugInfo="; If(KeepDebugInfo, "1", "0")
PRINT #hFic, "ControlPublic="; If(ControlPublic, "1", "0")
IF ExecPath <> (Project.Dir &/ Project.Name & ".gambas") THEN
PRINT #hFic, "ExecPath="; ExecPath
ENDIF
IF Systems.Count THEN
PRINT #hFic, "Systems="; Systems.Join(",")
sElt = ""
FOR EACH sSys IN Systems
sElt = sElt & "," & Menus[sSys]
NEXT
PRINT #hFic, "Menus="; Mid$(sElt, 2)
sElt = ""
FOR EACH sSys IN Systems
sElt = sElt & "," & Groups[sSys]
NEXT
PRINT #hFic, "Groups="; Mid$(sElt, 2)
ENDIF
PRINT #hFic, "Prefix="; If(Prefix, "1", "0")
CLOSE #hFic
KILL Path
RENAME Path & ".tmp" AS Path
sPath = Project.Dir &/ ".lang/#project.pot"
TRY KILL sPath
IF Localize THEN
TRY MKDIR File.Dir(sPath)
OPEN sPath FOR CREATE AS #hFic
PRINT #hFic, "# "; Path
PRINT #hFic, File.Load("pot-header.txt")
IF Title THEN
PRINT #hFic, "#: .project:1"
PRINT #hFic, "msgid \""; Escape(Title); "\""
PRINT #hFic, "msgstr \"\"\n"
ENDIF
IF Description THEN
PRINT #hFic, "#: .project:2"
PRINT #hFic, "msgid \""; Escape(Description); "\""
PRINT #hFic, "msgstr \"\"\n"
ENDIF
CLOSE #hFic
ENDIF
RefreshLibrary
FMain.UpdateTranslate
CATCH
Message.Error(("Cannot write project file.") & "\n\n" & Error.Text)
END
' PUBLIC FUNCTION GetSorted() AS String[]
'
' DIM cList AS NEW String[]
' DIM hFile AS Object
' DIM bStop AS Boolean
'
' ProjectTree[KEY_CLASS].MoveChild
' WHILE ProjectTree.Available
' cList.Add(ProjectTree.Item.Key)
' ProjectTree.MoveNext
' WEND
'
' ProjectTree[KEY_MODULE].MoveChild
' WHILE ProjectTree.Available
' cList.Add(ProjectTree.Item.Key)
' ProjectTree.MoveNext
' WEND
'
' 'cList.Sort
'
' RETURN cList
'
' END
PUBLIC FUNCTION GetNextEditor(sKey AS String) AS String
DIM sFirst AS String
DIM sFile AS String
DIM bNext AS Boolean
FOR EACH sFile IN GetClasses(TRUE)
IF bNext THEN RETURN sFile
IF NOT sFirst THEN
sFirst = sFile
ENDIF
IF sFile = sKey THEN
bNext = TRUE
ENDIF
NEXT
IF bNext THEN RETURN sFirst
END
PUBLIC FUNCTION GetPreviousEditor(sKey AS String) AS String
DIM sLast AS String
DIM sFile AS String
FOR EACH sFile IN GetClasses(TRUE)
IF sFile = sKey THEN
IF sLast THEN
RETURN sLast
ENDIF
ENDIF
sLast = sFile
NEXT
RETURN sLast
END
PRIVATE $bBlock AS Boolean
PUBLIC SUB Shortcut(Code AS Integer, Ascii AS String, State AS Integer)
IF $bBlock THEN RETURN
$bBlock = TRUE
SELECT CASE Code
CASE Key.F2
FExplorer.Show
CASE Key.F4
FProperty.Show
CASE Key.F5
ME.Run
CASE Key.F6
FToolBox.Show
CASE Key.F7
Compile(State And Mouse.Alt)
CASE Key.F8
ME.Step
END SELECT
$bBlock = FALSE
END
PUBLIC SUB SetMessage(sMsg AS String)
ProjectMessage.Text = sMsg
WAIT
END
PUBLIC SUB DeleteFile(sPath AS String)
DIM sExt AS String
DIM hForm AS Object
IF Not Exist(sPath) THEN RETURN
hForm = Files[sPath]
IF hForm THEN
hForm.Delete
Files[sPath] = NULL
ENDIF
TRY ProjectTree.Remove(sPath)
TRY KILL sPath & "~"
TRY RENAME sPath AS sPath & "~"
IF sExt = "form" Or sExt = "class" Or sExt = "module" THEN
TRY KILL Project.Dir &/ ".gambas" &/ UCase(File.BaseName(sPath))
TRY KILL Project.Dir &/ ".lang" &/ File.BaseName(sPath) & ".pot"
ENDIF
sExt = File.Ext(sPath)
IF sExt = "form" THEN
DeleteFile(File.Dir(sPath) &/ File.BaseName(sPath) & ".class")
ELSE IF sExt = "class" THEN
DeleteFile(File.Dir(sPath) &/ File.BaseName(sPath) & ".form")
ENDIF
IF File.BaseName(sPath) = Startup THEN
DefineStartup("")
ENDIF
'CATCH
'Message("*Unable to delete file.||" & sPath)
'Refresh
END
PUBLIC SUB DeleteDir(sDir AS String)
DIM sFile AS String
FOR EACH sFile IN Dir(sDir, "*~")
TRY KILL sDir &/ sFile
NEXT
RMDIR sDir
END
PRIVATE FUNCTION CheckStartupClass() AS Boolean
IF Startup THEN RETURN
Message.Warning(("You must define a startup class or form!"))
RETURN TRUE
END
PUBLIC FUNCTION CheckFileName(sName AS String, OPTIONAL sDir AS String) AS Boolean
DIM iInd AS Integer
IF Not sName THEN GOTO VOID_NAME
FOR iInd = 1 TO Len(sName)
IF InStr(FILE_AUTH_CAR & "-._+()", LCase(Mid$(sName, iInd, 1))) = 0 THEN GOTO BAD_CHAR
NEXT
IF Len(sDir) THEN
IF Exist(sDir &/ sName) THEN GOTO ALREADY_EXIST
ENDIF
RETURN
VOID_NAME:
Message.Warning(("Please type a name."))
RETURN TRUE
BAD_CHAR:
Message.Warning(("This name contains a forbidden character :") & " [ " & Mid$(sName, iInd, 1) & " ]")
RETURN TRUE
ALREADY_EXIST:
Message.Warning(("This name is already used. Choose another one."))
RETURN TRUE
END
PUBLIC FUNCTION CheckClassName(sName AS String, OPTIONAL bCheckNotExist AS Boolean) AS Boolean
DIM iInd AS Integer
IF Not sName THEN GOTO VOID_NAME
FOR iInd = 1 TO Len(sName)
IF InStr(CLASS_AUTH_CAR, LCase(Mid$(sName, iInd, 1))) = 0 THEN GOTO BAD_CHAR
NEXT
IF InStr("0123456789", Left$(sName)) THEN
iInd = 1
GOTO BAD_CHAR
ENDIF
IF bCheckNotExist THEN
IF Project.Exist(sName) THEN GOTO ALREADY_EXIST
ENDIF
RETURN
VOID_NAME:
Message.Warning(("Please type a name."))
RETURN TRUE
BAD_CHAR:
Message.Warning(("This name contains a forbidden character :") & " [ " & Mid$(sName, iInd, 1) & " ] \n\n" & ("A name must begin with a letter, followed by any letter or digit."))
RETURN TRUE
ALREADY_EXIST:
Message.Warning(("This name is already used. Choose another one."))
RETURN TRUE
END
PRIVATE FUNCTION RenameOneFile(sDir AS String, sName AS String, sNewName AS String, OPTIONAL sExt AS String) AS String
DIM sPath AS String
DIM hForm AS Object
DIM sNewPath AS String
sPath = sDir &/ sName
IF sExt THEN sPath = sPath & "." & sExt
IF NOT Exist(sPath) THEN RETURN
sNewPath = sDir &/ sNewName
IF sExt THEN sNewPath = sNewPath & "." & sExt
RENAME sPath AS sNewPath
IF sExt THEN
TRY KILL sDir &/ ".gambas" &/ UCase(sName)
ENDIF
hForm = Files[sPath]
IF hForm THEN
hForm.Rename(sNewName, sNewPath)
Files[sPath] = NULL
Files[sNewPath] = hForm
ENDIF
RETURN sNewPath
END
PUBLIC SUB RenameFile(sPath AS String)
DIM sName AS String
DIM sExt AS String
DIM sDir AS String
DIM sNewName AS String
DIM sNewPath AS String
DIM sTitle AS String
sDir = File.Dir(sPath)
sExt = File.Ext(sPath)
IF Project.IsClassName(sPath) THEN
sName = File.BaseName(sPath)
SELECT CASE sExt
CASE "form"
sTitle = ("Rename form")
CASE "class"
sTitle = ("Rename class")
CASE "module"
sTitle = ("Rename module")
END SELECT
sNewName = FRename.Run(sName, sTitle, TRUE)
IF Not sNewName THEN RETURN
IF sName = Startup THEN
Startup = sNewName
WriteProject
ENDIF
sNewPath = RenameOneFile(sDir, sName, sNewName, sExt)
IF sExt = "form" THEN
RenameOneFile(sDir, sName, sNewName, "class")
ELSE IF sExt = "class" THEN
RenameOneFile(sDir, sName, sNewName, "form")
ENDIF
ELSE
sName = File.Name(sPath)
sNewName = FRename.Run(sName, If(IsDir(sPath), ("Rename directory"), ("Rename file")))
IF Not sNewName THEN RETURN
sNewPath = RenameOneFile(sDir, sName, sNewName)
ENDIF
Refresh
TRY ProjectTree[sNewPath].Selected = TRUE
TRY ProjectTree[sNewPath].EnsureVisible
CATCH
Message.Error(Subst(("Unable to rename '&1'"), File.Name(sPath)))
END
PUBLIC FUNCTION Exist(sName AS String) AS Boolean
RETURN Project.GetClasses().Find(sName, gb.Text) >= 0
END
PRIVATE FUNCTION LockIt() AS Boolean
IF Application.Busy THEN RETURN TRUE
INC Application.Busy
'PRINT "Lock"
END
PRIVATE SUB UnLockIt()
DEC Application.Busy
END
PUBLIC FUNCTION GetProject() AS String
RETURN FOpenProject.Run()
END
PUBLIC FUNCTION GetNewProject() AS String
RETURN FNewProject.Run()
END
PRIVATE SUB LoadRecent()
DIM nRecent AS Integer
DIM hMenu AS Menu
DIM iInd AS Integer
DIM sPath AS String
nRecent = Settings["/Recent/Count", 0]
Recent.Clear
FOR iInd = 1 TO nRecent
sPath = Settings["/Recent/File[" & CStr(iInd) & "]"]
IF sPath THEN
IF Exist(sPath) THEN
Recent.Add(sPath)
IF Recent.Count >= MAX_RECENT THEN BREAK
ENDIF
ENDIF
NEXT
END
PRIVATE SUB AddRecent(sPath AS String)
DIM iInd AS Integer
IF Right$(sPath) = "/" THEN sPath = Left$(sPath, -1)
'sPath = "(" & File.BaseName(sPath) & ") " & File.Dir(sPath)
WHILE iInd < Recent.Count
IF Recent[iInd] = sPath THEN
Recent.Remove(iInd)
ELSE
INC iind
ENDIF
WEND
Recent.Add(sPath, 0)
WHILE Recent.Count > MAX_RECENT
Recent.Remove(Recent.Count - 1)
WEND
SaveRecent
END
PRIVATE SUB SaveRecent()
DIM iInd AS Integer
Settings["/Recent/Count"] = CStr(Recent.Count)
FOR iInd = 0 TO Recent.Count - 1
Settings["/Recent/File[" & CStr(iInd + 1) & "]"] = Recent[iInd]
NEXT
Settings.Save
END
PUBLIC FUNCTION CheckProjectName(sName AS String, OPTIONAL sDir AS String) AS Boolean
DIM iInd AS Integer
DIM sCar AS String
IF NOT sName THEN
Message.Warning(("Please type a project name."))
RETURN TRUE
ENDIF
FOR iInd = 1 TO Len(sName)
sCar = Mid$(sName, iInd, 1)
IF iInd = 1 THEN
IF InStr(" ?*.", sCar) = 0 And Asc(sCar) < 128 THEN CONTINUE
ELSE
IF InStr(" ?*", sCar) = 0 And Asc(sCar) < 128 THEN CONTINUE
ENDIF
Message.Warning(("Forbidden characters in project name."))
RETURN TRUE
NEXT
IF sDir THEN
IF Exist(sDir &/ sName &/ PROJECT_FILE) THEN
Message.Warning(("This project already exists."))
RETURN TRUE
ENDIF
ENDIF
END
PUBLIC SUB MakeSourcePackageTo(sPath AS String)
DIM sCmd AS String
DIM sOpt AS String
INC Application.Busy
IF Right$(sPath, 3) = ".gz" THEN
sOpt = "z"
ELSE IF Right$(sPath, 4) = ".bz2" THEN
sOpt = "j"
ENDIF
sCmd = "cd " & Quote(File.Dir(Project.Dir)) & ";"
sCmd = sCmd & " tar cfv" & sOpt & " " & Quote(sPath)
sCmd = sCmd & " --exclude=" & ".gambas/*"
sCmd = sCmd & " --exclude=" & "*~"
sCmd = sCmd & " --exclude=" & ".lock"
sCmd = sCmd & " --exclude=" & ".lang/*.pot"
sCmd = sCmd & " --exclude=" & ".lang/.pot"
sCmd = sCmd & " --exclude=" & "*/.xvpics/*"
sCmd = sCmd & " --exclude=" & ".xvpics/*"
sCmd = sCmd & " " & Quote(File.Name(Project.Dir)) & " > /dev/null"
SHELL sCmd WAIT
DEC Application.Busy
END
PUBLIC SUB MakePackage()
Dialog.Path = User.Home &/ Name & "-" & Subst("&1.&2", MajorVersion, MinorVersion) & IIf(ReleaseVersion > 0, "." & ReleaseVersion, "") & ".tar.gz"
Dialog.Title = ("Create source package")
Dialog.Filter = [("Source packages") & " (*.tar.gz)", ("All files") & " (*)"]
IF Dialog.SaveFile() THEN RETURN
MakeSourcePackageTo(Dialog.Path)
END
PUBLIC SUB RefreshForm()
DIM hFile AS Object
FOR EACH hFile IN Project.Files
IF Not Project.IsEditor(hFile) THEN
hFile.Refresh
ENDIF
NEXT
END
PUBLIC SUB RefreshEditor()
DIM hFile AS Object
FOR EACH hFile IN Project.Files
IF Project.IsEditor(hFile) THEN
hFile.Refresh
ENDIF
NEXT
END
PUBLIC SUB RefreshLibrary()
DIM sLib AS String
DIM sClass AS String
CComponent.Reset
ComponentFromType = NEW Collection
FOR EACH sLib IN Libraries
IF Not CComponent.All.Exist(sLib) THEN CONTINUE
WITH CComponent.All[sLib]
.Load
IF .Type THEN ComponentFromType[.Type] = sLib
END WITH
NEXT
FToolBox.RefreshToolbar
FCompletion.RefreshLibrary
FExplorer.RefreshTree
Project.Refresh
END
PUBLIC FUNCTION IsClassName(sName AS String) AS Boolean
DIM sExt AS String
sExt = File.Ext(sName)
IF sExt = "class" THEN RETURN TRUE
IF sExt = "module" THEN RETURN TRUE
IF sExt = "form" THEN RETURN TRUE
END
PUBLIC FUNCTION StripPath(sPath AS String) AS String
DIM sDir AS String
sDir = Project.Dir
IF Right$(sDir) <> "/" THEN sDir = sDir & "/"
IF Left$(sPath, Len(sDir)) = sDir THEN
RETURN Mid$(sPath, Len(sDir) + 1)
ELSE
RETURN sPath
ENDIF
END
PUBLIC SUB RunTool(sTool AS String)
DIM aExec AS NEW String[]
aExec.Add(System.Path &/ "bin" &/ sTool & ".gambas")
aExec.Add(Project.Dir)
EXEC aExec
END
PUBLIC FUNCTION GetExamples() AS String[]
DIM sFile AS String
DIM sFile2 AS String
DIM aList AS NEW String[]
FOR EACH sFile IN Dir(EXAMPLES_DIR)
IF Exist(EXAMPLES_DIR &/ sFile &/ ".project") THEN
aList.Add(sFile)
ELSE
FOR EACH sFile2 IN Dir(EXAMPLES_DIR &/ sFile)
aList.Add(sFile &/ sFile2)
NEXT
ENDIF
NEXT
aList.Sort
FINALLY
RETURN aList
END
PUBLIC SUB DefineStartup(sPath AS String, OPTIONAL bDoNotWrite AS Boolean)
IF Startup THEN
TRY ProjectTree[Project.Dir &/ Startup & ".module"].Picture = Picture["img/16/module.png"]
TRY ProjectTree[Project.Dir &/ Startup & ".class"].Picture = Picture["img/16/class.png"]
TRY ProjectTree[Project.Dir &/ Startup & ".form"].Picture = Picture["img/16/form.png"]
ENDIF
Startup = File.BaseName(sPath)
IF NOT Project.Exist(Startup) THEN
Startup = ""
ENDIF
IF Startup THEN
TRY ProjectTree[Project.Dir &/ Startup & ".module"].Picture = Picture["img/16/module-start.png"]
TRY ProjectTree[Project.Dir &/ Startup & ".class"].Picture = Picture["img/16/class-start.png"]
TRY ProjectTree[Project.Dir &/ Startup & ".form"].Picture = Picture["img/16/form-start.png"]
ENDIF
IF NOT bDoNotWrite THEN WriteProject
END
PUBLIC SUB CopyFile(sSrc AS String, sDst AS String)
DIM iInd AS Integer
DIM sDest AS String
DIM sExt AS String
'PRINT sSrc; " -> "; sDst
sDest = sDst
WHILE Exist(sDest)
INC iInd
sExt = File.Ext(sDst)
IF sExt THEN
sDest = File.Dir(sDst) &/ File.BaseName(sDst) & " (" & iInd & ")." & sExt
ELSE
sDest = File.Dir(sDst) &/ File.BaseName(sDst) & " (" & iInd & ")"
ENDIF
WEND
COPY sSrc TO sDest
Refresh
SelectKey(sDest)
CATCH
Message.Error(Subst(("Cannot copy file &1."), sSrc) & "\n\n" & Error.Text)
END
PUBLIC SUB MoveFile(sSrc AS String, sDst AS String)
RENAME sSrc AS sDst
Refresh
SelectKey(sDst)
CATCH
Message.Error(Subst(("Cannot move file &1."), sSrc) & "\n\n" & Error.Text)
END
' PUBLIC SUB RefreshToolbox()
'
' FToolBox.ClearToolbar
'
' END
PUBLIC FUNCTION GetNewName(sPrefix AS String) AS String
DIM iInd AS Integer
DIM sName AS String
DO
INC iInd
sName = sPrefix & iInd
IF NOT Project.Exist(sName) THEN RETURN sName
LOOP
END
PUBLIC SUB ResetScan()
DIM hFile AS Object
FOR EACH hFile IN Files
TRY hFile.colScan = NULL
NEXT
END
PUBLIC FUNCTION AllowForm() AS Boolean
RETURN ComponentFromType.Exist("Form")
END
PUBLIC SUB MakeInstall()
IF MakeExecutable(TRUE, TRUE) THEN RETURN
IF NOT CheckProgram("rpmbuild") THEN
RPMBUILD_PROG = "rpmbuild"
ELSE IF NOT CheckProgram("rpm") THEN
RPMBUILD_PROG = "rpm"
ELSE
Message.Error(("rpmbuild is not installed on your system."))
RETURN
ENDIF
FMakeInstall.ShowModal
END
PUBLIC SUB InitMove(hForm AS Form)
IF FMain.X < (Desktop.W \ 2) THEN
hForm.Move(Int(Rnd(FMain.X + FMain.W + 8, Desktop.Width - hForm.Width - 8)), Int(Rnd(0, Desktop.Height - hForm.Height)))
ELSE
hForm.Move(Int(Rnd(0, FMain.X - hForm.Width - 8)), Int(Rnd(0, Desktop.Height - hForm.Height)))
ENDIF
END
PUBLIC FUNCTION GetIcon(sPath AS String, iSize AS Integer) AS Picture
DIM hFile AS File
DIM sLig AS String
DIM hImage AS Image
DIM hPict AS Picture
OPEN sPath &/ ".project" FOR READ AS #hFile
WHILE NOT Eof(hFile)
LINE INPUT #hFile, sLig
IF Left$(sLig, 5) = "Icon=" THEN
sPath = sPath &/ Mid$(sLig, 6)
hImage = NEW Image
TRY hImage.Load(sPath)
IF ERROR THEN hImage = NULL
BREAK
ENDIF
WEND
CLOSE #hFile
FINALLY
IF NOT hImage THEN
hImage = NEW Image
hImage.Load("img/32/gambas.png")
ENDIF
RETURN hImage.Stretch(iSize, iSize, TRUE).Picture
END
PRIVATE SUB CleanUpProject()
DIM aDir AS NEW String[]
DIM sFile AS String
DIM sPath AS String
aDir.Add(Project.Dir)
WHILE aDir.Count
FOR EACH sFile IN Dir(aDir[0])
sPath = aDir[0] &/ sFile
IF IsDir(sPath) THEN
aDir.Add(sPath)
ELSE IF Right(sPath) = "~" THEN
TRY KILL sPath
ENDIF
NEXT
aDir.Remove(0)
WEND
CATCH
Message.Error(("Cannot clean the project.") & "\n\n" & Error.Text)
END
PUBLIC SUB SetFormIcon(hForm AS FForm)
'
' DIM hPict AS Picture
' DIM eRap AS Float
'
' 'hForm.Raise
' hPict = hForm.Grab()
' hForm.Refresh
' eRap = hPict.Width / hPict.Height
' IF eRap > 4 THEN
' eRap = 4
' hPict = hPict.Copy(0, 0, hPict.Height * eRap, hPict.Height)
' ELSE IF eRap < 0.5 THEN
' eRap = 0.5
' hPict = hPict.Copy(0, 0, hPict.Width, hPict.Width / eRap)
' ENDIF
' IF eRap > 1 THEN
' hPict = hPict.Image.Stretch(32 * eRap, 32).Picture
' ELSE
' hPict = hPict.Image.Stretch(32, 32 / eRap).Picture
' ENDIF
'
' Draw.Begin(hPict)
' Draw.Foreground = &H808080&
' Draw.Rect(0, 0, hPict.Width, hPict.Height)
' Draw.End
'
' ProjectTree[Project.Dir &/ hForm.Name & ".form"].Picture = hPict
'
' CATCH
'
' PRINT Error.Text
'
END
PUBLIC FUNCTION CheckProgram(sProg AS String) AS Boolean
DIM sTemp AS String
DIM bError AS Boolean
sTemp = Temp$
SHELL "which " & sProg & " > " & sTemp WAIT
bError = Trim(File.Load(sTemp)) LIKE "which: *"
KILL sTemp
RETURN bError
END
PUBLIC FUNCTION OpenWebPage(sLink AS String) AS String
DIM sExec AS String
IF NOT $sBrowser THEN
sExec = Application.Env["BROWSER"]
IF NOT sExec THEN
sExec = "konqueror"
IF CheckProgram(sExec) THEN sExec = "firefox"
IF CheckProgram(sExec) THEN sExec = "mozilla-firefox"
IF CheckProgram(sExec) THEN sExec = "mozilla"
IF CheckProgram(sExec) THEN sExec = "opera"
IF CheckProgram(sExec) THEN RETURN
ENDIF
$sBrowser = sExec
ENDIF
SHELL $sBrowser & " " & Chr$(34) & sLink & Chr$(34)
CATCH
Message.Error(Error.Text)
END
-------------- next part --------------
A non-text attachment was scrubbed...
Name: CComponent.class
Type: application/x-java
Size: 12441 bytes
Desc: not available
URL: <http://lists.gambas-basic.org/pipermail/user/attachments/20050902/b5421c71/attachment-0001.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: FEditor.class
Type: application/x-java
Size: 36490 bytes
Desc: not available
URL: <http://lists.gambas-basic.org/pipermail/user/attachments/20050902/b5421c71/attachment-0002.bin>
More information about the User
mailing list