[Gambas-user] Some Little Patch

fabien Bodard arcalis.prod at ...11...
Sat Apr 29 18:27:32 CEST 2006


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
-------------- next part --------------
' 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

-------------- next part --------------
# 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
  }
}
-------------- next part --------------
A non-text attachment was scrubbed...
Name: FSubs.class
Type: application/x-java
Size: 1886 bytes
Desc: not available
URL: <http://lists.gambas-basic.org/pipermail/user/attachments/20060429/2299262b/attachment.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: capture5.png
Type: image/png
Size: 114110 bytes
Desc: not available
URL: <http://lists.gambas-basic.org/pipermail/user/attachments/20060429/2299262b/attachment.png>


More information about the User mailing list