• Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

World: r4wp

[Rebol School] REBOL School

DocKimbel
4-Oct-2012
[1152]
(sorry, I should have posted that in #Red group)
james_nak
4-Oct-2012
[1153]
I have a script that runs another script (via do) but when I launch 
it from an icon or through startup, the other script asks for permission 
to open a port. I've tried looking for some properties to change 
in the icon and setting secure to allow (which brings up its own 
requester). How do I do this?
sqlab
4-Oct-2012
[1154]
see usage in the command level

rebol.exe --secure allow in the link string should work wit most 
versions
i
james_nak
4-Oct-2012
[1155x2]
Thanks sqlab. I think that's my problem in setting that. The icon 
properties don't seem to let me do that.
For now I just encapped the script and launch it as an .exe with 
no problems.  Thanks anyway.
Steeve
4-Oct-2012
[1157]
Completly changed my mind. It's lot leasier to manage /recur as a 
refinement! 
- eg. safe/recur instead of recur

- no words collision anymore (obviously /recur can't be used as a 
parameter).
Also really short code 

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    spec: append copy spec /recur

    ctx: bind? first second fun: throw-on-error [func spec [recur]]
    change second :fun compose/deep [
        if (in ctx 'recur) [throw/name second (ctx) 'recur]
        while [true][

            set/any [(bind to-block form first ctx ctx)] catch/name [
                return do [(bind/copy body ctx)]
            ] 'recur
        ]
    ]
    :fun
]
Ladislav
4-Oct-2012
[1158x6]
It's lot leasier to manage /recur as a refinement! 
 - yes, that is an interesting idea
Also, this implementation would behave differently in some interesting 
cases
Aha, maybe not... But still, it is interesting
However, I found another problem...
Which looks to be specific to this version.
What I specifically mean is this:

f: rfunc [x] [if x = 2 [g/recur 3 5]]

which does not look like making sense, although it can be written
Steeve
5-Oct-2012
[1164x3]
;Go back to recur as a function.
;Still recur can't be used as a parameter, local or a refinement.

;This implementation is much more clean (no shitty compose/deep) 
and still very short.

;The collision of words is avoided by the use of singleton functions 
#[function!]
;I'm confident with this one. It could be the last one -_-;


rfunc: func [[catch] spec [block!] body [block!] /local ctx args][
    ctx: bind? first second throw-on-error [
        ;* Temporary function created to retrieve parameters
        ;* and to get a new context for 'recur.
        ;* The context will remain alive (not GC'ed).
        func append copy spec /recur [recur]
    ]
    args: bind to-block form first ctx ctx
    ctx/recur: func spec reduce [

        quote #[function! ['word] [throw/name second bind? word 'recur]] 

        first args ;* may be 'recur if empty specs (still, it's ok)
    ]
    func spec reduce [
        quote #[function! [args body][

            while [true][set/any args catch/name [return do body] 'recur]
        ]] 
        head remove back tail args ;* remove 'recur
        bind/copy body ctx         ;* bound 'recur
    ]
]
;Go back to recur as a function.
;Still recur can't be used as a parameter, local or a refinement.

;This implementation is much more clean (no shitty compose/deep) 
and still very short.

;The collision of words is avoided by the use of singleton functions 
#[function!]
;I'm confident with this one. It could be the last one -_-;


rfunc: func [[catch] spec [block!] body [block!] /local ctx args][
    ctx: bind? first second throw-on-error [
        ;* Temporary function created to retrieve parameters
        ;* and to get a new context for 'recur.
        ;* The context will remain alive (not GC'ed).
        func append copy spec /recur [recur]
    ]
    args: bind to-block form first ctx ctx
    ctx/recur: func spec reduce [

        quote #[function! ['word] [throw/name second bind? word 'recur]] 

        first args ;* may be 'recur if empty specs (still, it's ok)
    ]
    func spec reduce [
        quote #[function! [args body][

            while [true][set/any args catch/name [return do body] 'recur]
        ]] 
        head remove back tail args ;* remove 'recur
        bind/copy body ctx         ;* bound 'recur
    ]
]
(Sorry for the double post)
Ladislav
5-Oct-2012
[1167x2]
Well, I do have a different suggestion, which might make sense....
The fact is that the CATCH/NAME+THROW/NAME pair is not ideal for 
this, but I do have a function which might be able to handle even 
the G/RECUR case.
Steeve
5-Oct-2012
[1169]
Maybe I forgot a [throw] attribute somewhere
BrianH
5-Oct-2012
[1170x2]
I haven't examined the code enough to determine if this would help, 
but one trick to avoid having to reserve a word to refer to your 
recursion function is to use an inline reference to the function 
value instead. That is a trick that has been used in some mezzanine 
functions, though I don't know if they're still in REBOL. Inline 
references to function values are not rebound when you bind the code 
block that references them.
Yup, it's still used in the CLOSURE function in R2.
Ladislav
5-Oct-2012
[1172x2]
BTW, Steeve:


    quote #[function! ['word] [throw/name second bind? word 'recur]]

