[Gambas-user] Some Little Patch
Leonardo Miliani
leonardo at ...1237...
Mon May 1 11:08:54 CEST 2006
fabien Bodard ha scritto:
> Hi to all this is just a little temporary patch that add a side 'goto' bar.
>
> Just replace the project.module file and add the Fsubs.Form and . class files,
> and recompile the ide ...
>
> Regards,
> Fabien Bodard
>
>
> ------------------------------------------------------------------------
>
> ' Gambas module file
>
> PUBLIC ProjectTree AS TreeView
> PUBLIC ProjectMessage AS Label
> PUBLIC Workspace AS Workspace
>
> 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 = 8192
>
> 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
> DIM iTest AS Integer
>
> 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(Workspace)
>
> FOutput.Load(Workspace)
> 'FDebug.Load(Workspace)
> FIconTool.Load(Workspace)
> FFormStack.Load(Workspace)
> FExplorer.Load(Workspace)
> FToolBox.Load(Workspace)
> FProperty.Load(Workspace)
> 'FSubs.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 hImage AS Image
> 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
> TRY hImage = Image.Load(sIcon)
> IF hImage.Height > 48 THEN
> hImage = hImage.Stretch(hImage.Width * 48 / hImage.Height, 48)
> ENDIF
> IF hImage.Width > 64 THEN
> hImage = hImage.Stretch(64, hImage.Height * 64 / hImage.Width)
> ENDIF
> hPict = hImage.Picture
> 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/32/../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, Workspace)
>
> CASE "form"
> IF AllowForm() THEN hForm = NEW FForm(sPath, Workspace)
>
> CASE "png", "gif", "jpg", "jpeg", "bmp", "xpm"
> hForm = NEW FIconEditor(sPath, Workspace)
>
> CASE ELSE
> hForm = NEW FTextEditor(sPath, Workspace)
>
> 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
>
> 'DEBUG "Activate: "; Workspace.ActiveWindow.Title
>
> '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 hForm THEN
> SelectKey(hForm.Path)
> IF ActiveForm = hForm THEN RETURN
> ActiveForm = hForm
> ELSE
> IF NOT ActiveForm THEN RETURN
> ENDIF
>
> FProperty.RefreshAll
> FFormStack.RefreshAll
>
> IF Object.Type(ActiveForm) = "FIconEditor" THEN
> FIconTool.Raise
> ELSE
> FIconTool.Hide
> ENDIF
>
> IF Object.Type(ActiveForm) = "FForm" THEN
> FProperty.Raise
> FToolBox.Raise
> ActiveForm.Raise
> ELSE
> FProperty.Lower
> FToolBox.Lower
> ENDIF
>
> IF Object.Type(ActiveForm) = "FEditor" THEN
> FSubs.RefreshAll
> FSubs.Raise
> ELSE
> FSubs.Hide
> ENDIF
>
>
>
> ' 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
>
> 'DEBUG "DeActivate: "; hForm.Title
>
> SELECT CASE Object.Type(hForm)
>
> CASE "FIconEditor"
> FIconTool.Hide
> CASE "FEditor"
> FSubs.Hide
> CASE "FForm"
> FProperty.HideAll
> FFormStack.HideAll
> FProperty.Hide
> FToolBox.Hide
>
> 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 move Project.Dir &/ Project.Name TO 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"
>
> hFic = OPEN Path FOR READ
>
> 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
>
> hFic = OPEN Path & ".tmp" FOR CREATE
>
> 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
> move Path & ".tmp" TO 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 move sPath TO 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
>
> move sPath TO 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)
>
> move sSrc TO 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.Scan = 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)
>
> hForm.Move(Int(Rnd(0, Max(0, Workspace.Width - hForm.Width - 8))), Int(Rnd(0, Max(0, Workspace.Height - hForm.Height - 8))))
>
> 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)
> TRY hImage = Image.Load(sPath)
> IF ERROR THEN hImage = NULL
> BREAK
> ENDIF
> WEND
>
> CLOSE #hFile
>
> FINALLY
>
> IF NOT hImage THEN
> hImage = Image.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
>
>
>
> ------------------------------------------------------------------------
>
> # Gambas Form File 1.0
>
> { FSubs Form
> MoveScaled(7.375,0.125,33.125,45.25)
> 'Move(59,1,265,362)
> Text = ("Goto")
> Persistent = True
> TopOnly = True
> Arrangement = Arrange.Vertical
> { Label1 Label
> MoveScaled(1,1,31,3)
> 'Move(8,8,248,24)
> Text = ("Goto")
> Border = Border.Raised
> }
> { tvFct TreeView
> MoveScaled(2,8,25,27)
> 'Move(16,64,200,216)
> Font = Font["-1"]
> Expand = True
> }
> }
>
>
> ------------------------------------------------------------------------
>
I've read about this patch just right now.
I'd like to know if I can apply it on SDI version of Gambas too or that
is only for the MDI one.
--
Ciao.
Leo
Visita il mio sito personale: www.leonardomiliani.com
e-mail: leonardo at ...1237...
More information about the User
mailing list