project.module

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

' 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 Types AS String[]
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/examples"

  'Config = NEW Config '(System.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 = System.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 -V > " & TMP_FILE WAIT
  sVer = File.Load(TMP_FILE)
  KILL TMP_FILE

  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

  FOR EACH hForm IN Files
    hForm.Delete
  NEXT

  Files.Clear
  ActiveForm = NULL

  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

  SaveRecent

  '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 NOT .Hidden THEN

      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

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

    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).Expanded = TRUE
    IF AllowForm() THEN
      .Add(KEY_FORM, ("Forms"), Picture["img/16/close.png"], sKey).Expanded = TRUE
    ENDIF
    .Add(KEY_MODULE, ("Modules"), Picture["img/16/close.png"], sKey).Expanded = TRUE
    .Add(KEY_MISC, ("Data"), Picture["img/16/close.png"], sKey).Expanded = TRUE

    '$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 = Conv$(sPath, Desktop.Charset, System.Charset)

  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