is equivalent to

    func ['word] [throw/name second bind? word 'recur]
And, Brian, examining Steeve's code above, you are late with your 
note...
BrianH
5-Oct-2012
[1174x2]
Not surprising :)
Functions specified with serialized syntax don't bind their words 
in R3, so you might want to use Ladislav's suggestion.
Ladislav
5-Oct-2012
[1176x5]
Regarding my G/RECUR note, this is a CATCH version I specifically 
had in mind:
Rebol [
    Title: "Catch"
    File: %catch.r
    Date: 5-Oct-2012/17:49:58+2:00
    Author: "Ladislav Mecir"
    Purpose: {
    	Catches local throw'
    	Ignores non-local throws
    }
]

; Error definition
system/error: make system/error [
	throw': make object! [
		code: system/error/throw/code + 50
		type: "throw' error"
    	not-caught: ["throw' not caught"]
    ]
]

catch': func [
    {Catches a throw' from a block and returns the value.}
    [throw]
    block [block!] "Block to evaluate"
    /local err disarmed
] [
	use [throw'] copy/deep compose/only [
		; "localize" 'throw' in the block
		block: (block)

		throw': func [[catch] value [any-type!]] [
			disarmed: disarm err: make error! [throw' not-caught]
			set/any in disarmed 'arg1 get/any 'value
			disarmed/arg2: 'throw'
			throw err
		]

		get/any either all [
			error? set/any 'err try block
			(
				disarmed: disarm err
				disarmed/type = 'throw'
			)
			disarmed/id = 'not-caught
			disarmed/arg2 =? 'throw'
		] [
			in disarmed 'arg1
		] [
			'err
		]
	]
]
Modifying your f/recur code as follows:
rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    spec: append copy spec /recur

    ctx: bind? first second fun: throw-on-error [func spec [recur]]
    change second :fun compose/deep [
        if (in ctx 'recur) [throw' second (ctx)]
        while [true][
            set/any [(bind to-block form first ctx ctx)] catch' [
                return do [(bind/copy body ctx)]
            ]
        ]
    ]
    :fun
]
aha, sorry, ignore my last attempt, it is wrong
Steeve
5-Oct-2012
[1181x4]
; Sorry Ladislav I've stolen your idea one should avoid catch/throw 
interferences

; As an extra (also your idea ?), f/recur and recur are now both 
allowed.

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    ctx: bind? take second fun: throw-on-error [
        func append copy spec /recur reduce ['recur body]
    ]
    insert second :fun reduce [

        quote #[function! [[throw] ctx args 'fun body /local ret][

            if :ctx/recur [ctx/recur: ctx throw/name second ctx 'recur]
            ctx/recur: :fun
            while [true][
                set/any 'ret catch/name [return do body] 'recur

                unless all [value? 'ret block? :ret same? ctx last ret][
                    throw/name get/any 'ret 'recur
                ]
                set/any args ret
            ]
        ]]

        ctx (bind head remove back tail to-block form first ctx ctx) :fun
    ]
    :fun
]
; Ladislav I can't see if you posted new code (WTF Altme)

; So I've tried your idea one should avoid catch/throw interferences

; As an extra (also your idea ?), f/recur and recur are now both 
allowed.

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    ctx: bind? take second fun: throw-on-error [
        func append copy spec /recur reduce ['recur body]
    ]
    insert second :fun reduce [

        quote #[function! [[throw] ctx args 'fun body /local ret][

            if :ctx/recur [ctx/recur: ctx throw/name second ctx 'recur]
            ctx/recur: :fun
            while [true][
                set/any 'ret catch/name [return do body] 'recur

                unless all [value? 'ret block? :ret same? ctx last ret][
                    throw/name get/any 'ret 'recur
                ]
                set/any args ret
            ]
        ]]

        ctx (bind head remove back tail to-block form first ctx ctx) :fun
    ]
    :fun
]
; Ladislav I can't see if you posted new code (WTF Altme)

; So I've tried your idea one should avoid catch/throw interferences

; As an extra (also your idea ?), f/recur and recur are now both 
allowed.

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    ctx: bind? take second fun: throw-on-error [
        func append copy spec /recur reduce ['recur body]
    ]
    insert second :fun reduce [

        quote #[function! [[throw] ctx args 'fun body /local ret][

            if :ctx/recur [ctx/recur: ctx throw/name second ctx 'recur]
            ctx/recur: :fun
            while [true][
                set/any 'ret catch/name [return do body] 'recur

                unless all [value? 'ret block? :ret same? ctx last ret][
                    throw/name get/any 'ret 'recur
                ]
                set/any args ret
            ]
        ]]

        ctx (bind head remove back tail to-block form first ctx ctx) :fun
    ]
    :fun
]
About the #[function!] vs func equivalence.

