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

[REBOL] Re: Right mouse button popup-menu for all my REBOl apps.

From: rebolview:yah:oo 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