Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Right mouse button popup-menu for all my REBOl apps.

 [1/7] from: rebolview:yah:oo at: 27-Feb-2004 14:02


Dear all, Excuse me for this long mail but i think someone here can help me. I'm working on this popup-menu for long time and i have a serious matter with the Garbage Colector but i can't reproduce the problem with a little console example like : loop 100 [view/new layout [ ...] unview ] So if someone can run this %menu.r and tell me what it is thinking about ? Many thanks for your help and informations... -yos REBOL [] ; For me it is impossible to write a rock stable menu : ; Please find below some parts of an application ; do this %menu.r script and press very quikly the "menu" button ; by selecting "item1" or "item2" ; in less than 20 secondes the Garbage Colector will crash (windows, amiga) ; sysr is a part of my %sys.r library ; i use this functions for many months ; and i don't think the problem is about them. sysr: get in context [ do-word: get in context [ do-word: func [ { } 'Word /make ] [ either make [ compose/deep [ (Word) [ new/user-data: make new/user-data [ (to-set-word Word) make (Word) second args] next args ] ] ] [ compose/deep [ (Word) [ new/user-data: make new/user-data [ (to-set-word Word) second args] next args ] ] ] ] ] 'do-word do-init: get in context [ do-init: func [ { } Face /with Rwith ] [ Face/init: any [Face/init copy []] Face/init: head insert head Face/init [ user-data: make user-data [] user-data/face: :self if user-data/styles [ user-data/styles: stylize user-data/styles user-data/layout: head insert head user-data/layout compose [ styles ( in context [styles-word: get in user-data 'styles] 'styles-word ) ] ] if user-data/layout [ user-data/layout: layout user-data/layout pane: get in user-data/layout 'pane size: 2 * edge/size + user-data/layout/size ] ] if with [Face/init: head insert head Face/init Rwith] ] ] 'do-init user-data: get in context [ user-data: context [ face: none styles: none layout: none menu: none ] ] 'user-data ] 'self ; stylesr is my %styles.r library stylesr: stylize [ item: face 75x25 silver with [ init: copy [] words: load compose [ (sysr/do-word on-up)] user-data: make sysr/user-data [ on-up: none] sysr/do-init self ] font [ valign: 'middle align: 'center color: black style: none shadow: 0x0 ] feel [ over: func [face over? position] [ if face/text [ either over? [ face/color: aqua face/font: make face/font [color: white] show face ] [ face/color: silver face/font: make face/font [color: black] show face ] ] ] engage: func [face action event /local uv] [ switch action [ up [ uv: last system/view/screen-face/pane unview do face/user-data/on-up ] ] ] ] ] ; show-menu the function maybe wrong for the Garbage Colector ... show-menu: get in context [ show-menu: func [ { } Menu Mouse-offset /local menu-face ] [ menu-face: copy [ styles stylesr origin 0x0 space 0x0 ] foreach [s b] Menu [ append menu-face reduce [ 'item 100x25 s 'on-up b] ] menu-face: layout menu-face menu-face: make menu-face [ options: copy [no-border no-title] user-data: context [ over: true face: get in menu-face 'self ] edge: make edge [size: 2x2 effect: 'bevel] size: 2 * edge/size + size ] view/new/offset menu-face Mouse-offset - (menu-face/size / 2) menu-face/feel: make menu-face/feel [ detect: func first :detect head insert head second :detect [ switch event/type [ move [ if (face/user-data/over xor within? event/offset 1x1 face/size - 3x3) [ either face/user-data/over [ ; print "away" unview ] [ ; print "over" ] face/user-data/over: not face/user-data/over ] ] ] ] ] do-events ] ] 'show-menu menu: copy [ "item 1" [print "item1"] "item 2" [print "item2"] ] view layout [ button "menu" [ show-menu menu (face/size / 2 + screen-offset? face) ] ] =09

 [2/7] from: greggirwin::mindspring::com at: 27-Feb-2004 9:31


Hi yos, Just remove the do-events call from your show-menu code and you should be fine I think. What is the reason you do this to set show-menu: show-menu: get in context [ show-menu: func [ ... ? -- Gregg

 [3/7] from: rebolview::yahoo at: 1-Mar-2004 9:40


Hi Gregg you are right !! I try many hacks to the code to not have the problem but without succes. How have you think about hide the do-events line ? show-men.r is a file of the %sys.r library %sys/ folder. All the functions, object, block ... in these files are defined like debug-name: get in context [ value-name: func [ ... ] ; end of func ] 'value-name The encapsulation in a context (get in context) is good when the value is complex and use other functions put in this context. File writen like that are very easy to manage to create the library file sys.r with sys.r/make-library %sys or loading the file in raw mode just the context for example to create my styles library. sys.r is for me a little "famous exec library" and i dream of a RebolOS for Rebol not only a desktop but a real cool api for all to create program easily. The main functions of the system i use are: %import.r REBOL [] import: get in context [ opencnt: copy [] import: func [ {import HELP. } File /raw /lib /only /call /help /header Rheader /name Rname /from Rfrom /in Rin /free /local ref? file-name module refinements ref spec-block n args value lib-name cnt ] [ file-name: File if call [ ref?: any [find File "/" tail File] file-name: copy/part File ref? call: to-lit-path next ref? ] lib-name: to-word to-string second split-path File if free [ error? try [ opencnt: head change cnt: next find opencnt lib-name (first cnt) - 1 if equal? 0 opencnt/:lib-name [ remove remove find opencnt lib-name unset sw.r/in sw.r lib-name ] ] return ] if lib [ error? try [ opencnt: head change cnt: next find opencnt lib-name (first cnt) + 1 return get sw.r/in sw.r/:lib-name 'self ] file-name: sys.r/assign/find 'libs second split-path file-name Rfrom: to-file "" ] Rfrom: any [Rfrom clean-path %./] module: sys.r/module/from file-name Rfrom if header [append clear head Rheader module/header] if name [append clear head Rname to-string first module/content] if all [lib equal? last module/content 'self] [ do/next module/content append opencnt reduce [lib-name 0] opencnt: head change cnt: next find opencnt lib-name (first cnt) + 1 return get sw.r/in sw.r/:lib-name 'self ] if in [module/content: bind module/content sw.r/in Rin 'self] value: do next module/content switch/default true reduce [ raw [module/content] only [fifth module/content] all [call function? :value] [ remove refinements: parse file "/" spec-block: first :value args: 0 forall spec-block [ either word? spec-block/1 [args: args + 1] [break]] args: args + length? refinements foreach ref refinements [ if not word? select spec-block to-refinement ref [ args: args - 1] ] spec-block: copy [] for n 1 args 1 [append spec-block to-word join "arg" n] append spec-block compose [/local (to-word first module/content)] call: head insert :call to-word first module/content append module/content compose [(call)] append module/content copy/part spec-block args first reduce load mold/only reduce ['func spec-block module/content] ] help [ use compose [(to-word first module/content)] compose [ (module/content) system/words/help (to-word first module/content) ] ] ] [ :value] ] ] 'import ;d: import %../time/date.r ;probe d ;t: import/lib %time.r ;probe t/date probe do import/from/call %date.r %../time/ probe do import/from/call %date.r/with %../time/ [day] %module.r REBOL [] module: get in context [ module: func [ { } File /from Rfrom /header /content /context /code /local module ] [ Rfrom: any [Rfrom clean-path %./] module: sys.r/script/from File Rfrom module: make module [code: copy at module/content 7] module/content: head clear at module/content 7 if not equal? last module/content 'self [ module/content: head change module/content to-set-word last module/content ] switch/default true reduce [ header [module/header] content [module/content] code [module/code] context [second fifth module/content] ] [ module] ] ] 'module %script.r REBOL [] script: get in context [ script: func [ { } File /from Rfrom /header /content /compress /decompress /local file-name script ] [ Rfrom: any [Rfrom clean-path %./] file-name: Rfrom/:File if error? try [script: read file-name] [ print [ newline "Erreur de chargement de votre application :" newline " - le fichier" File "est manquant." newline "Merci de r=E9installer votre programme." newline ] ask "Appuyer sur Entr=E9e pour quitter." quit ] script: load/all script? script while [block? first script] [script: first script] script: context [ header: second script content: copy at script 3 ] if binary? first script/content [ script/content: load sw.r/decompress first script/content] switch/default true reduce [ header [script/header] content [script/content] decompress [save/header File script/content script/header] compress [ save/header File sw.r/compress mold/only script/content script/header ] ] [ script] ] ] 'script %make-lib.r REBOL [] make-library: get in context [ make-library: func [ { } dir /name Rname /styles /local file lib-file ] [ if dir? dir [ lib-file: second split-path file.r/undirize dir lib-file: join lib-file ".r" Rname: any [Rname to-string lib-file] write lib-file rejoin [ "REBOL []" newline] write/append lib-file rejoin [ newline Rname either styles [": stylize"] [": get in context"] newline "[" ] foreach file read dirize dir [ print [file] write/append lib-file rejoin [ newline mold/only either styles [ sys.r/module/context/from file dirize dir] [ sys.r/module/content/from file dirize dir] ] ] write/append lib-file rejoin [ newline newline either styles ["]"] ["] 'self"] newline newline ] print "compress" sys.r/script/compress lib-file ] ] ] 'make-library make-library/styles %styles For an other menu see below the french "arctiste" example : REBOL [] menu.s: stylize [ menu: text feel [over: func [f a e /local l_ s_][ f/effect: pick reduce [append cp f/sav-effect f/focus-effect f/sav-effect] a show f if all [function? get/any in f 'action find second get in f 'action f/Style ] [ either a [ s_: f/parent-face/menustyle l_: layout/parent head insert cp second get in f 'action [styles s_ origin 1x1 space 0x0 ] s_/menu l_/offset: ((win-offset? f) + to-pair reduce either 2 * f/size/x > f/parent-face/size/x reduce [[f/size/x 0]][[0 f/size/y]]) l_/style: f/Style l_/rate: 4 l_/user-data: f/parent-face l_/menustyle: s_ f/parent-face/evt: l_ append get in find-window f 'pane l_ l_/feel/engage: get in f/feel 'engage ][f/parent-face/evt: none] show find-window f ] ] engage: func [f a e /local z_][ all [a = 'down function? z_: get/any in f 'action not find z_: second :z_ f/Style any [all [word? z_: first z_ logic? get/any z_ set z_ not get z_] true] any [f/action f a true] in f/parent-face 'parent f/parent-face/parent = 'panel remove find get in find-window f 'pane f/parent-face show find-window f f/parent-face/user-data: f/parent-face/parent-face f/parent-face/rate: f/parent-face/feel: none ] all [a = 'time not same? f/user-data/evt f same? last get in find-window f 'pane f not ((inside? e/3 win-offset? f ) and (inside? ((win-offset? f) + f/size) e/3 )) remove find get in find-window f 'pane f show find-window f f/user-data: f/parent-face f/rate: f/feel: none ] ] ] with [ focus-effect: [multiply 80] sav-effect: evt: menustyle: none check: 'radio size: 80x20 item: [across origin 1x1 space 1x1 image (to-pair either size [reduce [size/y size/y]][20x20]) (image) effect 'fit text as-is (text) (size) with [font: (font)] box (to-pair either size [reduce [size/y size/y]][20x20]) effect [arrow rotate 90] ] init: append cp init [use [v_ f_][ feel: styles/menu/feel sav-effect: to-block effect if size = 0x0 [size: none] either not all [empty? text none? image][ pane: layout replace/all compose/deep item none [] pane/color: color if any [not :action not find second :action Style] [ remove back tail pane/pane all [:action word? v_: first second :action logic? get/any v_ f_: make-face check f_/offset: pane/size - 20x20 set-face f_ get v_ append pane/pane f_ ] ] image: to-image pane size: image/size pane: none ][ data: cp second :action action: alt-action: none menustyle: reduce [style make self []] pane: layout head insert data [styles menustyle origin 1x1 space 0x1 ] size: pane/size pane: pane/pane foreach data pane [data/parent-face: self] image: color: none ] data: text: none ]] ] ] { **************************** comment =E7a marche ? Description d'un menu et ses sous-menus par imbrication de blocs. le menu racine est en fait la barre de menu.
>> menu [
menu "item 1" [ menu "item 1.1" [] menu "item 1.2" [] ] menu "item 2" [] ] Un bloc du menu autorise tous les mots du dialecte vid.
>> menu [ text bouton menu etc...]
On peut donc faire des menus hyper chiad=E9s (voir l'exemple en bas de page) Un sous-menu h=E9rite des propri=E9t=E9s et effets du menu parent, cela =E9vite d'avoir =E0 red=E9finir l'aspect des items de menu:
>> menu red font-size 16 [ menu "item1" menu "item2"] ; les items du sous-menu seront en rouge avec une taille de police 16
L'aspect d'un item peut associer une image + un texte + une boite =E0 cocher :
>> menu info.gif ;image seule >> menu info.gif "item" ;image + texte >> menu "text" [bool1] ;texte + boite =E0 cocher, bool doit =EAtre une variable de type logic!
Le style de la boite =E0 cocher peut =EAtre modifi=E9, par d=E9faut c'est un 'radio menu "text+coche" [bool1] witch [check: 'led] ; L'effet appliqu=E9 quand un item a le focus est modifiable:
>> menu [...] with [focus-effect: [invert emboss]]
Lorsque on active (click ou focus) un item de menu, son comportement d=E9pend du contenu du bloc associ=E9. * si il contient au moins un fois le mot 'menu (focus) -> appel d'un sous-menu
>> menu "item" [ ... menu ... ]
* si il contient un bloc de code (click) -> ex=E9cution du code et fermeture des menus
>> menu "item" [ print "code"]
* si il contient un bloc de code commen=E7ant par une variable de type logic! (click) -> inversion de la variable + ex=E9cution du code + fermeture des menus
>> menu "item" [ bool print bool] ; bool change de valeur =E0 chaque fois qu'on clique sur l'item
******************************} ; EXEMPLE d'un sous-menu appel=E9 dans 2 barres de menu avec des effets diff=E9rents. sub-menu: [ backdrop papaya effect [gradcol 1x0] vtext 124 "sous-menu" bold center effect [gradient 1x0 ] menu "essai" [bool1] menu "essai2" [bool3] menu "essai3..." [bool print "coucou"] menu info.gif "essai4" [ backdrop papaya effect [gradcol 1x0] menu "toto" menu "titi.." [print "titi"] ] ] unview view layout [ styles menu.s origin 0x0 size 400x300 do [bool: bool1: bool2: bool3: true] at 0X40 menu 80x30 black white bold italic [ backdrop black gray edge [size: 1x1] effect [gradient 1x0 ] vh1 "barre menu" vh1 "verticale" menu help.gif "sous-menu" sub-menu menu "go..." info.gif [print "go"] image logo.gif white ] effect [gradcol 0x1] at 0x0 menu white bold [across backdrop logo.gif effect [greyscale emboss emboss tile] vtext bold "barre horizontale" italic menu 0x0 white info.gif "Menu1" sub-menu menu 0x0 yellow "Menu2" menu 0x0 help.gif [print "help"] ] font-size 16 edge [size: 1x1] effect [key black] with [check: 'led focus-effect: [invert emboss]] ] Hey Carl we "keep it simple" for you so please keep always Rebol cool for us !! Have fun to all of us. AND MANY THANKS TO YOU GREGG !! Friendly French anonyme -yos. Gregg Irwin <[greggirwin--mindspring--com]> wrote: Hi yos, Just remove the do-events call from your show-menu code and you should be fine I think. What is the reason you do this to set show-menu: show-menu: get in context [ show-menu: func [ ... ? -- Gregg -- To unsubscribe from this list, just send an email to [rebol-request--rebol--com] with unsubscribe as the subject. =09

 [4/7] from: greggirwin:mindspring at: 1-Mar-2004 10:10


Hi Yos, AT> I try many hacks to the code to not have the problem but AT> without succes. How have you think about hide the do-events line ? If your app is already handling events (e.g. by calling VIEW), you don't need to call DO-EVENTS again. It can cause problems because you then basically have two main event loops in your app. It's not like using the DoEvents function in VB--for those who are familiar with that. AT> The encapsulation in a context (get in context) is good when the value AT> is complex and use other functions put in this context. Right, I was wondering more about the syntax you used--using a set-word with "get in context", rather than using SET in the context itself. e.g. show-menu: get in context [ show-menu: func [v] [print v] ] 'show-menu context [ set 'show-menu func [v] [print v] ] -- Gregg

 [5/7] from: rebolview:yah:oo at: 2-Mar-2004 9:58


Hi Gregg,
> If your app is already handling events (e.g. by calling VIEW), you > don't need to call DO-EVENTS again.
Yes Gregg that's right. My app is for example a style definition [face with etc...] defined in a module like the Show-menu function and all the functions of the differents libs i write. My file app are named with .s extension like style. To load and show the application i have sys.r/start function to do that and set the window feel of my app to show it's user-data/menu if not none when right mouse button is press in the detect func. Also if the app file is calculator.r the feel is also change to save in calculator.txt the relative position on screen of the window when the user close the app. So all the apps are very user friendly because they always appear at the place the user define when quitting. In this function start like in the show-menu i used to do a do-events at the end thinking that if i do not that the events process is stop. So with your help Gregg now in the user.r i lauch the main user app with : sys.r/start main-app.s do-events quit The only time i lauch do-events it is in the user.r, perfect. In fact my libs are called .r :
>> ? .r
Found these words: file.r object! [file split-file split-path undirize get-dir] locale.r object! [months days] styles.r block! length: 2 sw.r object! [unset! error! datatype! context! native! action! ... sys.r object! [ansi-prompt ansi cd assign clic-face cls show-men... sw.r IS system/words the very first lib give by Rebol !! It is shorter to write sw.r/print than system/words/print in all the function that use a refinement name the same as a global word.
> It's not like > using the DoEvents function in VB--for those who are familiar with
that. No and NEVER PC and M$ software at home, never use VB only working sometimes in C++ Builder Delphi Java and after AREXX AmigaE Rebol at home !!
> Right, I was wondering more about the syntax you used--using a > set-word with "get in context", rather than using SET in the context
I don't want to define the module value (function etc... ) globaly except when i do the module itself to debug it because the structure is : REBOL [] debug-name: get in context [ module-value: etc... ] 'module-value ; try game in french jeux d'essai or unitary tests ?! debug-name etc... I now the Rebol Style is not to have libs concept but put all the source in the same file BUT if you want to try Rebol PROGRAMMING IN THE LARGE not in the small how do you do ? Many thanks again to all of you for all the informations you give on this ML !! -yos Gregg Irwin <[greggirwin--mindspring--com]> wrote: Hi Yos, AT> I try many hacks to the code to not have the problem but AT> without succes. How have you think about hide the do-events line ? If your app is already handling events (e.g. by calling VIEW), you don't need to call DO-EVENTS again. It can cause problems because you then basically have two main event loops in your app. It's not like using the DoEvents function in VB--for those who are familiar with that. AT> The encapsulation in a context (get in context) is good when the value AT> is complex and use other functions put in this context. Right, I was wondering more about the syntax you used--using a set-word with "get in context", rather than using SET in the context itself. e.g. show-menu: get in context [ show-menu: func [v] [print v] ] 'show-menu context [ set 'show-menu func [v] [print v] ] -- Gregg -- To unsubscribe from this list, just send an email to [rebol-request--rebol--com] with unsubscribe as the subject. =09

 [6/7] from: lmecir:mbox:vol:cz at: 2-Mar-2004 12:48


Al TS napsal(a):
>I now the Rebol Style is not to have libs concept but put all the source in the same file >
That is a subjective POV. I *am* using libraries. I am using http://www.fm.vslib.cz/~ladislav/rebol/include.r to handle my optimizing routines, matrix processing routines etc.

 [7/7] from: maximo:meteorstudios at: 2-Mar-2004 9:29


you can checkout slim.r Steel Library Manager. its a tool I've developed which attempts to standardize the way we all use our external stuff. basically, it offers integrated tools to manage namespaces in the way you want. its very versatile, and it even handles resources locally to itself, so that you can package some data WITH your library in a rsrc directory. if you use the refinement, then any load/save/read/write will be local to the version of the library which is loaded. install is super simple. it is completely documented. http://www.rebol.it/~steel/libraries/ note that I will be upgrading my site in the following week, to include a later slim and slimmed versions of liquid.r. all downloads will now be placed on rebol.org. I will be testing the new download tool with my steel package, so they should all be available pretty quickly. -MAx --- PS: (I haven't gotten around to fixing a few typos yet, sorry gregg ;-)