project.module

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

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 "
  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 {Lock}() 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

      {Unlock}()
      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

  {Unlock}()

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 = [ ("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 " & Quote(Project.Dir) & " > " & OUTPUT_FILE & " 2>&1"

  'PRINT sExec

  SHELL sExec WAIT
  IF ExecPath <> (Project.Dir &/ Project.Name) 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

  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

  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 EACH sLib IN Libraries

    PRINT #hFic, "Library="; sLib

  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) 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]