It's not. The first one is a singleton, meaning only one version 
exists in memory (not recreated each time)
BrianH
5-Oct-2012
[1185]
You can build that singleton when rfunc is called initially, or if 
you only need one then you can use funct/with to make a static local 
var with that value. (Still haven't analyzed the source.)
Ladislav
5-Oct-2012
[1186x2]
However, Steeve, you probably do not understand what the problem 
with the

    f: rfunc [x] [if x = 2 [g/recur 3 5]]


code is. The problem in a nutshell is that the G/RECUR call uses 
G/RECUR calling convention and "expects" the G/RECUR call to be used; 
however, the CATCH/NAME+THROW/NAME pair does not respect that and 
actually would do the call of F/RECUR.
(with a possibly incompatible calling convention)
Steeve
5-Oct-2012
[1188]
This time it's really really my final version T_T
- Both f/recur and recur allowed
- Catch/throw interferences ok.

NB: The code would be simpler in R3 since several workarounds are 
used to correct misbehaviors of object related natives of R2.

Also the lack of the reflexive capability for a function to read 
its own context in a easy way is definitivly a huge miss.

(On can't create anonymous functions without analysing their specs 
first. What a pain)

One would need a reserved word holding the context (like SELF for 
objects).

These shortcomings are making the code too much obfuscated and huge 
for my taste.
I hope it will be corrected in R3..

rfunc: func [
    [catch] spec [block!] body [block!] 
    /local ctx args call-tail
][
    ctx: bind? first second throw-on-error [
        func spec: append copy spec /recur [recur]
    ]
    args: bind head remove back tail to-block form first ctx ctx
    call-tail: func ['word] compose/deep [
        set/any [(args)] second bind? word 
        throw/name (ctx) 'recur
    ]
    ctx/recur: func spec reduce [:call-tail 'recur]
    func spec reduce [
        quote #[function! [
            [throw] 'recur 'call-tail ctx args body /local ret
        ][
            if get/any recur [call-tail :recur]
            set recur get in ctx 'recur
            while [true][
                set/any 'ret catch/name [return do body] 'recur
                unless all [value? 'ret same? :ret ctx][
                    throw/name get/any 'ret 'recur
                ]
                set/any args second ctx
            ]
        ]]
        'recur :call-tail ctx args body
    ]
]
Steeve
7-Oct-2012
[1189]
(test sync)
Arnold
7-Oct-2012
[1190]
VID question. Is it possible to combine more than 1 fontsize, color 
within the text on a element like a label? I want to emphasize a 
small piece of the text.
Gregg
7-Oct-2012
[1191]
You have to use DRAW commands to do it in R2.
Henrik
7-Oct-2012
[1192]
and then you lose text adjustment control
Arnold
7-Oct-2012
[1193]
That is a idea. The text to emphasize is the text that you get to 
read. Then it disappear and you have to type it yourself. It is a 
progam from a schoolprogram for young children. I want to replicate 
it and maybe add a little fun for my daughter thinks it is boring 
as it is now.
Henrik
7-Oct-2012
[1194x2]
it's also possible to simply add a pane of faces that construct the 
text in the necessary parts. with SIZE-TEXT you can then calculate 
the necessary size of each part and write a little routine to lay 
it out. it's a bit of work, though.
that does not use DRAW.
Sunanda
7-Oct-2012
[1196]
Does this get close?
   http://www.rebol.org/view-script.r?script=render-rich-text.r
MaxV
8-Oct-2012
[1197]
WOW it's amazing!
Arnold
8-Oct-2012
[1198x2]
I tested this on my Macbook just now and only the blue link is specially 
rendered. Functional though, it does send me to the designated page 
in Safari.
Henrik, my initial idea was that it should be possible to make such 
a text/label facet where the text and markup are stored in array/blocks. 
The markup could just be a referral to a markup defined elsewhere. 
Not that I am afraid of a little work but right now I think I can 
manage what I want using just a new textcolor ;)


I named my Text+ field piep and calculated size-text piep to be 0x15. 
Doesn't look correct. Also "word' url" should be "word 'url" in render-rich-text 
/local declaration?
Henrik
8-Oct-2012
[1200]
I usually use a test face first for SIZE-TEXT. It's important that 
the test face has the dimensions to at least contain the text, as 
you want it formatted. When you then use that face as an argument 
to SIZE-TEXT, it returns the face size. That face size can then be 
used to set the size of the real text face.
Arnold
8-Oct-2012
[1201]
good tip. thnx!