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

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

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

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 [ text bouton menu etc...]

>> menu red font-size 16 [ menu "item1" menu "item2"] ; les items du sous-menu seront en rouge avec une taille de police 16

>> 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!

>> menu [...] with [focus-effect: [invert emboss]]

>> menu "item" [ ... menu ... ]

>> menu "item" [ print "code"]

>> menu "item" [ bool print bool] ; bool change de valeur =E0 chaque fois qu'on clique sur l'item

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

Hi Gregg,

> If your app is already handling events (e.g. by calling VIEW), you > don't need to call DO-EVENTS again.

>> ? .r

> It's not like > using the DoEvents function in VB--for those who are familiar with

> 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

Al TS napsal(a):

>I now the Rebol Style is not to have libs concept but put all the source in the same file >

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 ;-)