From ronstk at ...124... Thu Apr 6 00:03:35 2006 From: ronstk at ...124... (ron) Date: Thu, 6 Apr 2006 00:03:35 +0200 Subject: [Gambas-devel] PRB: SUB myFunction(arguments AS String ) AS Collection works! Message-ID: <200604060003.36124.ronstk@...124...> Oops In my module I have a line as: PUBLIC SUB roGetProcInfo(sFile AS String, sSearch AS String) AS Collection In 1.9.28 it just compiles AND works. Now I imported the file in a project on a box with 1.9.26 and I got a error on that line. it is used as: DIM cInfos AS Collection cInfos = NEW Collection cInfos = roGetProcInfo(sLink, sSymbol) In the class files you enter some information and this module extends the Help browser to show it. This can be user friendly for the components made in gambas to provide help during programming. Do you know after 6 months what the procedures and vars in that component has and how to use them ? The pages presented looks the same as the current internal help using a template file and you can edit to your own layout wishes. The question is about the SUB should be Function, some bug in gambas .28 compiler? Ron From gambas at ...1... Thu Apr 6 00:16:04 2006 From: gambas at ...1... (Benoit Minisini) Date: Thu, 6 Apr 2006 00:16:04 +0200 Subject: [Gambas-devel] gambas2 doesn't work In-Reply-To: <200603311608.34559.fasici@...451...> References: <200603311608.34559.fasici@...451...> Message-ID: <200604060016.04441.gambas@...1...> On Friday 31 March 2006 15:08, Fatih Asici wrote: > Hi, > > This error message appears when I want to run gambas2: > > fasici at ...452... ~ $ gambas2 > ERROR: #2: Cannot load class 'Project': Unable to load class file > > I thought it might be a problem with the Turkish locale. In the earlier > versions of gambas, there was a problem because of localized functions and > it couldn't load class file. So, I tried to run gambas with: > > LC_ALL=en_US gambas2 > > But it gave the same error. > > Gambas 1.0.15 runs properly. > > Regards, > Fatih Asici > Can you try with 'LANG=en_US LANGUAGE=en_US gambas2' instead? -- Benoit Minisini From fasici at ...451... Thu Apr 6 08:25:56 2006 From: fasici at ...451... (Fatih =?utf-8?q?A=C5=9F=C4=B1c=C4=B1?=) Date: Thu, 6 Apr 2006 09:25:56 +0300 Subject: [Gambas-devel] gambas2 doesn't work In-Reply-To: <200604060016.04441.gambas@...1...> References: <200603311608.34559.fasici@...451...> <200604060016.04441.gambas@...1...> Message-ID: <200604060925.56869.fasici@...451...> Per?embe 6 Nisan 2006 01:16 tarihinde, Benoit Minisini ?unlar? yazm??t?: > > Can you try with 'LANG=en_US LANGUAGE=en_US gambas2' instead? I have found the problem. It gives error messages during installation: Installing the development environment... Compiling gambas2... /var/tmp/pisi/gambas2-1.9.28-1/work/gambas2-1.9.28/app/src/gambas2/FOutput.class:11: Unknown identifier: Settings Compiling gambas-database-manager... /var/tmp/pisi/gambas2-1.9.28-1/work/gambas2-1.9.28/app/src/gambas-database-manager/FRequest.class:303: Unknown identifier: Settings (...) Compiling Database/Database/... /usr/share/gambas2/examples/Database/Database/FTest.class:30: Unknown identifier: DataSource (...) Despite the compilation errors, it continued installation. So I could not realize the errors. I will try to understand the reasons of errors. Regards, Fatih Asici From fasici at ...451... Thu Apr 6 18:42:56 2006 From: fasici at ...451... (Fatih Asici) Date: Thu, 6 Apr 2006 19:42:56 +0300 Subject: [Gambas-devel] gambas2 doesn't work In-Reply-To: <200604060925.56869.fasici@...451...> References: <200603311608.34559.fasici@...451...> <200604060016.04441.gambas@...1...> <200604060925.56869.fasici@...451...> Message-ID: <200604061942.56625.fasici@...451...> Per?embe 6 Nisan 2006 09:25 tarihinde, Fatih A??c? ?unlar? yazm??t?: > > Installing the development environment... > Compiling gambas2... > /var/tmp/pisi/gambas2-1.9.28-1/work/gambas2-1.9.28/app/src/gambas2/FOutput. >class:11: Unknown identifier: Settings Compiling gambas-database-manager... > /var/tmp/pisi/gambas2-1.9.28-1/work/gambas2-1.9.28/app/src/gambas-database- >manager/FRequest.class:303: Unknown identifier: Settings > > (...) > > Compiling Database/Database/... > /usr/share/gambas2/examples/Database/Database/FTest.class:30: Unknown > identifier: DataSource > > (...) Hi, Using DESTDIR instead of ROOT with "make install" solved this problem. Thanks, Fatih Asici From peter.moers at ...176... Sun Apr 9 00:33:10 2006 From: peter.moers at ...176... (Peter Moers) Date: Sun, 9 Apr 2006 00:33:10 +0200 Subject: [Gambas-devel] easier component development Message-ID: <6cb911930604081533n223d58acr78e96008555020e8@...178...> hi, I've been trying things out with gambas the last few days and now I want to write a component. Unfortunatly I can't get it working at all, all those configure files etc. One usefull thing would be an archive you can extract to the folder of the component you want to make with a very basic well documented component: one method, one property,... In the archive can be put a script file that asks for a name for the new component and edits all nessecary files to make the basic component compile and work. Let's say a quick start :). I'm sure I'm not the only one that would be happy with a thing like that :). Regards, -- Peter Moers peter.moers at ...453... Divides Webdesign - http://www.divides.be Startpagina - http://www.321start.be From gambas at ...1... Sun Apr 9 01:02:46 2006 From: gambas at ...1... (Benoit Minisini) Date: Sun, 9 Apr 2006 01:02:46 +0200 Subject: [Gambas-devel] easier component development In-Reply-To: <6cb911930604081533n223d58acr78e96008555020e8@...178...> References: <6cb911930604081533n223d58acr78e96008555020e8@...178...> Message-ID: <200604090102.46669.gambas@...1...> On Sunday 09 April 2006 00:33, Peter Moers wrote: > hi, > > I've been trying things out with gambas the last few days and now I > want to write a component. Unfortunatly I can't get it working at all, > all those configure files etc. > > One usefull thing would be an archive you can extract to the folder of > the component you want to make with a very basic well documented > component: one method, one property,... > In the archive can be put a script file that asks for a name for the > new component and edits all nessecary files to make the basic > component compile and work. Let's say a quick start :). > > I'm sure I'm not the only one that would be happy with a thing like that > :). > > Regards, > > -- > Peter Moers > peter.moers at ...453... > Divides Webdesign - http://www.divides.be > Startpagina - http://www.321start.be > I know, I have to write a HOWTO for that. But I must work for my paid job these days, and I didn't have the time to start it... Stay tune... :-) Regards, -- Benoit Minisini From gambas at ...1... Sun Apr 9 01:05:57 2006 From: gambas at ...1... (Benoit Minisini) Date: Sun, 9 Apr 2006 01:05:57 +0200 Subject: [Gambas-devel] PRB: SUB myFunction(arguments AS String ) AS Collection works! In-Reply-To: <200604060003.36124.ronstk@...124...> References: <200604060003.36124.ronstk@...124...> Message-ID: <200604090105.57301.gambas@...1...> On Thursday 06 April 2006 00:03, ron wrote: > Oops > In my module I have a line as: > > PUBLIC SUB roGetProcInfo(sFile AS String, sSearch AS String) AS Collection > > In 1.9.28 it just compiles AND works. > > Now I imported the file in a project on a box with 1.9.26 and I got a error > on that line. This syntax (SUB instead of FUNCTION) only works since 1.9.28. Replace SUB by FUNCTION, and it should compile. > > it is used as: > DIM cInfos AS Collection > cInfos = NEW Collection > cInfos = roGetProcInfo(sLink, sSymbol) > > In the class files you enter some information and this module extends > the Help browser to show it. > This can be user friendly for the components made in gambas to > provide help during programming. > Do you know after 6 months what the procedures and vars in that component > has and how to use them ? Usually yes :-) If my identifiers are well named. > The pages presented looks the same as the current internal help using a > template file and you can edit to your own layout wishes. > > > The question is about the SUB should be Function, some bug in gambas .28 > compiler? > > Ron > Regards, -- Benoit Minisini From ronstk at ...124... Sun Apr 9 03:25:11 2006 From: ronstk at ...124... (ron) Date: Sun, 9 Apr 2006 03:25:11 +0200 Subject: [Gambas-devel] easier component development In-Reply-To: <200604090102.46669.gambas@...1...> References: <6cb911930604081533n223d58acr78e96008555020e8@...178...> <200604090102.46669.gambas@...1...> Message-ID: <200604090325.11985.ronstk@...124...> On Sunday 09 April 2006 01:02, Benoit Minisini wrote: > On Sunday 09 April 2006 00:33, Peter Moers wrote: > > hi, > > > > I've been trying things out with gambas the last few days and now I > > want to write a component. Unfortunatly I can't get it working at all, > > all those configure files etc. > > > > One usefull thing would be an archive you can extract to the folder of > > the component you want to make with a very basic well documented > > component: one method, one property,... > > In the archive can be put a script file that asks for a name for the > > new component and edits all nessecary files to make the basic > > component compile and work. Let's say a quick start :). > > > > I'm sure I'm not the only one that would be happy with a thing like that > > :). > > > > Regards, > > > > -- > > Peter Moers > > peter.moers at ...453... > > Divides Webdesign - http://www.divides.be > > Startpagina - http://www.321start.be > > > > I know, I have to write a HOWTO for that. But I must work for my paid job > these days, and I didn't have the time to start it... > > Stay tune... :-) > > Regards, > There is a TEMPLATE directory in the gambas source tree. Explanation and a script to start with. Ron From Vince.Scott at ...440... Mon Apr 10 15:53:16 2006 From: Vince.Scott at ...440... (Scott, Vince) Date: Mon, 10 Apr 2006 08:53:16 -0500 Subject: [Gambas-devel] easier component development Message-ID: What I am planning on doing, once Benoit writes the code for the simple "Hello World" component and gets it to me :-), is to develop a Wizard that will create ALL the basic files required for building a component. I have gotten a component created by hand but I don't understand the next steps to communicating from Gambas to the component. I can see it in my library so I know all the basics are there. Vince -----Original Message----- From: gambas-devel-admin at lists.sourceforge.net [mailto:gambas-devel-admin at lists.sourceforge.net] On Behalf Of ron Sent: Saturday, April 08, 2006 8:25 PM To: gambas-devel at lists.sourceforge.net Subject: Re: [Gambas-devel] easier component development On Sunday 09 April 2006 01:02, Benoit Minisini wrote: > On Sunday 09 April 2006 00:33, Peter Moers wrote: > > hi, > > > > I've been trying things out with gambas the last few days and now I > > want to write a component. Unfortunatly I can't get it working at all, > > all those configure files etc. > > > > One usefull thing would be an archive you can extract to the folder of > > the component you want to make with a very basic well documented > > component: one method, one property,... > > In the archive can be put a script file that asks for a name for the > > new component and edits all nessecary files to make the basic > > component compile and work. Let's say a quick start :). > > > > I'm sure I'm not the only one that would be happy with a thing like that > > :). > > > > Regards, > > > > -- > > Peter Moers > > peter.moers at ...453... > > Divides Webdesign - http://www.divides.be > > Startpagina - http://www.321start.be > > > > I know, I have to write a HOWTO for that. But I must work for my paid job > these days, and I didn't have the time to start it... > > Stay tune... :-) > > Regards, > There is a TEMPLATE directory in the gambas source tree. Explanation and a script to start with. Ron ------------------------------------------------------- This SF.Net email is sponsored by xPML, a groundbreaking scripting language that extends applications into web and mobile media. Attend the live webcast and join the prime developer group breaking into this new coding territory! http://sel.as-us.falkag.net/sel?cmd=lnk&kid=110944&bid=241720&dat=121642 _______________________________________________ Gambas-devel mailing list Gambas-devel at lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/gambas-devel This communication is confidential and may be legally privileged. If you are not the intended recipient, (i) please do not read or disclose to others, (ii) please notify the sender by reply mail, and (iii) please delete this communication from your system. Failure to follow this process may be unlawful. Thank you for your cooperation. From dcamposf at ...176... Thu Apr 13 13:27:33 2006 From: dcamposf at ...176... (Daniel Campos) Date: Thu, 13 Apr 2006 13:27:33 +0200 Subject: [Gambas-devel] Little bug in examples Message-ID: <7259b5ae0604130427u6fa15f7clcf8cc78c8514c7a9@...178...> Hi Benoit: The "Clock" example shows the window border when running on Metacity, you should put the "Border=None" property in FClock form. Daniel -------------- next part -------------- An HTML attachment was scrubbed... URL: From ronstk at ...124... Fri Apr 14 05:57:40 2006 From: ronstk at ...124... (ron) Date: Fri, 14 Apr 2006 05:57:40 +0200 Subject: [Gambas-devel] Bug Sidepanel Message-ID: <200604140557.41143.ronstk@...124...> After add a tooltip to the sidebar. When mouse above the bar for sizing and the tooltip is visible moving the mouse into the sidebar area and do a mouse down the sidebar goes to hidden state( the resizebar with buttons only). The click/down on the resize bar also collapse sidebar. In my trial the sidebar has one columnview control in the space. If tooltip not visible it does not collapse. Moving the mouse into sidebar space the tooltip stay visible but does not follow mouse and moving outside the area the tooltip disapears. Also the SideBar1_Hide event only fires on going to hidden state and is fired after it has become true (object.hidden=true) It should fire on change of the state because the content of the sidebar must/need be updated on comming visible again. My wish is to refresh a columnview with the files in the folder at the moment it becomes visible again. I do not need to update this for speed if in collapsed state but have no way to see if the content is visible again. --- Greetings Ron From arcalis.prod at ...4... Mon Apr 17 16:04:47 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Mon, 17 Apr 2006 16:04:47 +0200 Subject: [Gambas-devel] Bug on Gambas 1.9.28 Message-ID: <200604171604.47361.arcalis.prod@...4...> ' Gambas class file CREATE INHERITS collection PUBLIC SUB _new() DIM arg AS String DIM s AS String DIM ars AS NEW String[] arg = application.Env["QUERY_STRING"] arg = "titi=toto" FOR EACH s IN Split(arg, " ") ars = Split(s, "=") IF ars.Count > 1 THEN 'PRINT ars[0] SUPER[ars[0]] = ars[1] ENDIF NEXT END Try this ... it's not a segmentation fault but... It say not an array on the line : SUPER[ars[0]] = ars[1] It look to a problem of parsing. I cant write SUPER[s] = ars[1] But not put an array between braces. Regards, Fabien Bodard From arcalis.prod at ...4... Mon Apr 17 16:18:15 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Mon, 17 Apr 2006 16:18:15 +0200 Subject: [Gambas-devel] A little suggest Message-ID: <200604171618.15187.arcalis.prod@...4...> Hi Benoit, I need something : FOR EACH s IN Get PRINT Get.Key & "=" & s NEXT Where get is an autocreatable class but it seem that the _new special event was not fired when i use this in a for each expression. So actually i use,before, a workaround like : PRINT "titi" & "=" & Get["titi"] but it's not really pretty. Regards, Fabien Bodard From arcalis.prod at ...4... Mon Apr 17 17:07:31 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Mon, 17 Apr 2006 17:07:31 +0200 Subject: [Gambas-devel] Problem with WRITE Message-ID: <200604171707.31718.arcalis.prod@...4...> This is the code : DIM hresult AS Result DIM s AS String DIM hField AS ResultField hcon.Login = "root" hcon.Host = "localhost" hcon.Type = "mysql" hcon.Name = "gambasforge" hcon.open 'form1.show PRINT "Content-type: text/html" PRINT PRINT File.Load("html") Post["table"] = "users" PRINT "" & post["table"] & "

