[REBOL] Re: A hard question
From: lmecir:mbox:vol:cz at: 7-Feb-2001 20:33
Hi Gabriele,
...
> Does SELECT-PROP really need to handle errors?
...
It has to handle all values that can be stored in a series. I think I got it
now:
soft-func: function [
{Create a "soft return" function}
spec [block!]
body [block!]
] [thr-on fnc-return] [
spec: copy/deep spec
if not string? pick spec 1 [
insert spec "(undocumented)"
]
either block? pick spec 2 [
change/only next spec [catch throw]
] [
insert/only next spec [catch throw]
]
use [thr fnc] [
thr-on: does [thr: on]
fnc-return: func [[throw] fnc-result [any-type!]] [
change/only next third :fnc either thr [[catch throw]] ["Soft"]
return get/any 'fnc-result
]
use [soft-return] [
soft-return: func [[throw] body-result [any-type!]] [
thr: off
return get/any 'body-result
]
body: bind/copy body 'soft-return
]
fnc: func spec reduce [
:thr-on
:fnc-return :body
]
body: does third second :fnc
change skip second :fnc 2 :body
:fnc
]
]
select-prop: soft-func [
{Finds a value in the series and returns the value after it.}
series [series! port!]
value [any-type!]
/part "Limits the search to a given length or position."
range [number! series! port!]
/only "Treats a series value as a single value."
/case "Characters are case-sensitive."
/any "Enables the * and ? wildcards."
/with "Allows custom wildcards."
wild [string!] "Specifies alternates for * and ?"
/default "The negative result handling"
handler [block!]
/local path args result1
] [
path: to path! 'find
args: [result1:]
append/only args :path
append args [:series get/any 'value]
if part [
append :path 'part
append :args [:range]
]
if only [
append :path 'only
]
if case [
append :path 'case
]
if any [
append :path 'any
]
if with [
append :path 'with
append/only :args :wild
]
do args
either system/words/any [
not result1
error? try [
error? set/any 'result1 second :result1
]
] [
either default [soft-return do handler] [
throw make error! {Cannot select}
]
] [soft-return get/any 'result1]
]
; situation 1:
test: does [
select-prop/default [1 a 2 b] 3 [return 4]
5
]
test ; == 4
; situation 2:
print mold disarm select-prop head insert tail copy [1 a 2 b 3] make
error! "some-error" 3
make object! [
code: 800
type: 'user
id: 'message
arg1: "some-error"
arg2: none
arg3: none
near: [print mold disarm select-prop head]
where: none
]
