AltME groups: search

Running altme with "Special Options" does create this error.. (1.1.29 
linux)

Install Error Info: make object! [
    code: 300
    type: 'script
    id: 'no-value
    arg1: 'base-effect
    arg2: none
    arg3: none
    near: [base-effect]
    where: 'do-facets
]

s1: make struct! [] none
s2: make struct! [] none
same? s1 s2
;== none  ; (expected false)
same? s1 s1
;== none  ; (expected true)
blk: reduce [s1]
;== [make struct! [] []]
find blk s2
;== [make struct! [] []]  ; (expected none)
equal? s1 s2

;== none  ; (are struct! comparable like string! (expect true) or 
incomparable like object!  (expect false) ?)

o: make object! [type: 'face]
third o
; == [type: face]  ; <---- should be a lit-word!   ?

#3463 : still crash with 1.2.104 - the problem is not construct/with, 
it's using an object containing a recursive block as prototype :
b: copy [] append/only b b 
an-object: make object! [a: b]
make an-object [] ; crash

NEW/LOCALS is an object of value:

   handler         object!   [name port-id hidden peer stop-at shared 
   module ev...
   write-queue     block!    length: 0
   file-chunk      integer!  65536
   stop            none!     none
   in-buffer       binary!   #{}
   file            none!     none
   flag-close      none!     none
   events          none!     none

this looks strange:
>> o: make object! [test-word: none]

>> do bind probe reduce [to set-path! 'test-word to lit-word! 'test-contents] 
in o 'self
[test-word: 'test-contents]
== test-contents
>> probe o

make object! [
    test-word: none
]

Thanks for the strict-greater? idea.  I was hoping there was a built-in 
ability somewhere.

One tiny tweak to the function -- you need to restrict the two values 
to series or you can get strange results:
     >> strict-greater? make object! [1] make object! [0]
     == false
     >> greater? make object! [1] make object! [0]
     ** Script Error: Cannot use greater? on object! value
So:

 strict-greater?: func [value1 [series!] value2 [series!]] [(to-binary 
 value1) > (to-
binary value2)]

>> a: make object! SMD2Header
** Script Error: Invalid argument: make struct! [
    m_iMagicNum [int]
    m_iVersion [int]
    m_iSkinWidthPx [int]
    m_iSkinHeightPx [int]
    m_iFrameSize [int]
    m_iNumSkins [int]
    m_iNumVertices [int]
    m_iNumTexCoords [int]
    m_iNumTriangles [int]
    m_iNumGLCommands [int]
    m_iNumFrames [int]
    m_iOffsetSkins [int]
    m_iOffsetTexCoords [int]
    m_iOffsetTriangles [int]
    m_iOffsetFrames [int]
    m_iOffsetGlCommands [int]
    m_iFileSize [int]
] [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]

stack!: make object! [
		stack: make block! []

		push: func['value /flattend][
			either (type? value) == block!
				[
					either flattend
						[foreach entry value [insert head stack entry]]
						[insert/only head stack value]
				]
				[insert head stack value]
		]

		pop: does [
			either (length? stack) > 0
			[
				value: first stack
				remove stack
				return value
			]
			[return none]
		]

		top: does [
			if not empty? [return first stack]
		]

		empty?: does [
			either (length? stack) == 0 [return true][return false]
		]

		ontop?: func ['value][
			either value == top [return true][return false]
		]

		instack?: func ['value][

   either result: find stack value [return index? result][return none]
		]

		reset: does [
			clear stack
		]

		size: does [
			return length? stack
		]

		print: does [
			probe reduce ["stack:" stack]
		]
	] ; stack

blk: copy []
loop 10 [append blk make object!  [a: 1]]

blk: make block! 10

loop 10 [insert tail blk make object! [name: copy "<name>"]] ; COPY 
so all objects don't share the same string

;I find this amazing.


>> o: make object! [sub-o: make object! [name: 'sub-o f: func [v][2 
* v]]]
>> ? o    
O is an object of value: 
   sub-o           object!   [name f] 

>> var: in o 'sub-o
== sub-o

>> ? var  
VAR is a word of value: sub-o

>> value: get var
>> ? value
VALUE is an object of value: 
   name            word!     sub-o 
   f               function! [v] 


;What I find amazing is that you can get the content of the object 
SUB-O by doing GET VAR

;Some how the context where 'SUB-O is defined gets attached to VAR 
or SUB-O by IN O 'SUB-O


;just to check, the global context doesn't know anything about SUB-O
>> ? sub-o
No information on sub-o (word has no value)
>> sub-o
** Script Error: sub-o has no value
** Near: sub-o

O is an object of value: 
   a               integer!  0 
   b               integer!  4 
   o1              object!   [a c o2] 

>> ? o/o1
O/O1 is an object of value: 
   a               integer!  1 
   c               integer!  5 
   o2              object!   [] 

>> ? o/o1/o2
O/O1/O2 is an object of value: 

>> d
== 6

a: make object! [
    b: 4
    c: 6
]

strange result, I would expect obtaining error here?
>> unset in a 'b
>> probe a

make object! [
    b: unset
    c: 6
]
>> a/b
>>

I'm getting a confusing error about using paths on a logic! object 
when trying to use the methods of a created object. I figure I'm 
missing something obvious, but I can't figure out what it is:

test-result: make object! [
    run-count: 0
    error-count: 0

    test-started: does [
        run-count: run-count + 1
    ]

    test-failed: does [
        error-count: error-count + 1
    ]

    summary: does [
        return join  run-count [ " run, " error-count " failed" ]
    ]
]


; ...


            ed: make test-result [ ]
            ed/test-started
            ed/test-failed
            assert [ ed/summary == "1 run, 1 failed" ]

; output of code:

[[wisti-:-us1-dhcp-227-65] xUnit]$ rebol xunit.r
** Script Error: Cannot use path on logic! value
** Where: test-failed-result-formatting
** Near: ed/test-started
ed/test-failed
assert [ed/summary == "1 run, 1 failed"]

obj-spec: func [
    "Returns the object spec as a single line (flat) string."
    obj [object!]
    /only "no surrounding brackets"
    /mold "Multi-line MOLDed format"
    /local res
][
    res: copy find/tail system/words/mold obj "make object! "
    if not mold [trim/lines res]
    if only [res: trim/auto next head remove back tail next res]
    res
]

remove-words: func [

    "Returns a copy of the object with the specified words removed."
    object [object!]
    words  [word! block!] "The word, or words, to remove"
    /local spec
][
    spec: load obj-spec object
    foreach word compose [(words)] [
        remove/part find spec to set-word! word 2
    ]
    make object! spec
]

I hope this is useful for someone

REBOL []

rest: func [s [series!]][skip s 1]

define-object: func [
	spec [block!] 
	/local 

  arg-spec ctx-spec object-name constructor-name predicate-name attributes
		spec-rule type-spec continue? w
][
	arg-names: copy []

	continue?: [none] ;used to stop parsing
	name-rule: [set w word! (insert tail arg-names w)]

 type-rule: [set w word! (unless datatype? attempt [get w] [continue?: 
 [end skip]])]

 spec-rule: [name-rule some [name-rule opt [into [some [type-rule 
 continue?]]]]]

	if any [
		not parse spec spec-rule
		arg-names <> unique arg-names
	][
		make error! "invalid spec"
	]

    object-name: to-string first arg-names
	constructor-name: to-word join 'make- object-name
	predicate-name: to-word join first arg-names '?
	attributes: rest arg-names

	arg-spec: copy []
	foreach itm attributes [
		insert tail arg-spec reduce [
			to-word join itm '-value
			either block? w: select spec itm [w][[any-type!]]
		]
	]

	ctx-spec: copy []
	arg-names: extract arg-spec 2 1
	repeat i length? attributes [

  insert tail ctx-spec reduce [to-set-word attributes/:i to-get-word 
  arg-names/:i]
	]

	;create constructor function
	set constructor-name make function! 

  compose [(reform ["Makes a new" uppercase object-name "object with 
  attributes" mold attributes]) (arg-spec)]
		compose/only [make object! (ctx-spec)] ;body

	;create predicate function
	set predicate-name make function! 

  compose [(reform ["Determines if value is a" uppercase object-name 
  "object"]) value [object!] /local types]
		compose/deep/only [
			either (attributes) = rest first value [
				foreach itm (attributes) [
					unless any [

      [any-type!] = types: select (arg-spec) to-word join itm '-value
						find types type?/word value/:itm
					][return false]
				]
				true
			][
				false
			]
		] 
]

REBOL [Title: "proxy multiple" ] 

print "start-multiple"
 list: []

proxy: make object! [ host: 24.186.191.254
                      port-id: 29992 ]

ph: func [port][ switch port/locals/events [
                          
                          connect [insert tail list  port

                                   ping: to-integer (now/time - port/date ) * 1000 
                                   port/date: now/time

                                   print [ "open   ping: " ping ]  ]

                          close [ remove find list port
                                  init

                                  ping: (now/time - port/date ) * 1000 

                                   print ["close   ping: " ping ] close port ]

                                                ]


false ]



stop: func [] [ clear system/ports/wait-list
               forall list [close first list ]]

init: func [ /local port ][ port: make port! [ scheme: 'atcp
                                               host: proxy/host

                                               port-id: proxy/port-id
                                               awake: :ph 
                                               date: now/time ]

                            open/no-wait/binary  port


                            insert tail system/ports/wait-list  port ]



set: func [ h p ] [ proxy/host: h
                    proxy/port-id: p ]
                          

send: func [ port ][ port/date: now/time

insert port join  #{0401} [debase/base  skip to-hex 80 4 16 to-binary 
193.238.73.117 #{00}] ]

rebol [ title: "SOCKS SERWER" ]

conn: make port! tcp://:800

proxy: make object! [ host: 208.59.117.69
                      port: 2988  ]



black-lista: [ 69.64.51.223 194.69.207.145 80.252.0.145 194.69.207.165 
217.73.17.115]




adns: open/no-wait make port! dns:///async

adns/awake: func [port /local data][                
		
		data: copy port

                print data
		
		false 
	]				

insert tail system/ports/wait-list adns





heandler: func [ port /local data dns  serwer client]

               [ serwer: first port

                          
 wait serwer
             
data: copy serwer
;data: make string! 10000
;read-io serwer data 10000
print ["data1" to-binary data]

dns: to-tuple copy/part skip to-binary  data 4 4  

insert adns dns ;print dns name



either find black-lista dns [ close serwer  print "firtled" print 
read join dns:// dns ]
                           
                            [ print "new connetion"

insert serwer  join #{005A} [debase/base  skip to-hex serwer/port-id 
4 16 to-binary dns ] 


client: make port! [ scheme: 'tcp 
                     host: system/words/proxy/host
                     port-id: system/words/proxy/port
]



;insert tail system/ports/timeout-list client

      open/no-wait/binary/async/direct client :response


client/sub-port: serwer





insert tail system/ports/wait-list  client

client/date: data

serwer/sub-port: client

serwer/awake: :request









] 



       false         
]




request: func [ port /local data  f ] 

              [ data: make string! 10000
               read-io port data 10000


if f: find data "GET /favicon.ico" [ insert port "HTTP/1.1 404 Not 
Found" 
                                      print "favicon.ico"]
 


                either (data <> {}) and not f [     print [ "data3" data  ]
                              

                                if error? try [    write-io port/sub-port data length? data ][ print 
                                "error: close serwer"]
                                   ; insert port/sub-port data 
]

                            [  close port 

                              remove find system/ports/wait-list port port
                               close port/sub-port

                              remove find system/ports/wait-list port/sub-port port/sub-port
                              print "close connetion client"

                               print length? system/ports/wait-list
                               ]

               false]




       
   


  
response: func [ port e a /local data  f  ] 

               [  switch e [ open [ insert port port/date ]
                                    
                             read [ data: copy/part port a

                                   either ( a <> 8 ) [write-io port/sub-port data length? data] 

                                                     [  insert tail system/ports/wait-list  port/sub-port ]
                                    ]
                                     
                             close [ close port 

                                     remove find system/ports/wait-list port port
                                     close port/sub-port

                                     remove find system/ports/wait-list port/sub-port port/sub-port

                                       print "close connetion serwer"

                                      print length? system/ports/wait-list]
 

                          ]   ]


start: func [] [

conn: make port! tcp://:800

conn/awake: :heandler

set-modes conn [no-wait: false]

insert tail system/ports/wait-list  conn

open/no-wait/direct/binary conn ]


stop: func [][ close conn
               remove find system/ports/wait-list conn]

set-proxy: func [ h p ] [ proxy/host: h
                          proxy/port: p ]
                          


print "proxy"

lay:  layout [ backdrop blue
              across  h3  red "PROXY" f: field 145 
              return
              button green "start" [ p: parse f/text  ":"
                                     remove find p "" 

                                     set-proxy  to-tuple p/1  to-integer p/2
                                     source p
                                    
                                     start]
              button  green "stop" [f/text: "" stop ] ]

view/offset lay 4x29 
halt

win-lib: make object! [	
	user-lib: load/library %user32.dll
	SetWindowText: make routine! [
		handle			[integer!]
		Title			[string!]
		return:			[integer!]
	] user-lib "SetWindowTextA"
	
	set 'WindowTitle func [
		Title [string!] 
	] [
		SetWindowText get-modes system/ports/system 'window Title
	]
]

WindowTitle "eFishAnt Ink"

or a "dynamic" object like o: make object! [data: make object! [x: 
1]]

usage:

>> o/data/x
== 1
>> o/data: make o/data [y: 5]
>> o/data/x
== 1
>> o/data/y
== 5

note: that feature can be imitated using

    make object! [#include %somedefinition.r]


when using my INCLUDE. The only trouble is, when the author of the 
script does some "nonstandard" things. Then it may not be protective 
enough, which is the case of Anton's include too, where you have 
to rely on the discipline of the original author.

spec: [
	a: 1
	block: [do [a]]
]

o1: make object! spec
o2: make object! spec
o2/a: 2
do o1/block
do o2/block

objects: []
loop 2 [
	append objects make object! [a: 1 block: [a]]
]
objects/2/a: 2
do objects/1/block ; == 2 !

The easiest rule is to write make object! copy/deep spec instead 
of make object! spec

But is this appropriate, why not just have copy/deep by default on 
make object! ?

It would be *much* better to suggest the beginners to always use 
CONTEXT instead of MAKE OBJECT! and be safe IMO

context: func [
    "Defines a unique (underived) object."
    blk [block!] "Object variables and values."
][
    make object! copy/deep blk
]

You can propose it. I'm happy to let Carl decide. I wonder if it 
might cause some confusion as it won't be an exact replacement for 
make object!, which it's just a shortcut for. It could break code 
and change behavior if substituted.

objects: []
loop 2 [
	append objects make object! [a: 1 block: [a]]
]
objects/2/a: 2
do objects/1/block ; == 2 !

I usually do that kind of thing like this:

objects: []
loop 2 [
	append objects make object! [a: 1 block: does [a]]
]
objects/2/a: 2
objects/1/block ; == 1 !

To me thats the typical copy-problem. i use 'copy in context-blocks 
too.
   make object! [a: 1 block: copy[a]]
In most cases it does not matter, as 'func copies too.
But when it goes wrong, its pretty confusing.

BrianH: do you think, that you could give a simple example using 
MAKE OBJECT! that would break using the deep copying variant of CONTEXT?

sunanda I am getting an error from the server itself!  


whenever I press download, it starts the download (shows the green 
xfer data on the bottom, and then pops up an error:  here is the 
error as reported by LDS:

make object! [
    status: [100 20 "bad cgi data"]
    data: none
    diagnostics: [9003 9003 9.8084E-2]
    supply-date: 15-Sep-2006/1:03:41
]


have any idea where that is comming from?  I try to check it out 
from the code I have... but its been sooo long, A nudge on your part 
will help me get this working much faster IMHO!

It was my first though, but block! are not shared between object!.

Or was it done for an old View version where 'make does not duplicate 
block! ???

*Then* CONTEXT starts building a new object! of its own, from the 
spec block of binded words. But it only puts the set-words (eg. chars: 
non-chars:   but *not* 'copy-word) into the new object.

is it possible to use an object variable for a VID item, such as 
obj: make object! [t: none] where I would like view layout [obj/t: 
button "hello"] in some way? it doesn't work...

As far as I know it is not possible to define new types.


Not sure that would solve your problem anyway.  A word can point 
to a value that has only *one* type (ignoring the heirarchy -- eg 
block! is also series!). So complex assertions about something would 
not be easy.


Maybe rethink the need.....Use objects to hold both a value and a 
type:
>> item: make object! [value: 'salt type: 'seasoning]
>> item/type
== seasoning
>> 'seasoning = item/type
== true

You could encapsulate that in a couple of functions and expand the 
scope (maybe make type a block with multiple values)

Adding or deleting fields in objects can be tricky if you have multiple 
references to the object:
  obj: make object! [a: 1 b: 2]
  block: copy []
  append block obj
  obj/a: 9

  probe block     ; shows the object in the block is the same as obj
  obj: [a: 7]     ; attempt to update obj to remove b

  probe block     ; the object in the block still has a 'b -- it's 
  still the original

Otherwise, the technique is fine.

Or in other words, you can't add/remove fields in objects, but you 
can clone objects, and add/remove during cloning 

>> a: make object! [b: 1 c: 2]
>> b: make a [d: 3]
>> probe b

make object! [
    b: 1
    c: 2
    d: 3
]

>> c: make object! head remove/part find third b to set-word! 'c 
2
>> probe c

make object! [
    b: 1
    d: 3
]

Just as a little helper ...

>> third b
== [b: 1 c: 2 d: 3]

hl7msg: make object! [
	msh: []
	msa: []
	pid: []
	obr: []
	obx: []
	nte: []
]

datafile: %hl7data.txt

parse-hl7msg: func [datafile [string!]
	/local segment segbl v
] [
	hl7: make hl7msg []
	trim/head/tail datafile
	append datafile {^/}
	line-rule: [copy segment to "^/" 1 skip (
			segbl: parse/all segment "|"
			either segbl/1 = "OBX" [
				insert/only tail hl7/obx skip segbl 1
			] [
				v: to-word segbl/1
				insert hl7/:v skip segbl 1
			]
		)
	]
	parse/all datafile [ some line-rule ]
	hl7
]

test: parse-hl7msg read datafile

Its strange.. I should not be needing to run a fontserver..My desktop 
is already anti-aliased with fonts and so it the rest..But rebol 
still does not display it... mmm It does load the font though..(also 
when i look with an Strace during the execute rebol does read the 
font..) it simply does not display it ..yet! ;-)

>> probe fnt1

make object! [
    name: "/usr/X11R6/lib/X11/fonts/TTF/VeraMono.ttf"
    style: none
    size: 32
    color: 0.0.0
    offset: 2x2
    space: 0x0
    align: 'center
    valign: 'center
    shadow: none
]

(local machine)

and it returns:

make object! [
    server-software: none
    server-name: none
    gateway-interface: none
    server-protocol: none
    server-port: none
    request-method: none
    path-info: none
    path-translated: none
    script-name: none
    query-string: none
    remote-host: none
    remote-addr: none
    auth-type: none
    remote-user: none
    remote-ident: none
    Content-Type: none
    content-length: none
    other-headers: []
]

With Apache 2.x (normal CGI), we have: make object! [ 
	server-software: "Apache/2.0.54 (Fedora)" 
	server-name: "localhost" 
	gateway-interface: "CGI/1.1" 
	server-protocol: "HTTP/1.1" 
	server-port: "80" 
	request-method: "GET" 
	path-info: "/sample01.rhtml" 
	path-translated: "/var/www/html/sample01.rhtml" 
	script-name: "/cgi-bin/magic.cgi" 
	query-string: "" 
	remote-host: none 
	remote-addr: "127.0.0.1" 
	auth-type: none 
	remote-user: none 
	remote-ident: none 
	Content-Type: none 
	content-length: none 
	other-headers: [
		"HTTP_HOST" "localhost" 

  "HTTP_USER_AGENT" {Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.10) 
  Gecko/20050720 Fedora/1.0.6-1.1.fc4 Firefox/1.0.6} 

  "HTTP_ACCEPT" {text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5} 
		"HTTP_ACCEPT_LANGUAGE" "en-us,en;q=0.5" 
		"HTTP_ACCEPT_ENCODING" "gzip,deflate" 
		"HTTP_ACCEPT_CHARSET" "ISO-8859-1,utf-8;q=0.7,*;q=0.7" 
		"HTTP_KEEP_ALIVE" "300" 
		"HTTP_CONNECTION" "keep-alive" 
		"HTTP_COOKIE" "PHPSESSID=7f84fd7766f23e1462fed550ecbbfda4"
	] 
]

With LiteServer and lighttpd (normal CCI and FastCGI) i have: 
make object! [
	...
	path-info: "" 
	path-translated: none 
	script-name: "/sample01.rhtml"
	...
]

And with lighttpd: 
make object! [
	...
	path-info: none 
	path-translated: none 
	script-name: "/sample01.rhtml"
	...
]

Volker means that CONSTRUCT will not evaluate the spec block, so 
there will be no explosions :)   (make object! spec-blk   does evaluate 
the contents.)

I use this for window titles

win-lib: make object! [
	
	user-lib: load/library %user32.dll

	SetWindowText: make routine! [
		handle			[integer!]
		Title			[string!]
		return:			[integer!]
	] user-lib "SetWindowTextA"
	
	set 'WindowTitle: func [
		Title [string!] 
	] [
		SetWindowText get-modes system/ports/system 'window Title
	]
	
]

I'm keen to see your findings / conclusion on this one. Nailing "memory 
leaks" early in the design is a high priority.


If the "problem" is with 'show then we can always do something simple 
like:

	show*: :show
	show: func [face [object! block!]][show* face recycle]

Not sure about the performance hit though ...

I'm probably doing something wrong here, but I get an error when 
I try do %gui.r:

Script: "RebGUI system" (25-Mar-2005)
** Script Error: Word show is protected, cannot modify
** Where: context

** Near: set 'show func [face [object! block!]] [show* face recycle]

construct: func [
    block [block!] /with object [object!]
/local nb spec values name value
][
    if not with [object: object!]
    spec: copy []
    values: copy []
    parse/all :block [
        any [
            to set-word! (nb: 0) some [
                set name set-word! (nb: nb + 1 append spec :name)
            ]
            set value skip (

                insert tail values nb insert/only tail values :value
            )
        ]
    ]
    append spec none
    object: make object spec
    foreach [nb value] values [
        loop nb [
            set in object (to-word first spec) 

                either find [true false none on off] :value [do value][:value]
            spec: next spec
        ]
    ]
    object
]

REBOL [
	Title: "SMTP daemon"
	Author: "Graham Chiu"
	Version: 0.0.1
	Date: 5/3/2005
]

install-service [
	name: 'smtp
	port-id: 25

	multi-line-end: rejoin [crlf #"." crlf]
	stop-at: crlf
	
	server: make object! [ user-data: none ]
	
	maildir: %mail/ ; store mail here
	
	save-mail: func [ data /local mailbox ][

  if not dir? mailbox: rejoin [ maildir server/user-data/email "/" 
  ] [
			if not exists? join maildir %misc/ [
				mailbox: make-dir join maildir %misc/
			]					
		]
		if not exists? join mailbox "mail.txt" [
			write join mailbox "mail.txt" "" 
		]
		write/append join mailbox "mail.txt" join crlf to-string data	
		print dehex data
	]
	
	on-new-client: has [su] [
			su: server/user-data: context [
			state: copy "command"
			email: none
	 	]
		stop-at: crlf
		write-client join "220 mail.compkarori.co.nz SMTP" crlf
	]

	smtp-rule: [
		"HELO" thru newline
			( write-client join "250 mail.compkarori.co.nz SMTP" crlf ) |
		"EHLO" thru newline
			( write-client join "500 not implemented" crlf ) |
		"MAIL" thru newline
			( write-client join "250 OK MAIL FROM" crlf) |
		"QUIT" thru newline
			( write-client join "221 Good Bye" crlf close-client) |
		"RSET" thru newline

   ( write-client join "250 OK RESET" crlf server/user-data/state: copy 
   "command" ) |
		"NOOP" thru newline
			( write-client join "250 OK NOOP" crlf ) |
		"VRFY" thru newline

   ( write-client join "252 send some mail, i'll try my best" crlf ) 
   |
		"EXPN" thru newline
			( write-client join "500 not implemented" crlf ) |
		"RCPT" [ thru "<" | thru ": " ] copy name to "@" thru newline 

   ( server/user-data/email: form name write-client join "250 OK RCPT 
   TO" crlf ) |
		"DATA" thru newline

   ( stop-at: multi-line-end server/user-data/state: copy "body" ) 
	]
	
	on-received: func [data /local su] [
		su: server/user-data
		print join "Data: " data
		switch su/state [
			"command" [
				if not parse data smtp-rule	[ 
					write-client join "500 command not understood" crlf
				]		
			]
			"body" [
				; reject if we don't have a RCPT command first
				if none? su/email [
					write-client join "500 no email address received" crlf
					stop-at: crlf
					su/state: copy "command"
					return
				]
				
				; write the body of the message somewhere

    save-mail rejoin [ "Received: from somewhere at " to-idate now newline 
    dehex data newline newline ]
				stop-at: crlf
				write-client join "250 OK MAIL received" crlf
				su/state: "command"
				su/email: none
			]	
		]
	]
]

REBOL [
	Title: "SMTP daemon"
	Author: "Graham Chiu"
	Version: 0.0.2
	Date: 5/3/2005
]

install-service [
	name: 'smtp
	port-id: 25

	multi-line-end: rejoin [crlf #"." crlf]
	stop-at: crlf
	
	server: make object! [ user-data: none ]

 clear-server: server/user-data [ state: "command" email: computer: 
 none ]
	
	maildir: %mail/ ; store mail here
	domains: [ "@compkarori.co.nz" ] ; list of accepted domains
	
	save-mail: func [ data /local mailbox ][

  if not dir? mailbox: rejoin [ maildir server/user-data/email "/" 
  ] [
			if not exists? mailbox: join maildir %misc/ [
				mailbox: make-dir join maildir %misc/
			]					
		]
		if not exists? join mailbox "mail.txt" [
			write join mailbox "mail.txt" "" 
		]
		write/append join mailbox "mail.txt" join crlf to-string data	
		; print dehex data
	]
	
	on-new-client: has [su] [
			su: server/user-data: context [
			state: copy "command"
			email: computer: none
	 	]
		stop-at: crlf
		write-client join "220 mail.compkarori.co.nz SMTP" crlf
	]

	smtp-rule: [
		"HELO" copy name thru newline
			( write-client join "250 mail.compkarori.co.nz SMTP" crlf 
				if not none? name [
					trim/head/tail name
				]
				server/user-data/computer: form name
			) |
		"EHLO" thru newline
			( write-client join "500 not implemented" crlf ) |
		"MAIL" thru newline
			( write-client join "250 OK MAIL FROM" crlf) |
		"QUIT" thru newline
			( write-client join "221 Good Bye" crlf close-client) |
		"RSET" thru newline
			( write-client join "250 OK RESET" crlf clear-server ) |
		"NOOP" thru newline
			( write-client join "250 OK NOOP" crlf ) |
		"VRFY" thru newline

   ( write-client join "252 send some mail, i'll try my best" crlf ) 
   |
		"EXPN" thru newline
			( write-client join "500 not implemented" crlf ) |

  "RCPT" [ thru "<" | thru ": " ] copy name to "@" copy domain to ">" 
  thru newline 
			( 
				either find domains domain [

     server/user-data/email: form name write-client join "250 OK RCPT 
     TO" crlf 
				][

     write-client join "553 sorry, that domain is not in my list of allowed 
     rcpthosts" crlf
					server/user-data/email: none					
				]
			) |
		"DATA" thru newline

   ( 	stop-at: multi-line-end server/user-data/state: copy "body" 
				write-client join "354 start mail input" crlf
			) 
	]
	
	on-received: func [data /local su] [
		su: server/user-data
		; print join "Data: " data
		switch su/state [
			"command" [
				if not parse data smtp-rule	[ 
					write-client join "500 command not understood" crlf
				]		
			]
			"body" [
				; reject if we don't have a RCPT command first
				if none? su/email [
					write-client join "500 no email address received" crlf
					stop-at: crlf
					su/state: copy "command"
					return
				]
				
				; write the body of the message somewhere

    save-mail rejoin [ "Received: from " su/computer " ( " su/computer 
    " [ " client/remote-ip " ]) " to-idate now newline dehex data newline 
    newline ]
				stop-at: crlf
				write-client join "250 OK MAIL received" crlf
				su/state: "command"
				su/email: none
			]	
		]
	]
]

Not used to uniserv much, but usually such things use contexts for 
services. so 
 install-service [testFunk: func [it][print it]
should be similar to
  make object![  testFunk: func [it][print it]

DideC -- your method is similar to Henrik's, and has the same limitation: 
sub-objects fields do not propagate as you'd expect.....No f2-2 field 
in 'config here:


     standard-config: make object! [f1: 1 f2: make object! [f2-1: 21 f2-2: 
     22] f3: 3]

     config-file: make object! [f1: 88 f2: make object! [f2-1: 99]]

     probe config: construct/with  third config-file standard-config

Likely because in the code, it says -- parser: make object! [[  ... 
 parse-xml: ...]]

I understand the need for efficiency, I am also mindful of completeness. 
 The DOM is a complete standard for accessing XML (and I appreciate 
that the 'O' in DOM does not necessarily mean Rebol object! :o)

About the choice of the right internal data-keeping structure: because 
we are manipulating big XML files (> 2MB), we had to find the most 
performant way to retrieve our data into a nested structure. The 
choice was block! / hash! / list! / or object! . after a few tests, 
it appears that block! is the most suitable in terms of retrieval 
time. Note that this is true only for nested structures. In case 
of one-level structures, the hash! is the most performant (see http://www.rebol.net/article/0020.html).

I was fighting today to find the best internal data format. Out of 
the tests seems object! the most performant when using nested data 
structure. hash! when not nested. but the problem with object! is 
that we cannot have a recurrent element in the  structure, like:
<aaa>
   <bbb>content</bbb>
   <bbb bbb_attrib="attrib1"></bbb>
</aaa>

because, of course, when evaluated the last definition of bbb overrides 
the others.
So, we are trying to work with hash!

We got a little diminution of the overhead comparing to XML, but 
the processing time compare to block! seems from 10 to 20% more.

I need some more tests about data retrieving in the structure to 
find the right combination;
Any suggestion is welcome !

How are people creating large xml documents where there are large 
numbers of elements and where the data is being drawn from a database.

Model the document first as a Rebol object!, and then generate the 
xml from the object?

obj-xml: make object! xml-to-object parse-xml+ read %my.xml

soapenv:Envelope: make object!

is not valid

Ok, another revision.  This has a few more methods, I may strip them 
down to read-only, as I don't need to manipulate the object though 
I left them in for completeness.

>> do http://www.ross-gill.com/r/qdom.r
connecting to: www.ross-gill.com
Script: "QuickDOM" (none)
>> doc: load-dom {<some><xml id="foo">to try</xml></some>}
>> foo: doc/get-by-id "foo"
>> foo/name
== <xml>
>> foo/value
== [
    /id "foo" 
    # "to try"
]
>> kids: foo/children
== [make object! [
        name: #
        value: "to try"
        tree: [
            # "to try"
        ]
        position: [
   ...
>> kids/1/value
== "to try"
>> doc/tree/<some>/<xml>/(#)           
== "to try"

This seems to work for me ...

obj2xml: func [ obj [object!] out [string!]
	/local o 
][
	foreach element next first obj [
		repend out [ to-tag element newline ]
		either object? o: get in obj element [
			obj2xml o out
		][
			repend out [ o newline ]
		]		
		repend out [ to-tag join "/" element newline ]
	]
]

using this 

obj2xml: func [ obj [object!] out [string!]
	/local o 
][
	foreach element next first obj [
		repend out [ to-tag element newline ]
		either object? o: get in obj element [
			obj2xml o out
		][
			repend out [ o newline ]
		]		
		repend out [ to-tag join "/" element newline ]
	]
]

>> probe obj
make object! [
    a: "testing"
    b: "again"
    c: make object! [
        d: "testing2"
        e: "again2"
        f: make object! [
            g: "testing3"
            h: "again3"
        ]
    ]
    i: "finished"
]

format-xml: func [ xml
    /local out space prev
][
    out: copy ""
    spacer: copy ""
    prev: copy </tag>
    foreach tag load/markup xml [
        either tag = find tag "/" [
            ; we have a close tag
            

            ; reduce the spacer by a tab unless the previous was an open tag
            either not tag? prev [
                ; not a tag
                remove/part spacer 4
            ][
                ; is a tag
                if prev = find prev "/" [
                    ; last was a closing tag
                    remove/part spacer 4
                ]
            ]
        ][ 
            either tag? tag [
                ; current is tag
                ; indent only if the prev is not a closing tag
                if not prev = find prev "/" [
                    insert/dup spacer " " 4
                ]
            ][
                ; is data
                insert/dup spacer " " 4 
            ]
        ]
        repend out rejoin [ spacer tag newline ]
        prev: copy tag
    ]
	view layout compose [ area (out) 400x400 ]
]

obj2xml: func [ obj [object!] out [string!]
	/local o 
][
	foreach element next first obj [
		repend out [ to-tag element ]
		either object? o: get in obj element [
			obj2xml o out
		][
			repend out any [ o copy "" ]
		]		
		repend out [ to-tag join "/" element ]
	]
]

Perhaps I'm not clear on this ....  
If I create a pharmacy object like this


pharmacy: make object! [
	name: none
	init: func [ n ][
		self/name: n
	]
]


is the init function shared by all the subsequent pharmacy instances?

so if I have

pharmacy: make object! [
	address: make addressobj [ ]
]


and the address object has objects in it ... they will be shared??

Every MAKE object! takes a spec block that is an init function, in 
effect.

One way to do init is as open code in the object....That only "inits" 
the original object, not anything MAKEd from it. But it may be useful 
in some cirumstances, and it does not become part of the object:
    o: make object! compose [print "init" (a: 99) a: 1 b: 2]

so graham... instead of doing: 


; note this is an object, context is a shortcut for make object! 
,  like func is a shortcut for make function!
addressobj: context [
	number: 666
	street: "styx lane"
	city: "pandemonium"
]
pharmacy: context [
	address: make addressobj [ ]
]

you do:

; note this is a block
addressobj: [
	number: 666
	street: "styx lane"
	city: "pandemonium"
]

pharmacy: context [
	address: context addressobj
]

>> probe load replace {#[object! [a: #[object! [b: #[object! [c: 
"%VALUE%"]]]]]]} "%VALUE%" "tadam!"
make object! [
    a: make object! [
        b: make object! [
            c: "tadam!"
        ]
    ]
]

ex:

load mold/all make object! [
    a: make object! [
        b: make object! [
            c: "tadam!"
        ]
    ]
]


will effectively create a complete duplicate of the whole object 
tree.

seems not :(

>> pharmacy: make object! [
[     name: none
[     init: func [ n ][
[          self/name: n
[         ]
[    ]
>> a: load mold/all make pharmacy []
>> probe a
make object! [
    name: none
    init: func [n][
        self/name: n
    ]
]
>> a/init "testing"
** Script Error: self has no value
** Where: init
** Near: self/name: n

Why not remove the self ? [not a metaphysical question in this context]
    ph: make object! [
        name: none
        init: func [n][
            name: n
        ]
    ]

fix-object: func [ obj [object!]
	/local prev
][
	foreach element next first obj [
		if object? o: get in obj element [
			; is object, so check to see if has value?
			either "value?" = form next first o [
				set in obj element trim/head/tail get in o 'value?	
			][
				fix-object o
			]		
		]
	]
]

this fixes up the object created by xml-to-object

so, this is an attempt to remedy this 

fix-object: func [obj [object!]
	/local o value?
] [
	foreach element next first obj [
		if object? o: get in obj element [
			; is object, so check to see if has value?
			either value?: in o 'value? [
				set in obj element trim/head/tail get value?
			] [
				fix-object o
			]
		]
		if block? o [
			foreach ob o [
				fix-object ob
			]
		]
	]
]

>> do %xml-parse.r

Script: "A more XML 1.0 compliant set of XML parsing tools." (4-Dec-2001)
>> do %xml-object.r

Script: {Convert an XML-derived block structure into objects.} (29-Sep-2001)
>> obj: first reduce xml-to-object parse-xml+ read %test.xml
>> data: second obj
== [make object! [
        xts:sports-content-set: make object! [
            sports-content: make object! [
                sports...
>> type? data
== block!
>> probe data/2/sports-content/sports-event/team/1/player/1
make object! [
    player-metadata: make object! [
        name: make object! [
            value?: ""
            first: "Matt"
            last: "Kemp"
        ]
        position-event: "8"
        player-key: "l.mlb.com-p.11965"
        status: "starter"
    ]
    player-stats: make object! [
        player-stats-baseball: make object! [
            stats-baseball-offensive: make object! [
                value?: ""
                runs-scored: "0"
                at-bats: "4"
                hits: "1"
                rbi: "2"
                bases-on-balls: "0"
                strikeouts: "0"
                singles: "1"
                doubles: "0"
                triples: "0"
                home-runs: "0"
                grand-slams: "0"
                sac-flies: "0"
                sacrifices: "0"
                grounded-into-double-play: "0"
                stolen-bases: "0"
                stolen-bases-caught: "1"
                hit-by-pitch: "0"
                average: ".271"
            ]
            stats-baseball-defensive: make object! [
                value?: ""
                errors: "0"
                errors-passed-ball: "0"
            ]
        ]
    ]
    id: "b.11965"
]

>> do http://www.ross-gill.com/r/altxml.r
connecting to: www.ross-gill.com
Script: "AltXML" (7-Jun-2009)
>> all-stats: load-xml/dom your-xml-data 
>> player: stats/get-by-id "b.11965"                        
>> his-stats: first player/get-by-tag <stats-baseball-offensive>
>> his-stats/get #hits                                          
== "1"


>> remove-each code codes: all-stats/get-by-tag <sports-content-code> 
["league" <> code/get #code-type]
== [make object! [
        name: <sports-content-code>
        space: none
        value: [
            #code-type "league" 
      ...
>> foreach code codes [probe code/get #code-name]
Major ^/      League Baseball
== "Major ^/      League Baseball"

>> google-xml: load-xml/dom clipboard:// ; copied from page
>> entries: google-xml/get-by-tag <entry>
== [make object! [
        name: <entry>
        space: none
        value: [
            #etag {"BxAUSh5RAyp7ImBq"} 
            <...
>> foreach entry entries [probe entry/get <resourceId>]
spreadsheet:key
== "spreadsheet:key"

It depends what's your input and how should look the output, but 
you can use something like that:
context [
	xml:  copy ""
	tabs: copy ""
	set 'to-xml func[node /init][
		if init [
			xml:  copy ""
			tabs: copy ""
		]
		switch/default type?/word node [
			object! [
				append tabs #"^-"
				foreach child next first node [
					append xml rejoin [tabs "<" child ">^/"]
					to-xml node/(child)
					append xml rejoin [tabs "</" child ">^/"]
				]
				remove tabs
			]
		][
			append xml rejoin [
				tabs "<" type? node ">" node "</" type? node ">^/"
			]
		]
		xml
	]
]
o: context [
	person: context [
		name: "bla"
		age:  1
	]
]


print rejoin [
	"<o>^/"
		to-xml o
	"</o>"
]

this is something I wrote a couple of years back ... maybe it will 
help

obj2xml: func [obj [object!] out [string!]
	/local o
] [
	foreach element next first obj [
		if all [ not function? o: get in obj element o] [
                        ; not a none tag
				repend out [to-tag element]
				either object? o [
					obj2xml o out
				] [
					repend out any [o copy ""]
				]
				repend out [to-tag join "/" element]
		]
	]
	out
]

opkay so we are planning on the opportinity to use a REBOL tree object! 
structure to represente SVG datas :)

Handling SVG as REBOL object! tree makes it really really easier 
to set recursivity and code writing ( as all can be exploded into 
small fonctions I hope the resulting code once terminated won't be 
so deficult to read

Currently, object! and function! types have contexts associated with 
them, and some natives (such as USE) create contexts internally as 
part of their operation.

Ports are nifty little objects.  :)  And if you just type
>> In-port
 you get back nothing, just another prompt.
>>

The interpreter does not display the internals of objects, but print 
does, so what you are seeing is the object! that is In-port.  Well, 
I'm lying...In-port is a port!  not an object!  Close but not the 
same.  ports emulate a series! wrapped in object! wrapped in enigma. 
 Or is it an object! wrapped in a series! disguised as a sphynx? 
 :)


first In-port is a REBOL reflective property feature that when you 
get it, you'll go "Ahhhh" as you step closer to the Zen of REBOL.

For fun with a really big object!  try >> print system

one solution is:

>> f: rebcode [] [add.i x x]
>> f': func [obj] [bind second :f obj f obj]
>> probe f' context [x: 3]
make object! [
    x: 6
]

>> rss/run %sqlite
!!! ERRROR:
make object! [
    code: 312
    type: 'script
    id: 'cannot-use
    arg1: 'path
    arg2: 'none!
    arg3: none
    near: [any [system/script/parent/header halt]]
    where: 'attempt
]

>> exists? path-thru http://localhost/slideshow/test.r
== false
>> probe info? http://localhost/slideshow/test.r
connecting to: localhost
make object! [
    size: 15
    date: none
    type: 'file
]
>>

and because it took me some time... there is this important difference, 
if you center faces inside plugin:
;system/version == 2.6.2.3.1

center-face: func [
    obj [object!]
    /with face [object!]
][
    if none? face [face: system/view/screen-face]
    obj/offset: max 0x0 face/size - obj/size / 2 + face/offset
    obj
]

;system/version == 2.7.5.3.1
center-face: func [

    {Center a face relative to parent (screen for windows) or a sibling 
    face.}
    obj [object!]
    /with "Center relative to a sibling face." face [object!]
][

    if none? face [face: any [obj/parent-face system/view/screen-face]]

    obj/offset: max 0x0 face/size - obj/size / 2 + either with [face/offset] 
    [0x0]
    obj
]

Hi Max, reading the %liquid.r source code from rebol.org, I've found 
a typo at line 948 : count plug/subordnates object!  (i missing in 
"subordnates").

I finally started playing around with liquid.r   Having a little 
trouble conceptually with converting code that contains objects into 
the data-flow model.  For example, I was fiddling around with a D&D 
character generator.  I have an ABILITY! object class that I'm trying 
to convert to the model now.  SUM is just a function that adds up 
all the values in a block


ability:  [[1 -5] [2 -4] [3 -4] [4 -3] [5 -3] [6 -2] [7 -2] [8 -1] 
[9 -1] [10 0] [11 0] [12 1] [13 1] [14 2] [15 2] [16 3] [17 3] [18 
4]]
ability!: make object! [
	base: 0
	modifiers: [0 0]
	total: does [base + sum modifiers]
	ability-mod: does [ability/(total)/2]
]


It may be a lot to ask, but would it be possible for someone to convert 
this to liquid, so I can actually see how one creates this kind of 
hierarchy in data flowprogramming.

-------------------------------------------------
NOTE:  

FROM NOW ON, 

every usable !plug definition that I post will be in black, to make 
it easy to differentiate from test code, and copy in your own libs.

-------------------------------------------------

	;-     glue-proc-face:
	glue-proc-face: make face [size: 100x100] 

	;-----------------
	;- !gfx-text-area
	;-----------------

 ; this class returns the area which a value, when represented as 
 a string, occupies.
	;
	; returns: a pair representing width and height
	;
	; usage:

 ;  linked only, unlabeled.  (filling this node will permanently freeze 
 it)
	;
	; inputs:
	; (1) [any!] value
	;     the first input is formed to a string, or set to ""
	;   	
	; (2) [object!:font] font to use

 ;     the test will be run with this font, irrelevant of what font 
 is currently set in the face.
	;
	; <TO DO>: add explicit support for /para facet
	;-----------------
	!gfx-text-area: make !plug [
		liquid: 0x0
		
		;-----------------
		;-    frozen?()
		;-----------------
		; plug won't do anything until you have proper linkage done.
		;-----------------
		frozen?: func [
		][
			vin ["" self/valve/type {/frozen?()}]
			vout
			(2 <> length? subordinates)
		]

		valve: make valve [
			;-----------------
			;-    process()
			;-----------------
			process: func [
				plug
				data
			][
				vin ["" self/valve/type {/process()}]
				plug/liquid: 0x0
				glue-proc-face/font: data/2
				glue-proc-face/size: 1000x1000
				glue-proc-face/text: any [
					attempt [to-string data/1]
					""
				]
				plug/liquid: size-text glue-proc-face
				
				vout
			]
			
			
		
		]
	]

For Text CGI script I get:


#!/usr/bin/rebol --cgi REBOL [ Title: "show" File: %show.r ] print 
"Content-type: text/html^/" print {Back

} print ["Script path :" system/script/path "

] print 
CGI Object :" print "

 foreach name next first system/options/cgi [ either :name = 'other-headers 
 [ print [
 name 
: 
] foreach [n v] list: system/options/cgi/:name [ print [
 n 
: " mold select list n ""] ] print "
 ][ print [
 name 
: " mold system/options/cgi/:name ""] ] ] print "
 if system/options/cgi/request-method = 

POST" [ vars: make object! decode-cgi make string! input if not empty? 
next first vars [ print " Variables passed :

 foreach name next first vars [ print [
 name 
: " mold vars/:name ""] ] print "
 ] ] print 

kernel32: make object! [ lib: load/library %kernel32.dll win32api-GetEnvironmentVariable: 
make routine! [ name [string!] buffer [string!] size [ struct! [ 
size [integer!] ] ] return: [integer!] ] lib "GetEnvironmentVariableA" 
get-env: func [name [string!] /local size][ buffer: copy "" repeat 
sp 255 [buffer: append buffer " "] size: make struct! [size [integer!]] 
reduce [length? buffer] win32api-GetEnvironmentVariable name buffer 
size trim buffer ] win32api-SetEnvironmentVariable: make routine! 
[ name [string!] value [string!] return: [integer!] ] lib "SetEnvironmentVariableA" 
set-env: func [name [string!] value [string!] ][ win32api-SetEnvironmentVariable 
name value ] ]

here's another one ...

kernel32: make object! [
lib:  load/library %msvcrt.dll

get-env: make routine! [
	varname [string!]
	return: [string!]
] lib "getenv"

put-env: make routine! [
	env-string [string!]
	return:    [integer!]
] lib "_putenv"

remove-env-var: func [name [string!]] [put-env join name "="]

env-var-exists?: func [name [string!]] [
	either "^@" = get-env name [false][true]
]

tz-set: make routine! [
	return:    [integer!]
] lib "_tzset"

free_lib: does [ free lib ]

]

## Error in [task-handler] :Make object! [
code: 500
type: 'access
id: 
'cannot-open
arg1: "/Volumes/data/che/Cheyenne/handlers/RSP.r"
arg2: 
none
arg3: none
near: [do load file]
where: 'do-cache
] !
REBOL Internal 
Error: #415

Program terminated abnormally.
This should never happen.
Contact 
www.REBOL.com with details.

considers allowing object! to define the port handler... like a feel.. 
.MUCH easier to Tweak and scan handler