fmain.class

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

' Gambas class file

PRIVATE CONST FILE_CLIPBOARD_FORMAT AS String = "text/x-gambas-file"

PRIVATE $sKey AS String
PRIVATE $bCtrl AS Boolean

PUBLIC SUB _new()

  Project.ProjectTree = tvwProject
  Project.ProjectMessage = lblMessage

  FDebugInfo.Load(splProject)
  FDebugInfo.Hide

  FDebug.Load(panToolbar)
  FDebug.H = 24

  ME.Move(0, 0, ME.Width, Desktop.Height)
  Config.LoadWindow(ME, "/FMain")
  ReadConfig

  UpdateRecentMenu
  UpdateExampleMenu

END


PUBLIC SUB Form_Close()

  DIM bRet AS Boolean

  IF Project.Close() THEN
    STOP EVENT
  ELSE
    Config.SaveWindow(ME, "/FMain")
  ENDIF

END


' PUBLIC SUB Form_Resize()
'
'   'PRINT "("; ME.Width; ME.Height; ") ("; ME.CLientW; ME.ClientH; ")"
'
'   'panToolBar.W = ME.CLientW
'   'panToolBar.H = FDebug.Y + FDebug.H
'   'tvwProject.Move(0, panToolbar.H, ME.ClientWidth, ME.ClientHeight - lblMessage.H - panToolbar.H)
'   'lblMessage.Move(0, tvwProject.Y + tvwProject.H, ME.ClientW, lblMessage.H)
'
' END


PUBLIC SUB mnuOpen_Click()

  DIM sPath AS String

  sPath = Project.GetProject()
  IF NOT sPath THEN RETURN

  Project.Open(sPath)
  UpdateRecentMenu

END


PUBLIC SUB tvwProject_Activate()

  DIM sKey AS String

  sKey = tvwProject.Key

  IF sKey THEN
    IF CanEdit(sKey) THEN
      IF $bCtrl THEN
        tvwProject.Item.MoveParent
        IF tvwProject.Item.Key = Project.KEY_FORM THEN
          sKey = Left(sKey, -5) & ".class"
        ENDIF
      ENDIF
      Project.OpenFile(sKey)
    ENDIF
  ENDIF

END


PUBLIC SUB mnuEditFile_Click()

  tvwProject_Activate()

END


PUBLIC SUB mnuEditClass_Click()

  $bCtrl = TRUE
  tvwProject_Activate()

END



PUBLIC SUB mnuAddModule_Click()

  InsertFile("module")

END

PUBLIC SUB mnuAddClass_Click()

  InsertFile("class")

END

PUBLIC SUB mnuAddForm_Click()

  InsertFile("form")

END

PUBLIC SUB mnuQuit_Click()

  ME.Close

END

PRIVATE SUB InsertFile(sType AS String)

  DIM sDir AS String
  DIM sPath AS String

  SELECT CASE sType

    CASE "class"
      IF FNewClass.Run() THEN RETURN
      Project.Insert(FNewClass.Name, sType, FNewClass.Template)
      IF FNewClass.Startup THEN Project.DefineStartup(FNewClass.Name & ".class")

    CASE "form"
      IF FNewForm.Run() THEN RETURN
      Project.Insert(FNewForm.Name, "class", FNewForm.TemplateClass, TRUE)
      Project.Insert(FNewForm.Name, "form", FNewForm.TemplateForm)
      IF FNewForm.Startup THEN Project.DefineStartup(FNewForm.Name & ".form")

    CASE "module"
      IF FNewModule.Run() THEN RETURN
      Project.Insert(FNewModule.Name, sType, FNewModule.Template)
      IF FNewModule.Startup THEN Project.DefineStartup(FNewModule.Name & ".module")

  END SELECT

  Project.RefreshLibrary

END


PUBLIC SUB mnuCompile_Click()

  Project.Compile()

END


PUBLIC SUB mnuCompileAll_Click()

  Project.Compile(TRUE)

END


PUBLIC SUB mnuRun_Click()

  Project.Run(FALSE)

END

PUBLIC SUB mnuDebug_Click()

  Project.Run(FALSE, 1)

END


PUBLIC SUB mnuSave_Click()

  Project.Save

