project.module

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

  IF hForm THEN
    hForm.Delete
    Files[sPath] = NULL
  ENDIF

  TRY ProjectTree.Remove(sPath)

  TRY KILL sPath & "~"
  TRY RENAME sPath AS 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

  RENAME sPath AS 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 Lock() AS Boolean

  IF Application.Busy THEN RETURN TRUE
  INC Application.Busy
  'PRINT "Lock"

END

PRIVATE SUB UnLock()

  DEC Application.Busy
  'PRINT "Unlock"

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

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

END


PUBLIC FUNCTION CheckProjectName(sName AS String, OPTIONAL sDir AS String) AS Boolean

  DIM iInd AS Integer

  IF NOT sName THEN
    Message.Warning(("Please type a project name."))
    RETURN TRUE
  ENDIF

  FOR iInd = 1 TO Len(sName)

    IF Instr(" .?*", Mid$(sName, iInd, 1)) OR Asc(Mid$(sName, iInd, 1)) > 127 THEN
      Message.Warning(("Forbidden characters in project name."))
      RETURN TRUE
    ENDIF

  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 = System.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

  Types = NEW String[]

  FOR EACH sLib IN Libraries
    IF NOT CComponent.All.Exist(sLib) THEN CONTINUE
    WITH CComponent.All[sLib]
      .Load
      IF .Type THEN
        IF Types.Find(.Type) < 0 THEN Types.Add(.Type)
      ENDIF
    END WITH
  NEXT

  FToolBox.RefreshToolbar
  FCompletion.RefreshLibrary
  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)
  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)

  RENAME sSrc AS 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 Types.Find("Form") >= 0

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)

  IF FMain.X < (Desktop.W \ 2) THEN
    hForm.Move(Int(Rnd(FMain.X + FMain.W + 8, Desktop.Width - hForm.Width - 8)), Int(Rnd(0, Desktop.Height - hForm.Height)))
  ELSE
    hForm.Move(Int(Rnd(0, FMain.X - hForm.Width - 8)), Int(Rnd(0, Desktop.Height - hForm.Height)))
  ENDIF

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)
      hImage = NEW Image
      TRY hImage.Load(sPath)
      IF ERROR THEN hImage = NULL
      BREAK
    ENDIF
  WEND

  CLOSE #hFile

FINALLY

  IF NOT hImage THEN
    hImage = NEW Image
    hImage.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