r3wp [groups: 83 posts: 189283]
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search

World: r3wp

[Core] Discuss core issues

Here's the source to the new 2.7.8 functions that were posted earlier 
today, for those who haven't seen it on chat. I'm posting one function 
per message so bear with me for a sec. Not posting them in !REBOL2 
because that is just for release discussion.
; Fake immediate! and internal! typesets, for documentation
immediate!: reduce [

 none! logic! integer! decimal! money! char! pair! tuple! time! date!
	datatype! word! set-word! get-word! lit-word! refinement! event!
] ; percent! typeset!
internal!: reduce [end! unset! symbol!] ; frame! handle!
resolve: func [

 "Copy context by setting values in the target from those in the source."
	target [object! port!]
	source [object! port!]

 /only from [block! integer!] "Only specific words (exports) or new 
 words in target (index to tail)"

 /all "Set all words, even those in the target that already have a 
	either only [
		from: either integer? from [

   ; Only set words in the target positioned at the number from or later
			unless positive? from [throw-error 'script 'out-of-range from]
			intersect words-of source at words-of target from
		] [

   ; Only set the words in the target that are also in the from block
			intersect words-of source intersect words-of target from
		foreach word from pick [

   [unless value? in target word [error? set/any in target word get/any 
			[error? set/any in target word get/any word]
		] not all ; See below for what this means
	] [

  either all [ ; Override all target words even if they have values
			error? set/any bind words-of source target get/any source
		] [ ; Only set target words if they aren't yet set
			foreach word intersect words-of source words-of target [

    unless value? in target word [error? set/any in target word get/any 
	also target set [source target from] none
; Note: This is native in R3 and supports module! too.

; Implementation note: INTERSECT returns the values from its first 

; and WORDS-OF returns a block of words that are bound to its argument, 
;     intersect words-of source words-of target
; returns a block of words bound to source.
single?: funco [
	"Returns TRUE if the series length is 1."

 series  [series! port! tuple! bitset! struct!] ; map! object! gob! 
][1 = length? :series]

; Note: Type spec same as LENGTH?, which also supports the extra 
types in R3
collect-words: func [

 "Collect unique words used in a block (used for context construction)."
	block [block!]
	/deep "Include nested blocks"
	/set "Only include set-words"
	/ignore "Ignore prior words"
	words [object! port! block!] "Words to ignore"
	/local rule word blk w

 deep: either deep [[path! | set-path! | lit-path! | into rule]] [any-block!]
	word: either set [set-word!] [any-word!]
	blk: []
	parse block rule: [
		set w word (insert tail blk to-word to-string w) | deep | skip
	also either ignore [
		unless block? words [words: words-of words]
		difference blk intersect blk words
	] [
		unique blk
	] (clear blk set [block words] none)
; Note: In R3 this is native, called by MAKE OBJECT!

;   The words are not supposed to be bound, thus the to-word to-string.
ascii?: funct [

 "Returns TRUE if value or string is in ASCII character range (below 
	value [string! file! email! url! tag! issue! char! integer!]
] compose [
	ascii: (charset [#"^(00)" - #"^(7F)"])

 either any-string? value [parse/all/case value [any ascii]] [value 
 < 128]
; Note: Native in R3.
latin1?: func [

 "Returns TRUE if value or string is in Latin-1 character range (below 

 value [string! file! email! url! tag! issue! char! integer!] ; Not 
][ ; R2 has Latin-1 chars and strings
	either integer? value [value < 256] [true]

; Note: Native (and more meaningful) in R3. For forwards compatibility.
invalid-utf?: funct [

 "Checks for proper UTF encoding and returns NONE if correct or position 
 where the error occurred."
	data [binary!]
	/utf "Check encodings other than UTF-8"
	num [integer!] "Bit size - positive for BE negative for LE"
] compose [
	ascii: (charset [#"^(00)" - #"^(7F)"])
	utf8+1: (charset [#"^(C2)" - #"^(DF)"])
	utf8+2: (charset [#"^(E0)" - #"^(EF)"])
	utf8+3: (charset [#"^(F0)" - #"^(F4)"])
	utf8rest: (charset [#"^(80)" - #"^(BF)"])
	switch/default any [num 8] [
		8 [ ; UTF-8
			unless parse/all/case data [(pos: none) any [
				pos: ascii | utf8+1 utf8rest |
				utf8+2 2 utf8rest | utf8+3 3 utf8rest
			]] [as-binary pos]
		16 [ ; UTF-16BE
			pos: data
			while [not tail? pos] [
				hi: first pos
				case [
					none? lo: pick pos 2 [break/return pos]
					55296 > w: hi * 256 + lo [pos: skip pos 2]  ; #{D800}
					57343 < w [pos: skip pos 2]  ; #{DFFF}
					56319 < w [break/return pos]  ; #{DBFF}
					none? hi: pick pos 3 [break/return pos]
					none? lo: pick pos 4 [break/return pos]
					56320 > w: hi * 256 + lo [break/return pos]  ; #{DC00}
					57343 >= w [pos: skip pos 4]  ; #{DFFF}
			] ; none = valid, break/return pos = invalid
		-16 [ ; UTF-16LE
			pos: data
			while [not tail? pos] [
				lo: first pos
				case [
					none? hi: pick pos 2 [break/return pos]
					55296 > w: hi * 256 + lo [pos: skip pos 2]  ; #{D800}
					57343 < w [pos: skip pos 2]  ; #{DFFF}
					56319 < w [break/return pos]  ; #{DBFF}
					none? lo: pick pos 3 [break/return pos]
					none? hi: pick pos 4 [break/return pos]
					56320 > w: hi * 256 + lo [break/return pos]  ; #{DC00}
					57343 >= w [pos: skip pos 4]  ; #{DFFF}
			] ; none = valid, break/return pos = invalid
		32 [ ; UTF-32BE
			pos: data
			while [not tail? pos] [
				if any [
					4 > length? pos
					negative? c: to-integer pos
					1114111 < c  ; to-integer #{10FFFF}
				] [break/return pos]
		-32 [ ; UTF-32LE
			pos: data
			while [not tail? pos] [
				if any [
					4 > length? pos

     negative? c: also to-integer reverse/part pos 4 reverse/part pos 
					1114111 < c  ; to-integer #{10FFFF}
				] [break/return pos]
	] [
		throw-error 'script 'invalid-arg num

; Note: Native in R3, which doesn't support or screen the /utf option 

; See http://en.wikipedia.org/wiki/Unicodefor charset/value explanations.
; Aliases copied from R3 mezz-file
ls: :list-dir
pwd: :what-dir
rm: :delete
mkdir: :make-dir

cd: func [
	"Change directory (shell shortcut function)."

 'path [file! word! path! unset! string! paren!] "Accepts %file, :variables 
 and just words (as dirs)"

 ; Workaround for R3 change in lit-word! parameters with paren! arguments
	if paren? get/any 'path [set/any 'path do path] 
	switch/default type?/word get/any 'path [
		unset! [print what-dir]
		file! [change-dir path]
		string! [change-dir to-rebol-file path]
		word! path! [change-dir to-file path]

 ] [throw-error 'script 'expect-arg reduce ['cd 'path type? get/any 

more: func [
	"Print file (shell shortcut function)."

 'file [file! word! path! string! paren!] "Accepts %file, :variables 
 and just words (as file names)"

 ; Workaround for R3 change in lit-word! parameters with paren! arguments
	if paren? :file [set/any 'file do :file] 
	print read switch/default type?/word get/any 'file [
		file! [file]
		string! [to-rebol-file file]
		word! path! [to-file file]

 ] [throw-error 'script 'expect-arg reduce ['more 'file type? get/any 
So there we are, by request. Any comments?
Any FUNCO references were left over from R2/Forward, from which this 
source was copied. It was changed to FUNC in R2.
LS won't work the same on R2 as in R3, AFAIR?
sorry, that woulc be CD and it seems it might work.
would be nice if we can the sdk to 2.7.7 ...
what about a mv function where the target isn't relative to the origin? 
would be nice
if it's of use and Dock agree, this function has just been added 
to latest cheyenne svn:
relative-path: func [src dst /local i][
		src: remove parse src "/"
		dst: remove parse get-modes dst 'full-path "/"
		if src/1 <> dst/1 [return none]					;-- requires same root

		i: 1 + length? src 
		repeat c i - 1 [if src/:c <> dst/:c [i: c break]]	
		dst: to-file at dst i
		src: at src i
		if not tail? src [loop length? src [insert dst %../]]
I think we already have something like this. It's called TO-RELATIVE-FILE.
Thanks Henrik, I wasn't aware, is this recent? still a mv function 
would be nice to have
I wrote it, I think, 2-3 years ago. BrianH refined it for R2-Forward 
and R3.
As I recall, MV isn't possible due to limitations in R2 ports, but 
I may be wrong. You would have to load the entire file into memory 
and save it at the destination. If there already is a MV function, 
then I'm wrong.
It seems that R3 doesn't have a MV function. RENAME can't be used 
for it.
as you can rename from one directory to another with a relative target, 
the mv would only need the target to be converted to relative to 
origin and it should work, no?
to-relative-file works only one way, not good
;   %/Users/alpha/
  to-relative-file %/Users/alpha/Pictures/IMG_0003.JPG
;   %Pictures/IMG_0003.JPG
  to-relative-file %/Users/                           
;   %/Users/		;this should be %../
seems that BrianH has changed it a lot. I wanted to compare a specific 
source and destination.
From the help:

Returns the relative portion of a file if in a subdirectory,
So it seems to work as advertised, but this isn't enough.
althought the definition is right "Returns the relative portion of 
a file if in a subdirectory, or the original if not." the function 
name would have suggested to me that in the secon case I get a %../ 
but no
secon -> second
Will, this is the one I did:

get-path: func [
  "Calculates the relative path between two directories."
  p1 p2 /local i p3
] [
  p1: clean-path p1
  p2: clean-path p2
  p3: copy %""
  until [
    any [
      find/match p2 p1
      not p1: first split-path p1
      not append p3 %../
  append p3 find/match p2 p1
  either p3 = %"" [%./][p3]
hmm... there's some useful stuff here.
Yeah, sorry, TO-RELATIVE-FILE doesn't do full relative, it's mostly 
a variant of CLEAN-PATH. I wrote the R2/Forward version for use in 
DevBase 2, included it in 2.7.6, then ported it to R3. It's one of 
the two functions where the flow went the other way (IN-DIR being 
the other).
It wasn't based on any preexisting function (not even yours, Henrik), 
it was in response to a real need of REBOL apps, particularly DevBase, 
where the base path is the app path. Carl considered it useful enough 
to include in 2.7.6, same as IN-DIR.
It was originally used to clean up saved file/directory preferences, 
where the default app behavior follows the portable app model: Data 
and settings going in subdirectories of the app directory. If they 
aren't subdirectories, they're absolute paths.
Money! type is nice but not nice enough...

I find it t hard to read the amount when values are large without 
the commas seperating thousands...
I know know some use periods

Has anyone created a function to format money for better display?
you mean like following, which we have for ages? :-)

>> $10'000'000
== $10000000.00
amacleod, we've been discussing FORM-DECIMAL for a while in this 
very group. Scroll up to see.
Pekr, that works but  would prefer commas...
but can you go the other way:

Thanks, Henrik, I'll have a look..
REBOL uses the French Swiss currency format (how neutral can you 
get?), but I agree that default formatting to include group separators 
in the console would be nice.
Hmmm.... http://www.articlesbase.com/banking-articles/no-deal-for-us-on-usb-names-1795473.html
Is it intended that some binaries read with LOAD, should return an 
empty block? REBOL/View 2.7.6 here.

>> load read/binary %file.dat
== #{
>> load %file.dat
== [
Depends on what's in %file.dat, the whole file, not just the beginning 
of it.
LOAD in R2 has several bugs and design flaws - not sure which is 
which - which probably can't be fixed due to compatibility.
Thanks for the input Brian. I've spent many an hour trying to figure 
out how "load" behaves.
So did I, when I was writing LOAD for R3, fixing the aforementioned 
bugs and design flaws.
Working on LOAD this week, actually. Already fixed one bug earlier, 
now working on a tricky blog request.
load in R2 has even returned a word! datatype to me !
(on a binary zip file)