END


PUBLIC SUB mnuSaveFile_Click()

  DIM sPath AS String
  DIM hForm AS Object

  sPath = GetCurrent()
  IF NOT sPath THEN RETURN

  hForm = Project.Files[sPath]
  IF NOT hForm THEN RETURN

  hForm.Save

END


PUBLIC SUB mnuRefresh_Click()

  Project.Refresh

END


PUBLIC SUB mnuView_Show()

  'mnuViewTool.Checked = Project.ToolForm.Visible
  'mnuViewProperty.Checked = Project.PropertyForm.Visible
  'mnuViewMessage.Checked = Project.MessageForm.Visible

END


PRIVATE SUB HideOrShow(hForm AS Form)

  'PRINT "FMain.HideOrShow: ": hForm.Name
  hForm.Show 'NOT hForm.Visible

END


PUBLIC SUB mnuViewTool_Click()

  HideOrShow(FToolBox)

END


PUBLIC SUB mnuViewProperty_Click()

  HideOrShow(FProperty)

END


PUBLIC SUB mnuViewMessage_Click()

  HideOrShow(Project.MessageForm)

END


PUBLIC SUB mnuViewExplorer_Click()

  HideOrShow(FExplorer)

END


PUBLIC SUB mnuExec_Click()

  Project.MakeExecutable

END


PUBLIC SUB mnuAbout_Click()

  FAbout.Run

END


PUBLIC SUB mnuNew_Click()

  Project.NewProject

END

PUBLIC SUB mnuProperty_Click()

  IF FPropertyProject.Run() THEN RETURN
  'Project.WriteProject

END


'PUBLIC SUB mnuPrev_Click()
'
'  tvwProject.Current
'  PRINT Project.GetPreviousEditor(tvwProject.Item.Text)
'
'END

'PUBLIC SUB mnuNext_Click()
'
'  tvwProject.Current
'  PRINT Project.GetNextEditor(tvwProject.Item.Text)
'
'END


PUBLIC SUB mnuDeleteFile_Click()

  DIM sPath AS String
  DIM sName AS String

  sPath = GetCurrent()
  IF NOT sPath THEN RETURN

  IF IsDir(sPath) THEN

    IF Message.Question(Project.StripPath(sPath) & "\n\n" & ("Do you really want to delete this directory ?"), ("Delete"), ("Cancel")) <> 1 THEN RETURN
    Project.DeleteDir(sPath)
    Project.Refresh

  ELSE

    IF Project.IsClassName(sPath) THEN
      sName = File.BaseName(sPath)
    ELSE
      sName = File.Name(sPath)
    ENDIF

    IF Message.Delete(sName & "\n\n" & ("Do you really want to delete this file ?"), ("Delete"), ("Cancel")) <> 1 THEN RETURN

    Project.DeleteFile(sPath)

  ENDIF

CATCH

  Message.Error(("Cannot delete file or directory") & "\n\n" & Error.Text)

END


PUBLIC SUB mnuRenameFile_Click()

  DIM sPath AS String

  sPath = GetCurrent()
  IF NOT sPath THEN RETURN

  Project.RenameFile(sPath)

END


PUBLIC SUB mnuPreferences_Click()

  FOption.Run

END

PUBLIC SUB tvwProject_Menu()

  mnuPopup.Popup

END


PRIVATE FUNCTION GetCurrent() AS String

  $sKey = ""
  IF NOT tvwProject.Key THEN RETURN
  IF NOT tvwProject.Current.Selected THEN RETURN
  $sKey = tvwProject.Key
  IF Left$($sKey) = "$" THEN RETURN
  IF IsProject($sKey) THEN RETURN
  RETURN $sKey

END


PRIVATE FUNCTION GetCurrentDir() AS String

  GetCurrent
  IF NOT $sKey THEN RETURN
  IF $sKey = Project.KEY_MISC THEN RETURN Project.Dir
  IF Left$($sKey) = "$" THEN RETURN

  IF IsDir($sKey) THEN
    RETURN $sKey
  ELSE
    RETURN File.Dir($sKey)
  ENDIF

END


