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éinstaller votre programme." newline
]
ask "Appuyer sur Entrée 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 ça 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és (voir l'exemple en bas de page)
Un sous-menu hérite des propriétés et effets du menu parent, cela évite d'avoir à
redéfinir 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 à cocher :
>> menu info.gif ;image seule
>> menu info.gif "item" ;image + texte
>> menu "text" [bool1] ;texte + boite à cocher, bool doit être une variable de type
>> logic!
Le style de la boite à cocher peut être modifié, par défaut c'est un 'radio
menu "text+coche" [bool1] witch [check: 'led] ;
L'effet appliqué 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épend du contenu
du bloc associé.
* 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écution du code et fermeture des menus
>> menu "item" [ print "code"]
* si il contient un bloc de code commençant par une variable de type logic!
(click) -> inversion de la variable + exécution du code + fermeture des menus
>> menu "item" [ bool print bool] ; bool change de valeur à chaque fois qu'on clique
>> sur l'item
******************************}
; EXEMPLE d'un sous-menu appelé dans 2 barres de menu avec des effets différents.
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 <[EMAIL PROTECTED]> 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
[EMAIL PROTECTED] with unsubscribe as the subject.
---------------------------------
Yahoo! Mail : votre e-mail personnel et gratuit qui vous suit partout !
Créez votre Yahoo! Mail
Dialoguez en direct avec vos amis grâce à Yahoo! Messenger !
--
To unsubscribe from this list, just send an email to
[EMAIL PROTECTED] with unsubscribe as the subject.