" IF NOT IsNull(Post["table"]) THEN 'PRINT Subst("SELECT * FROM users", Post["table"]) hresult = db.Exec("SELECT * FROM " & Post["table"]) PRINT "" FOR EACH hfield IN hResult.Fields WRITE Subst("", hField.Name) NEXT PRINT "" FOR EACH hResult PRINT "" FOR EACH hField IN hResult.Fields WRITE Subst("", hResult[hField.Name]) NEXT PRINT "" NEXT PRINT "
&1
&1
" ENDIF This is what i get : Look between the i've some space ... some ')' and some ASC 10 and others..; i think it's not normal ! Am i wrong ?
users

))))) Regards, Fabien Bodard From arcalis.prod at ...4... Mon Apr 17 17:31:47 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Mon, 17 Apr 2006 17:31:47 +0200 Subject: [Gambas-devel] Pb with subst Message-ID: <200604171731.47296.arcalis.prod@...4...> hi benoit :) PRINT Subst("&1  (&2 entr?e(s))

", post["table"], hResult.count) give : userinfonbsp; (&249 entr?e(s)) Regards, Fabien Bodard From gambas at ...1... Mon Apr 17 18:23:49 2006 From: gambas at ...1... (Benoit Minisini) Date: Mon, 17 Apr 2006 18:23:49 +0200 Subject: [Gambas-devel] Pb with subst In-Reply-To: <200604171731.47296.arcalis.prod@...4...> References: <200604171731.47296.arcalis.prod@...4...> Message-ID: <200604171823.49989.gambas@...1...> On Monday 17 April 2006 17:31, fabien Bodard wrote: > hi benoit :) > > PRINT Subst("&1  (&2 entr?e(s))

", post["table"], > hResult.count) > > give : > > userinfonbsp; (&249 entr?e(s)) > > Regards, > > Fabien Bodard > Try this patch and tell me the result. I must backport it to the stable version. -- Benoit Minisini -------------- next part -------------- A non-text attachment was scrubbed... Name: gbx_string.c Type: text/x-csrc Size: 11850 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: gbx_subst.c Type: text/x-csrc Size: 1970 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: gbx_subst.h Type: text/x-objchdr Size: 1213 bytes Desc: not available URL: From gambas at ...1... Mon Apr 17 18:26:04 2006 From: gambas at ...1... (Benoit Minisini) Date: Mon, 17 Apr 2006 18:26:04 +0200 Subject: [Gambas-devel] Problem with WRITE In-Reply-To: <200604171707.31718.arcalis.prod@...4...> References: <200604171707.31718.arcalis.prod@...4...> Message-ID: <200604171826.04365.gambas@...1...> On Monday 17 April 2006 17:07, fabien Bodard wrote: > This is the code : > DIM hresult AS Result > DIM s AS String > DIM hField AS ResultField > hcon.Login = "root" > hcon.Host = "localhost" > hcon.Type = "mysql" > hcon.Name = "gambasforge" > hcon.open > 'form1.show > PRINT "Content-type: text/html" > PRINT > PRINT File.Load("html") > > Post["table"] = "users" > PRINT "" & post["table"] & "

" > IF NOT IsNull(Post["table"]) THEN > 'PRINT Subst("SELECT * FROM users", Post["table"]) > hresult = db.Exec("SELECT * FROM " & Post["table"]) > PRINT "
idusers creadate login passw email admin photoactivate
1 1100386859 gambix5d933eef19aee7da192608de61b6c23d abidoo.too at ...4... 2
2 1100386859 bidoo17fb812d2bf6cb65dc05fb45bdccbaea abidoo.too at ...4... 0
3 1100386859 lordheavyec15590a3d3a798d0382d84570f964e8 lordheavy at ...141... 1
4 1100386859 LaurentC04d8c425cc03ec3f918500848084a04f lordheavy at ...141... 0
5 1100386859 RGCook11ace34f612341c3da418085af222411 rgcook at ...456... 0
" > FOR EACH hfield IN hResult.Fields > WRITE Subst("", hField.Name) > NEXT > PRINT "" > FOR EACH hResult > PRINT "" > FOR EACH hField IN hResult.Fields > WRITE Subst("", hResult[hField.Name]) > NEXT > PRINT "" > NEXT > PRINT "
&1
&1
" > ENDIF > > > > > > This is what i get : > Look between the i've some space ... some ')' and some ASC 10 and > others..; i think it's not normal ! Am i wrong ? > > >
> > >
> users

> > > > > > > ) > > > > > > ) > > > > > > ) > > > > > > ) > > > > > > ) > > > > > > Regards, > > Fabien Bodard > Use PRINT instad of WRITE. WRITE is used for writing binary data (see the documentation). Regards, -- Benoit Minisini From gambas at ...1... Mon Apr 17 19:09:54 2006 From: gambas at ...1... (Benoit Minisini) Date: Mon, 17 Apr 2006 19:09:54 +0200 Subject: [Gambas-devel] Bug on Gambas 1.9.28 In-Reply-To: <200604171604.47361.arcalis.prod@...4...> References: <200604171604.47361.arcalis.prod@...4...> Message-ID: <200604171909.55097.gambas@...1...> On Monday 17 April 2006 16:04, fabien Bodard wrote: > ' Gambas class file > CREATE > INHERITS collection > > PUBLIC SUB _new() > DIM arg AS String > DIM s AS String > DIM ars AS NEW String[] > arg = application.Env["QUERY_STRING"] > arg = "titi=toto" > FOR EACH s IN Split(arg, " ") > ars = Split(s, "=") > IF ars.Count > 1 THEN > 'PRINT ars[0] > SUPER[ars[0]] = ars[1] > ENDIF > NEXT > > > END > > > Try this ... it's not a segmentation fault but... > It say not an array on the line : > SUPER[ars[0]] = ars[1] > > It look to a problem of parsing. I cant write SUPER[s] = ars[1] > > But not put an array between braces. > > Regards, > Fabien Bodard > OK. I fixed the bug! Try this patch... -- Benoit Minisini -------------- next part -------------- A non-text attachment was scrubbed... Name: gbx_exec.c Type: text/x-csrc Size: 30437 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: gbx_exec_loop.c Type: text/x-csrc Size: 35378 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: gbx_value.h Type: text/x-chdr Size: 4756 bytes Desc: not available URL: From gambasfr at ...4... Mon Apr 17 20:06:47 2006 From: gambasfr at ...4... (Fabien) Date: Mon, 17 Apr 2006 20:06:47 +0200 (CEST) Subject: [Gambas-devel] Problem with WRITE Message-ID: <23350826.1145297207370.JavaMail.www@...458...> > > > > Use PRINT instad of WRITE. WRITE is used for writing binary data (see the > documentation). So we have not anything like echo... that send something without linefeed. > > Regards, > > -- > Benoit Minisini > > > > ------------------------------------------------------- > This SF.Net email is sponsored by xPML, a groundbreaking scripting language > that extends applications into web and mobile media. Attend the live webcast > and join the prime developer group breaking into this new coding territory! > http://sel.as-us.falkag.net/sel?cmd=lnk&kid=110944&bid=241720&dat=121642 > _______________________________________________ > Gambas-devel mailing list > Gambas-devel at lists.sourceforge.net > https://lists.sourceforge.net/lists/listinfo/gambas-devel > > From lordheavy at ...141... Mon Apr 17 20:14:46 2006 From: lordheavy at ...141... (Laurent Carlier) Date: Mon, 17 Apr 2006 20:14:46 +0200 Subject: [Gambas-devel] Problem with WRITE In-Reply-To: <23350826.1145297207370.JavaMail.www@...458...> References: <23350826.1145297207370.JavaMail.www@...458...> Message-ID: <200604172014.46484.lordheavy@...141...> Le Lundi 17 Avril 2006 20:06, Fabien a ?crit?: > > Use PRINT instad of WRITE. WRITE is used for writing binary data (see the > > documentation). > > So we have not anything like echo... that send something without linefeed. > http://64.128.110.55/help/lang/print ? ----- print "my stuff"; print "other stuff" ----- -- jabber : lordheavy at ...298... mail : lordheavymREMOVEME at ...176... From gambas at ...1... Mon Apr 17 20:18:21 2006 From: gambas at ...1... (Benoit Minisini) Date: Mon, 17 Apr 2006 20:18:21 +0200 Subject: [Gambas-devel] Problem with WRITE In-Reply-To: <23350826.1145297207370.JavaMail.www@...458...> References: <23350826.1145297207370.JavaMail.www@...458...> Message-ID: <200604172018.22015.gambas@...1...> On Monday 17 April 2006 20:06, Fabien wrote: > > Use PRINT instad of WRITE. WRITE is used for writing binary data (see the > > documentation). > > So we have not anything like echo... that send something without linefeed. > PRINT xxxx; -- Benoit Minisini From gambas at ...1... Mon Apr 17 22:35:24 2006 From: gambas at ...1... (Benoit Minisini) Date: Mon, 17 Apr 2006 22:35:24 +0200 Subject: [Gambas-devel] Bug on Gambas 1.9.28 In-Reply-To: <200604171909.55097.gambas@...1...> References: <200604171604.47361.arcalis.prod@...4...> <200604171909.55097.gambas@...1...> Message-ID: <200604172235.25220.gambas@...1...> On Monday 17 April 2006 19:09, Benoit Minisini wrote: > On Monday 17 April 2006 16:04, fabien Bodard wrote: > > ' Gambas class file > > CREATE > > INHERITS collection > > > > PUBLIC SUB _new() > > DIM arg AS String > > DIM s AS String > > DIM ars AS NEW String[] > > arg = application.Env["QUERY_STRING"] > > arg = "titi=toto" > > FOR EACH s IN Split(arg, " ") > > ars = Split(s, "=") > > IF ars.Count > 1 THEN > > 'PRINT ars[0] > > SUPER[ars[0]] = ars[1] > > ENDIF > > NEXT > > > > > > END > > > > > > Try this ... it's not a segmentation fault but... > > It say not an array on the line : > > SUPER[ars[0]] = ars[1] > > > > It look to a problem of parsing. I cant write SUPER[s] = ars[1] > > > > But not put an array between braces. > > > > Regards, > > Fabien Bodard > > OK. I fixed the bug! Try this patch... Forget it, it does not work... -- Benoit Minisini From arcalis.prod at ...4... Mon Apr 17 23:40:59 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Mon, 17 Apr 2006 23:40:59 +0200 Subject: [Gambas-devel] Problem with WRITE In-Reply-To: <200604172018.22015.gambas@...1...> References: <23350826.1145297207370.JavaMail.www@...458...> <200604172018.22015.gambas@...1...> Message-ID: <200604172340.59237.arcalis.prod@...4...> Le Lundi 17 Avril 2006 20:18, Benoit Minisini a ?crit?: > On Monday 17 April 2006 20:06, Fabien wrote: > > > Use PRINT instad of WRITE. WRITE is used for writing binary data (see > > > the documentation). > > > > So we have not anything like echo... that send something without > > linefeed. > > PRINT xxxx; Another thing i haven't noticed ... gambas have many surprises ! From arcalis.prod at ...4... Tue Apr 18 22:24:40 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Tue, 18 Apr 2006 22:24:40 +0200 Subject: [Gambas-devel] Problem on saving executable where i want ! Message-ID: <200604182224.40690.arcalis.prod@...4...> hi Benoit, This is the corrected project.module file ... i've just change a little thing into the Make_Executable sub.. (add '& ".gambas" in the condition line for move the file). So now move a file work.... but i've alway a problem... I need to move the file into the cgi-bin path and i get this error when i remove the try on the line.... a suggest ? System error. Lien crois? de p?riph?riques invalide 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) 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(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 "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 & ".gambas" 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 From ronstk at ...124... Wed Apr 19 02:12:12 2006 From: ronstk at ...124... (ron) Date: Wed, 19 Apr 2006 02:12:12 +0200 Subject: [Gambas-devel] Problem on saving executable where i want ! (add wish) In-Reply-To: <200604182224.40690.arcalis.prod@...4...> References: <200604182224.40690.arcalis.prod@...4...> Message-ID: <200604190212.12541.ronstk@...124...> On Tuesday 18 April 2006 22:24, fabien Bodard wrote: > hi Benoit, > This is the corrected project.module file ... i've just change a little thing > into the Make_Executable sub.. (add '& ".gambas" in the condition line for > move the file). So now move a file work.... but i've alway a problem... I > need to move the file into the cgi-bin path and i get this error when i > remove the try on the line.... a suggest ? > > System error. Lien crois? de p?riph?riques invalide > > > Regards, > Fabien Bodard > 'FProperty.Show <--- 'FToolBox.Show <--- 'FFormStack.Load I have seen this before :) In my Project.module To Benoit, I think most of the time you are busy with coding and do not need the Toolbox at all and for the Property very less. May be others like it for the show, so a config option what the user wants is not a bad idea. TIA Ron From gambas at ...1... Fri Apr 21 00:54:22 2006 From: gambas at ...1... (Benoit Minisini) Date: Fri, 21 Apr 2006 00:54:22 +0200 Subject: [Gambas-devel] Release of gambas 1.9.29 Message-ID: <200604210054.23265.gambas@...1...> Hi, This release is intended to compile and run on FreeBSD, and other non-Linux systems that do not support ioctl(...,FIONREAD,...) on any file descriptor. It fixes many important bugs too: * SUPER keyword now should work in any case. * Auto-creatable classes now can be enumerated safely. * Subst() was rewritten and fixed, and will be backported to the stable version as soon as possible. * Val("") returns NULL now, and not a null date anymore. * Tooltips work correctly on view controls now. * Blob management was fixed in mysql driver. * Void lines in mails are correctly sent by the SMTP component now. See the ChangeLog for the other changes. I'm waiting information about problems on PowerPC before releasing a 1.0.16 version that will fix the Subst() function. Regards, -- Benoit Minisini From ronstk at ...124... Fri Apr 21 03:24:16 2006 From: ronstk at ...124... (ron) Date: Fri, 21 Apr 2006 03:24:16 +0200 Subject: [Gambas-devel] Database field name error. Message-ID: <200604210324.17119.ronstk@...124...> I have a table where one of the fields is named 'group' This table has no primary key as need by gambas. Using the database manager from gambas to add that key does not work. I get a error near ',group from tblname' The database is a mysql 4.xx db. Here is group interpreted as a reserved keyword from the 'group by' syntax. This as field name is allowed if the names of database, table and field names are between backticks. While in the past at my work the office people in exel made tables with those reserverd column names or even spaces in it I have the habbit always to use backticks on db, table and field names. I suggest to do it in the mysql driver to. Adding backticks does not harm but without them it does/can create errors for unexperiented people they do not understand. my 3 cents Ron From ronstk at ...124... Fri Apr 21 07:04:04 2006 From: ronstk at ...124... (ron) Date: Fri, 21 Apr 2006 07:04:04 +0200 Subject: [Gambas-devel] Question gb.db.Request Message-ID: <200604210704.05521.ronstk@...124...> I try to make program :) DIM Request as string Request ="id=" & useid IF usechar THEN Request = Request & " AND char=" $ usechar Somehow by accident i got the Completion comes up. As I understood for Request in the Completion it could be used to create a SQL line for the Connection.Exec() and made the next code DIM hConn as Connection hConn = new Connection ... setting the values DIM req AS Request req.Select("field1,field2") req.From("tblname") req.Where("id=" & useid) ... DIM hResult AS Result hResult=hConn.Exec(req) ' forget the Argument and remaining ... Browsing in the gb.db.form files while they are not documented yet. in srcfile DataCombo.class I found rData = DB.Exec(Request.Select([$sKey, sDisp]).From($sTable).Where($sFilter).Get()) Here the way Request is handled in different way the AutoCompletion suggest. Now I understand also the the meaning of .Get() more. However a Select is already meaning I want to Get the records. Then the .Get() must mean something else and I asume it means to Get from Request the complete SQL line in well formed fashion, I gues. With a look at other pages in gb.db I found -------- Connection.Edit (gb.db) Syntax FUNCTION Edit ( Table AS String [ , Request AS String, Arguments AS , ... ] ) AS Result Request is a SQL WHERE clause used for filtering the table. Request is here a string and looks to me the "id=123" case. For the Arguments should it not be FUNCTION Edit ( Table AS String [ , Request AS String [, Arguments AS , ... ] ] ) AS Result -------- Connection.Exec (gb.db) Syntax FUNCTION Exec ( Request AS String, Arguments AS , ... ) AS Result Request is a SQL WHERE clause used for filtering the table. Request must be here something like a full SQL line. Connection.Exec("id=123 and char=a") makes no sence to me. For 'Arguments AS', the same as noted for FUNCTION Edit. -------- Request is overall a very confusing word. (if the component gb.db.form is add) The way it is used in the DataCombo.class as given above looks nice to me. Note here also that 'Arguments AS' is not used so that must be optional. Can it be confirmed that rData = DB.Exec(Request.Select([$sKey, sDisp]).From($sTable).Where($sFilter).Get()) Is it the same as using a object Request, set the arguments/properties/methods and use it for case where only the field needs to change. DIM MyRequest AS Request MyRequest.Select("field1") MyRequest.From("table") MyRequest.Where("id=123") rData = DB(MyRequest.Get()) TIA from Ron From gambas at ...1... Tue Apr 25 05:57:45 2006 From: gambas at ...1... (Benoit Minisini) Date: Tue, 25 Apr 2006 05:57:45 +0200 Subject: [Gambas-devel] Re: a bug found. In-Reply-To: <200604242135.19917.lordheavy@...141...> References: <20060424092107.38281.qmail@...461...> <200604242110.44533.gambas@...1...> <200604242135.19917.lordheavy@...141...> Message-ID: <200604250557.45796.gambas@...1...> On Monday 24 April 2006 21:35, you wrote: > Le Lundi 24 Avril 2006 21:10, vous avez ?crit?: > > On Monday 24 April 2006 11:21, you wrote: > > > Dear sir Benoit, > > > > > > I am not sure if it is a bug.. > > > > > > I use Gambas2 Version 1.9.25 on linux Mandriva 2006 > > > > > > I created a project and made some layout on the form. after all has > > > been set, i am thinking to add a function to play for an audio file. > > > what i did is i go to Project-> Properties -> Components, and checked > > > the GB.SDL.SOUND... when i click Ok, the gb.form was detached from the > > > project. To solve the problem was checking the gb.form again on the > > > components window. > > > > > > Best Regards, > > > Erwin Diansay > > > > It seems that Laurent defined gb.sdl as excluding gb.qt and gb.gtk. > > Theorically, only gb.image and gb.opengl should exclude gb.qt and gb.gtk. > > > > What do you think Laurent ? > > Yes it's a bug :o > > In gb.sdl.component there is an exclude line, this one must be in > gb.sdl.image and gb.sdl.opengl instead ! > > Currently i've start a complete rewrite of the sdl component in c++, which > will give me a cleanup source code, and better features i hope :-) > > I don't know if the sdl.sound will be a separate component in the future > .... gstreamer/... component should be a better choice. > > Regards, I added two keywords in the component files: "Implement", that is a list of features implemented by a component. Each of these feature can be implemented by only one component. At the moment, the features are: - Form - EventLoop - ImageProvider - OpenGLViewer "Need", that is a list of features needed by a component. This way, the IDE can deal with component incompatibility correctly. Regards, -- Benoit Minisini From brian at ...418... Tue Apr 25 06:29:07 2006 From: brian at ...418... (Christopher Brian Jack) Date: Mon, 24 Apr 2006 21:29:07 -0700 (PDT) Subject: [Gambas-devel] Re: a bug found. In-Reply-To: <200604250557.45796.gambas@...1...> References: <20060424092107.38281.qmail@...461...> <200604242110.44533.gambas@...1...> <200604242135.19917.lordheavy@...141...> <200604250557.45796.gambas@...1...> Message-ID: <20060424212209.R53725@...419...> On Tue, 25 Apr 2006, Benoit Minisini wrote: > > > > I don't know if the sdl.sound will be a separate component in the future > > .... gstreamer/... component should be a better choice. > > I wonder if Audiere (http://audiere.sf.net) would be of any use here. Also a component to access libdumb (for playing tracker formats) might be nice to have too. Gambas might be a little slow for this but how about also a signal processing (DSP) type library that can do high speed audio effects perhaps using nyquist notation or a patch-based plugin system (by patched based meaning you literally build your audio path by combining "components" and connecting them including "source" components, "process" components such as splitters, filters, reverberators, combiners and such, and "sink" components representing output devices). .=================================================. | Christopher BRIAN Jack aka "Gau of the Veldt" | +=================================================' | brian _AT_ brians-anime _DOT_ com `=================================================- Hi Spambots, my email address is sputnik at ...418... From gambas at ...1... Wed Apr 26 23:00:23 2006 From: gambas at ...1... (Benoit Minisini) Date: Wed, 26 Apr 2006 23:00:23 +0200 Subject: [Gambas-devel] Question gb.db.Request In-Reply-To: <200604210704.05521.ronstk@...124...> References: <200604210704.05521.ronstk@...124...> Message-ID: <200604262300.23465.gambas@...1...> On Friday 21 April 2006 07:04, ron wrote: > I try to make program :) > > DIM Request as string > Request ="id=" & useid > IF usechar THEN Request = Request & " AND char=" $ usechar > > Somehow by accident i got the Completion comes up. > > As I understood for Request in the Completion it could be used > to create a SQL line for the Connection.Exec() and made the next code > > DIM hConn as Connection > hConn = new Connection > ... setting the values > > DIM req AS Request > req.Select("field1,field2") > req.From("tblname") > req.Where("id=" & useid) > ... > > DIM hResult AS Result > hResult=hConn.Exec(req) ' forget the Argument and remaining > ... > > > Browsing in the gb.db.form files while they are not documented yet. > in srcfile DataCombo.class I found > rData = DB.Exec(Request.Select([$sKey, > sDisp]).From($sTable).Where($sFilter).Get()) > > Here the way Request is handled in different way the AutoCompletion > suggest. Now I understand also the the meaning of .Get() more. > However a Select is already meaning I want to Get the records. > Then the .Get() must mean something else and I asume it means to Get from > Request the complete SQL line in well formed fashion, I gues. > > With a look at other pages in gb.db I found > -------- > Connection.Edit (gb.db) > Syntax > FUNCTION Edit ( Table AS String [ , Request AS String, Arguments AS , ... ] > ) AS Result Request is a SQL WHERE clause used for filtering the table. > Request is here a string and looks to me the "id=123" case. > > For the Arguments should it not be > FUNCTION Edit ( Table AS String [ , Request AS String [, Arguments AS , ... > ] ] ) AS Result -------- > Connection.Exec (gb.db) > Syntax > FUNCTION Exec ( Request AS String, Arguments AS , ... ) AS Result > Request is a SQL WHERE clause used for filtering the table. > > Request must be here something like a full SQL line. > Connection.Exec("id=123 and char=a") makes no sence to me. > For 'Arguments AS', the same as noted for FUNCTION Edit. > -------- > > Request is overall a very confusing word. (if the component gb.db.form is > add) The way it is used in the DataCombo.class as given above looks nice to > me. Note here also that 'Arguments AS' is not used so that must be > optional. > > > Can it be confirmed that > rData = DB.Exec(Request.Select([$sKey, > sDisp]).From($sTable).Where($sFilter).Get()) > > Is it the same as using a object Request, set the > arguments/properties/methods and use it for case where only the field needs > to change. > > DIM MyRequest AS Request > > MyRequest.Select("field1") > MyRequest.From("table") > MyRequest.Where("id=123") > rData = DB(MyRequest.Get()) > > > TIA from > > Ron > > The Request class should not be exported, this is a mistake I done. It should be internal to the gb.db.form component. This class is used for making SQL request. If you find it useful, maybe I could add this class to the gb.db.component. Regards, -- Benoit Minisini From gambas at ...1... Wed Apr 26 23:01:06 2006 From: gambas at ...1... (Benoit Minisini) Date: Wed, 26 Apr 2006 23:01:06 +0200 Subject: [Gambas-devel] Database field name error. In-Reply-To: <200604210324.17119.ronstk@...124...> References: <200604210324.17119.ronstk@...124...> Message-ID: <200604262301.06195.gambas@...1...> On Friday 21 April 2006 03:24, ron wrote: > I have a table where one of the fields is named 'group' > This table has no primary key as need by gambas. > Using the database manager from gambas to add that key > does not work. I get a error near ',group from tblname' > > The database is a mysql 4.xx db. > > Here is group interpreted as a reserved keyword from the > 'group by' syntax. > > This as field name is allowed if the names of > database, table and field names are between backticks. > > While in the past at my work the office people in exel made > tables with those reserverd column names or even spaces in it > I have the habbit always to use backticks on db, table and field names. > > I suggest to do it in the mysql driver to. > Adding backticks does not harm but without them it does/can > create errors for unexperiented people they do not understand. > > > my 3 cents > > Ron > > You are right, I should quoting field names everywhere. Regards, -- Benoit Minisini From ronstk at ...124... Thu Apr 27 07:18:54 2006 From: ronstk at ...124... (ron) Date: Thu, 27 Apr 2006 07:18:54 +0200 Subject: [Gambas-devel] Question gb.db.Request In-Reply-To: <200604262300.23465.gambas@...1...> References: <200604210704.05521.ronstk@...124...> <200604262300.23465.gambas@...1...> Message-ID: <200604270718.55635.ronstk@...124...> On Wednesday 26 April 2006 23:00, Benoit Minisini wrote: > On Friday 21 April 2006 07:04, ron wrote: > > I try to make program :) > > --8<-- > > Is it the same as using a object Request, set the > > arguments/properties/methods and use it for case where only the field needs > > to change. > > > > DIM MyRequest AS Request > > > > MyRequest.Select("field1") > > MyRequest.From("table") > > MyRequest.Where("id=123") > > rData = DB(MyRequest.Get()) > > > > > > TIA from > > > > Ron > > > > > > The Request class should not be exported, this is a mistake I done. It should > be internal to the gb.db.form component. > > This class is used for making SQL request. If you find it useful, maybe I > could add this class to the gb.db.component. > > Regards, > I do not dislike it at all and to promote it the gb.db.component was my idea to. It gives noobs a basic idiot proof to construct a query and can prevent misformated sql syntax for them. It is a pitty I lost my SQL Editor I was working on previous year, I have only the screenshots, where I did use something like this one to build and extract SQL lines, with qouting. I must have that part written with php on old windows box. Greets, Ron From ronstk at ...124... Thu Apr 27 08:48:59 2006 From: ronstk at ...124... (ron) Date: Thu, 27 Apr 2006 08:48:59 +0200 Subject: [Gambas-devel] Database field name error. In-Reply-To: <200604262301.06195.gambas@...1...> References: <200604210324.17119.ronstk@...124...> <200604262301.06195.gambas@...1...> Message-ID: <200604270848.59354.ronstk@...124...> On Wednesday 26 April 2006 23:01, Benoit Minisini wrote: > > I suggest to do it in the mysql driver to. > > Adding backticks does not harm but without them it does/can > > create errors for unexperiented people they do not understand. > > > > > > my 3 cents > > > > Ron > > > > > > You are right, I should quoting field names everywhere. > > Regards, > Thank you master of universe :) But a little warning. If the user uses COUNT(fielddname) it is fieldname that should be quoted. COUNT can be also SUM(), AVG(), MAX(), MIN(), CAT(filed1,field2) or even more complex formulas. I use for that SQL syntax always upercase with mysql. It could be easy for the quoting to require from the user to do it that way so only mixed or lowcase are the db,table or field names for quoting. SELECT MAX(`tbl1`.`field1`), `tblname2`.`field3` FROM `table1`, `table2` For mysql the qouting for database objects is backtick and for arguments it is single or double quote, this for the other readers. Consider for the Request class to use for .From(tbl as string) the same method as current used for fields. It is valid, at least for mysql, to use *FROM `table1`. `table2`* wich result in a join between the tables and done here by mysql. Ron From arcalis.prod at ...4... Sat Apr 29 18:27:32 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Sat, 29 Apr 2006 18:27:32 +0200 Subject: [Gambas-devel] Some Little Patch Message-ID: <200604291827.32380.arcalis.prod@...4...> 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: -------------- next part -------------- A non-text attachment was scrubbed... Name: capture5.png Type: image/png Size: 114110 bytes Desc: not available URL: From arcalis.prod at ...4... Sat Apr 29 18:42:47 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Sat, 29 Apr 2006 18:42:47 +0200 Subject: [Gambas-devel] Re: [Gambas-user] Some Little Patch In-Reply-To: <200604291827.32380.arcalis.prod@...4...> References: <200604291827.32380.arcalis.prod@...4...> Message-ID: <200604291842.47925.arcalis.prod@...4...> Le Samedi 29 Avril 2006 18:27, fabien Bodard a ?crit?: > 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 OOps i've forgoten a file ! And to say that is based on 1.9.29 VERSION So this is the file : From arcalis.prod at ...4... Sat Apr 29 18:44:32 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Sat, 29 Apr 2006 18:44:32 +0200 Subject: [Gambas-devel] Re: [Gambas-user] Some Little Patch In-Reply-To: <200604291827.32380.arcalis.prod@...4...> References: <200604291827.32380.arcalis.prod@...4...> Message-ID: <200604291844.32766.arcalis.prod@...4...> Le Samedi 29 Avril 2006 18:27, fabien Bodard a ?crit?: > 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 OOps i've forgoten a file ! And to say that is based on 1.9.29 VERSION So this is the file : -------------- next part -------------- A non-text attachment was scrubbed... Name: FMain.class Type: application/x-java Size: 14735 bytes Desc: not available URL: From arcalis.prod at ...4... Sat Apr 29 19:12:14 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Sat, 29 Apr 2006 19:12:14 +0200 Subject: [Gambas-devel] Re: [Gambas-user] Some Little Patch In-Reply-To: <200604291844.32766.arcalis.prod@...4...> References: <200604291827.32380.arcalis.prod@...4...> <200604291844.32766.arcalis.prod@...4...> Message-ID: <200604291912.14277.arcalis.prod@...4...> There was an iden bug... this is the patch... sorry :/ Fabien Bodard -------------- next part -------------- A non-text attachment was scrubbed... Name: FSubs.class Type: application/x-java Size: 2028 bytes Desc: not available URL: From arcalis.prod at ...4... Sun Apr 30 16:29:19 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Sun, 30 Apr 2006 16:29:19 +0200 Subject: [Gambas-devel] New set of files for ide proc navigator Message-ID: <200604301629.19255.arcalis.prod@...4...> Hi to all, As the file name of FSubs.form change to FProc.form you need to delete FSubs.form and FSubs.Class if you have installed it. There is 4 files for my trying to simplify the proc navigate. Now the list is refresh and the tree items walk syncronisated with the cursor position. Now You have Two button to navigate on the previous and the next proc either if the proc is in another file ... It's really usefull... you will see. I've add a file replacement for FFind.form because of the form raise problem ... in fact it's due to the Workspace bad concepting and i hope the Benoit new one work better. So i force the Form_Activate calling( witch is not done at each time!) Please tell me what you think about this idea... and mabe if you have other ideas ... telll it too each one of my modificate are now between and tags... So, benoit, you cans see what i've done. Regards, Fabien Bodard -------------- next part -------------- A non-text attachment was scrubbed... Name: FEditor.class Type: application/x-java Size: 39011 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: FProc.class Type: application/x-java Size: 4180 bytes Desc: not available URL: -------------- next part -------------- # Gambas Form File 1.0 { FProc Form MoveScaled(6,12.25,32.125,45.25) 'Move(48,98,257,362) Text = ("Goto") Persistent = True TopOnly = True Arrangement = Arrange.Vertical { HBox1 HBox MoveScaled(2,1,30,3) 'Move(16,8,240,24) { Label1 Label MoveScaled(0,0,22,3) 'Move(0,0,176,24) Expand = True Text = ("Goto") } { tlbPrev ToolButton MoveScaled(22,0,3,3) 'Move(176,0,24,24) Enabled = False ToolTip = ("Previous") Text = ("") Picture = Picture["img/16/left.png"] } { tlbNext ToolButton MoveScaled(25,0,3,3) 'Move(200,0,24,24) Enabled = False ToolTip = ("Next") Text = ("") Picture = Picture["img/16/right.png"] } } { tvFct TreeView MoveScaled(2,8,25,27) 'Move(16,64,200,216) Font = Font["-1"] Expand = True } } -------------- 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) 'FProc.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 ' FProc.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 'hForm.setFocus 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 FProc.RefreshAll FProc.Raise ELSE FProc.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" FProc.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 -------------- A non-text attachment was scrubbed... Name: FFind.class Type: application/x-java Size: 17732 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: capture6.png Type: image/png Size: 121137 bytes Desc: not available URL: From arcalis.prod at ...4... Sun Apr 30 17:36:41 2006 From: arcalis.prod at ...4... (fabien Bodard) Date: Sun, 30 Apr 2006 17:36:41 +0200 Subject: [Gambas-devel] New set of files for ide proc navigator In-Reply-To: <200604301629.19255.arcalis.prod@...4...> References: <200604301629.19255.arcalis.prod@...4...> Message-ID: <200604301736.41419.arcalis.prod@...4...> Re :) This is a bug correction Regards, Fabien Bodard > Hi to all, > > As the file name of FSubs.form change to FProc.form you need to delete > FSubs.form and FSubs.Class if you have installed it. > > There is 4 files for my trying to simplify the proc navigate. > > Now the list is refresh and the tree items walk syncronisated with the > cursor position. > > Now You have Two button to navigate on the previous and the next proc > either if the proc is in another file ... It's really usefull... you will > see. > > I've add a file replacement for FFind.form because of the form raise > problem ... in fact it's due to the Workspace bad concepting and i hope the > Benoit new one work better. > So i force the Form_Activate calling( witch is not done at each time!) > > Please tell me what you think about this idea... and mabe if you have other > ideas ... telll it too > > each one of my modificate are now between and tags... So, > benoit, you cans see what i've done. > > > Regards, > Fabien Bodard -------------- next part -------------- A non-text attachment was scrubbed... Name: FProc.class Type: application/x-java Size: 4245 bytes Desc: not available URL:
idusers creadate login passwemail admin photoactivate
1 1100386859gambix5d933eef19aee7da192608de61b6c23dabidoo.too at ...4...2
2 1100386859bidoo17fb812d2bf6cb65dc05fb45bdccbaeaabidoo.too at ...4...0
3 1100386859lordheavyec15590a3d3a798d0382d84570f964e8lordheavy at ...141...1
4 1100386859LaurentC04d8c425cc03ec3f918500848084a04flordheavy at ...141...0
5 1100386859RGCook11ace34f612341c3da418085af222411rgcook at ...456...0