PUBLIC SUB mnuPopup_Show()

  DIM sCurrent AS String
  DIM bCurrent AS Boolean
  DIM bFile AS Boolean

  sCurrent = GetCurrent()
  bCurrent = sCurrent

  UpdateMenu

  mnuSaveFile.Visible = mnuSave.Visible AND CanEdit(sCurrent)
  mnuRenameFile.Visible = mnuRenameFile.Visible AND bCurrent
  mnuSepRenameFile.Visible = mnuRenameFile.Visible OR mnuSaveFile.Visible

  mnuDeleteFile.Visible = mnuDeleteFile.Visible AND CanDelete(sCurrent)
  mnuSepDeleteFile.Visible = mnuDeleteFile.Visible

  mnuEditFile.Visible = CanEdit(sCurrent)
  mnuEditForm.Visible = mnuEditFile.Visible
  mnuEditClass.Visible = mnuEditFile.Visible
  mnuPropertyFile.Enabled = bCurrent OR IsProject($sKey)

  mnuStartup.Visible = mnuStartup.Visible AND Project.IsClassName(sCurrent)
  IF mnuStartup.Visible THEN
    mnuStartup.Checked = (Project.Startup = File.BaseName(sCurrent))
  ENDIF

  bFile = (NOT Project.IsClassName(sCurrent)) AND bCurrent
  mnuCut.Visible = mnuCut.Visible AND (bFile AND NOT IsDir($sKey))
  mnuCopy.Visible = mnuCopy.Visible AND (bFile AND NOT IsDir($sKey))
  mnuPaste.Visible = mnuPaste.Visible AND (bFile OR $sKey = Project.KEY_MISC) AND Clipboard.Format = FILE_CLIPBOARD_FORMAT

  mnuAddForm.Visible = Project.AllowForm()

  IF Right(sCurrent, 5) = ".form" THEN
    mnuEditFile.Visible = FALSE
    'mnuEditForm.Visible = TRUE
    'mnuEditClass.Visible = TRUE
  ELSE
    'mnuEditFile.Visible = TRUE
    mnuEditForm.Visible = FALSE
    mnuEditClass.Visible = FALSE
    'mnuEditFile.Picture = tvwProject.Item.Picture
  ENDIF

END


PRIVATE FUNCTION FormatFile(sPath AS String) AS String

  DIM sText AS String

  sText = File.Name(sPath)

  IF Left$(sPath, Len(System.Home)) = System.Home THEN
    sPath = "~" &/ Mid$(sPath, Len(System.Home) + 1)
  ENDIF

  RETURN sText & "  (" & File.Dir(sPath) & ")"

END


PUBLIC SUB UpdateRecentMenu()

  DIM hMenu AS Menu
  DIM iInd AS Integer
  DIM sPath AS String

  mnuOpenRecent.Children.Clear
  mnuOpenRecent.Enabled = Project.Recent.Count > 0

  IF Project.Recent.Count = 0 THEN RETURN

  hMenu = NEW Menu(mnuOpenRecent) AS "mnuClearRecent"
  hMenu.Text = ("&Clear history")
  hMenu.Picture = Picture["img/16/delete.png"]

  hMenu = NEW Menu(mnuOpenRecent)

  FOR iInd = 0 TO Project.Recent.Count - 1
    hMenu = NEW Menu(mnuOpenRecent) AS "mnuOpenRecentFile"
    sPath = Project.Recent[iInd]
    hMenu.Tag = sPath
    hMenu.Text = FormatFile(sPath)
    hMenu.Picture = Project.GetIcon(hMenu.Tag, 16)
  NEXT

END


PUBLIC SUB UpdateExampleMenu()

  DIM hMenu AS Menu
  DIM aList AS String[]
  DIM iInd AS Integer
  DIM sPath AS String
  DIM sParent AS String
  DIM sDir AS String
  DIM hParent AS Menu

  aList = Project.GetExamples()

  mnuOpenExample.Children.Clear
  mnuOpenRecent.Enabled = aList.Count > 0

  hParent = mnuOpenExample

  IF aList.Count = 0 THEN RETURN

  FOR iInd = 0 TO aList.Count - 1
    sPath = aList[iInd]

    IF Instr(sPath, "/") THEN
      sDir = File.Dir(sPath)
      IF sDir <> sParent THEN
        sParent = sDir
        hParent = NEW Menu(mnuOpenExample)
        hParent.Text = sParent
      ENDIF
    ELSE
      hParent = mnuOpenExample
      sParent = ""
    ENDIF

    hMenu = NEW Menu(hParent) AS "mnuOpenRecentFile"
    hMenu.Tag = Project.EXAMPLES_DIR &/ sPath
    hMenu.Text = File.Name(sPath) 'FormatFile(sPath)
    hMenu.Picture = Project.GetIcon(hMenu.Tag, 16)

  NEXT

END


PUBLIC SUB mnuOpenRecentFile_Click()

  Project.Open(LAST.Tag)
  UpdateRecentMenu

END


PUBLIC SUB mnuClearRecent_Click()

  Project.Recent.Clear
  UpdateRecentMenu

END



PUBLIC SUB mnuNewProject_Click()

  DIM sPath AS String

  sPath = FNewProject.Run()
  IF NOT sPath THEN RETURN

  Project.Open(sPath)
  UpdateRecentMenu

END

PUBLIC SUB mnuMakePackage_Click()

  Project.MakePackage

END

PUBLIC SUB mnuTip_Click()

  FTips.Run

END

PUBLIC SUB mnuStep_Click()

  Project.Run(FALSE, 2)

END

PUBLIC SUB mnuViewGambas_Click()

  HideOrShow(FGambas)

END

PUBLIC SUB mnuAddIcon_Click()

  IF FNewIcon.Run(GetCurrentDir()) THEN RETURN
  Project.InsertFile(FNewIcon.Name, FNewIcon.DestDir, FNewIcon.Template)

END


PUBLIC SUB mnuAddText_Click()

  IF FNewText.Run(GetCurrentDir()) THEN RETURN
  Project.InsertFile(FNewText.Name, FNewText.DestDir, FNewText.Template)

END


PUBLIC SUB mnuAddDirectory_Click()

  IF FNewDirectory.Run(GetCurrentDir()) THEN RETURN
  Project.InsertDirectory(FNewDirectory.ParentDir &/ FNewDirectory.Name)

END


PRIVATE FUNCTION CanEdit(sPath AS String) AS Boolean

  IF NOT sPath THEN RETURN
  IF Left$(sPath) = "$" THEN RETURN
  RETURN NOT IsDir(sPath)

END


PRIVATE FUNCTION CanDelete(sPath AS String) AS Boolean

  IF NOT sPath THEN RETURN
  IF Left$(sPath) = "$" THEN RETURN
  RETURN tvwProject[sPath].Count = 0

END


PUBLIC SUB UpdateTranslate()

  mnuTranslate.Enabled = Project.Localize
  btnTranslate.Enabled = mnuTranslate.Enabled

END

PUBLIC SUB mnuTranslate_Click()

  IF Project.Running THEN RETURN
  IF Project.Compile() THEN RETURN
  FTranslate.Run

END


PUBLIC SUB mnuDatabaseManager_Click()

  Project.RunTool("gambas-database-manager")

END

PUBLIC SUB mnuViewConsole_Click()

  HideOrShow(FOutput)
  FOutput.Shown = FOutput.Visible

END


PUBLIC SUB mnuStartup_Click()

  IF mnuStartup.Checked THEN RETURN
  mnuStartup.Checked = TRUE
  Project.DefineStartup(GetCurrent())

END


PUBLIC SUB mnuPropertyFile_Click()

  DIM sKey AS String

  sKey = GetCurrent()
  IF IsProject($sKey) THEN
    FPropertyProject.Run
  ELSE
    FPropertyFile.Run(sKey)
  ENDIF

END


PRIVATE FUNCTION IsProject(sKey AS String) AS Boolean

  RETURN sKey = Project.Dir

END


PUBLIC SUB mnuCopy_Click()

  DIM sPath AS String

  sPath = GetCurrent()
  Clipboard.Copy("C" & sPath, FILE_CLIPBOARD_FORMAT)

  mnuPopup_Show

END


PUBLIC SUB mnuCut_Click()

  DIM sPath AS String

  sPath = GetCurrent()
  Clipboard.Copy("X" & sPath, FILE_CLIPBOARD_FORMAT)

END


PUBLIC SUB mnuPaste_Click()

  DIM sFile AS String
  DIM sAction AS String
  DIM sSrc AS String
  DIM sDst AS String

  sFile = Clipboard.Paste(FILE_CLIPBOARD_FORMAT)
  sAction = Left$(sFile)
  sSrc = Mid$(sFile, 2)
  sDst = GetCurrentDir() &/ File.Name(sFile)

  SELECT CASE sAction

    CASE "C"
      Project.CopyFile(sSrc, sDst)

    CASE "X"
      IF sSrc = sDst THEN RETURN
      Project.MoveFile(sSrc, sDst)
      Clipboard.Clear

  END SELECT

END

PUBLIC SUB tvwProject_Select()

  mnuPopup_Show

END

PUBLIC SUB tvwProject_Expand()

  IF tvwProject.Item.Picture = Picture["img/16/close.png"] THEN
    tvwProject.Item.Picture = Picture["img/16/open.png"]
  ENDIF

END

PUBLIC SUB tvwProject_Collapse()

  IF tvwProject.Item.Picture = Picture["img/16/open.png"] THEN
    tvwProject.Item.Picture = Picture["img/16/close.png"]
  ENDIF

END

PUBLIC SUB mnuCloseAll_Click()

  Project.CloseAll

END

PUBLIC SUB mnuFrom_Click()

  Project.Run(FALSE, 3)

END

PUBLIC SUB mnuViewIconTool_Click()

  IF Project.ActiveForm THEN
    IF Object.Type(Project.ActiveForm) = "FIconEditor" THEN
      FIconTool.Raise
    ENDIF
  ENDIF

END

PUBLIC SUB mnuViewStack_Click()

  HideOrShow(FFormStack)

END

PUBLIC SUB mnuMakeInstall_Click()

  Project.MakeInstall

END

PUBLIC SUB ReadConfig()

'   DIM hFont AS Font
'
'   IF Settings["/UseSmallFont", FALSE] THEN
'     hFont = Font["8"]
'   ELSE
'     hFont = Font["10"]
'   ENDIF
'
'   tvwProject.Font = hFont

  'PRINT Desktop.Resolution;;Application.Font.ToString()
  'PRINT tvwProject.Font.Size;;Application.Font.Size
  tvwProject.Font.Size = If(Settings["/UseSmallFont", FALSE], 8.0, Application.Font.Size)
  lblMessage.Font = tvwProject.Font

END

PUBLIC SUB mnuViewDebug_Click()

  HideOrShow(FDebugInfo)

END

PRIVATE SUB UpdateMenu()

  DIM bVisible AS Boolean

  bVisible = NOT (Project.ReadOnly OR Project.Running)

  mnuExec.Visible = bVisible
  mnuMakeInstall.Visible = bVisible
  mnuTranslate.Visible = bVisible
  mnuSepTranslate.Visible = bVisible
  btnTranslate.Visible = bVisible
  mnuCompile.Visible = bVisible
  btnCompile.Visible = bVisible
  mnuCompileAll.Visible = bVisible
  btnCompileAll.Visible = bVisible
  mnuSepCompile.Visible = bVisible
  mnuSave.Visible = bVisible
  mnuSepSave.Visible = bVisible
  btnSave.Visible = bVisible
  mnuProperty.Visible = bVisible
  btnProperty.Visible = bVisible

  mnuAddFile.Visible = bVisible
  mnuStartup.Visible = bVisible
  mnuSaveFile.Visible = bVisible
  mnuRenameFile.Visible = bVisible
  mnuSepRenameFile.Visible = bVisible
  mnuCut.Visible = bVisible
  mnuCopy.Visible = bVisible
  mnuPaste.Visible = bVisible
  mnuDeleteFile.Visible = bVisible
  mnuSepDeleteFile.Visible = bVisible

END


PUBLIC SUB OnProjectChange()

  UpdateMenu
  UpdateTranslate

END


PUBLIC SUB OnProjectDebug()

  UpdateMenu

END



PUBLIC SUB tvwProject_MouseDown()

  $bCtrl = Mouse.Control

END