-
-
Save greggirwin/ab10ae521654d7f74dd4c784de6b32a2 to your computer and use it in GitHub Desktop.
Provides source of Red native functions
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Red [ | |
Title: "Nsource - native source" | |
Purpose: "Print source for native functions" | |
Author: "Boleslav Březovský" | |
Date: "8-6-2017" | |
] | |
indent: func [ | |
"(Un)indent text by tab" | |
string [string!] "Text to (un)indent" | |
value [integer!] "Positive vales indent, negative unindent" | |
/space "Use spaces instead of tabs (default is 4)" | |
/size "Tab size in spaces" | |
sz [integer!] | |
; NOTE: Unindent automaticaly detects tabs/spaces, but for different size than 4, | |
; /size refinement must be used (TODO: autodetect space size?) | |
; | |
; Zero value does automatic unindentation based on first line | |
] [ | |
out: make string! length? string | |
indent?: positive? value ; indent or unindent? | |
ending?: equal? newline back tail string ; is there newline on end? | |
unless size [sz: 4] | |
tab: either any [space not positive? value] [append/dup copy "" #" " sz] [#"^-"] | |
if zero? value [ | |
parse string [ | |
; NOTE: The rule will accept comination of tabs and spaces. | |
; Probably not a good thing, maybe it can be detected somehow. | |
some [ | |
tab (value: value - 1) | |
| #"^-" (value: value - 1) | |
| break | |
] | |
to end | |
] | |
] | |
data: split string newline | |
foreach line data [ | |
loop absolute value [ | |
case [ | |
; indent | |
indent? [insert line tab] | |
; unindent | |
all [not indent? equal? first line #"^-"] [remove line] | |
all [not indent? equal? copy/part line sz tab] [remove/part line sz] | |
] | |
] | |
; process output | |
append out line | |
append out newline | |
] | |
unless ending? [remove back tail out] ; there wasn't newline on end, remove current | |
out | |
] | |
entab: function [ | |
"Replace spaces at line start with tabs (default size is 4)" | |
string [string!] | |
/size "Number of spaces per tab" | |
sz [integer!] | |
] [ | |
spaces: append/dup clear "" #" " either size [sz] [4] | |
parse string [some [some [change spaces #"^-"] thru newline]] | |
string | |
] | |
detab: function [ | |
"Replace tabs at line start with spaces (default size is 4)" | |
string [string!] | |
/size "Number of spaces per tab" | |
sz [integer!] | |
] [ | |
spaces: append/dup clear "" #" " either size [sz] [4] | |
parse string [some [some [change #"^-" spaces] thru newline]] | |
string | |
] | |
match-bracket: function [ | |
string [string!] | |
] [ | |
mark: none | |
level: 0 | |
slevel: 0 | |
subrule: [fail] | |
string-char: complement charset [#"^""] | |
mstring-char: complement charset [#"{" #"}"] | |
string-rule: [ | |
#"^"" | |
some [ | |
{^^"} | |
| [#"^"" break] | |
| string-char | |
] | |
] | |
mstring-rule: [ ; multiline string | |
#"{" (slevel: slevel + 1) | |
some [ | |
#"{" (slevel: slevel + 1) | |
| [#"}" (slevel: slevel - 1 subrule: either zero? slevel [[break]] [[fail]]) subrule] | |
| mstring-char | |
] | |
] | |
parse string [ | |
some [ | |
{#"["} ; ignore char! | |
| {#"]"} ; ignore char! | |
| #"[" (level: level + 1) | |
| #"]" (level: level - 1 subrule: either zero? level [[break]] [[fail]]) subrule | |
| string-rule | |
| mstring-rule | |
| skip | |
] | |
mark: | |
] | |
mark | |
] | |
nsource: function [ | |
'word | |
] [ | |
type: type? get word | |
if any [type = native! type = action!] [ | |
runtime-link: rejoin [ | |
https://raw.githubusercontent.com/red/red/master/runtime/ type %s.reds | |
] | |
env-link: rejoin [ | |
https://raw.githubusercontent.com/red/red/master/environment/ type %s.red | |
] | |
; Red/System source | |
sources: read runtime-link | |
run-word: append form word #"*" | |
src: next find/reverse find sources run-word newline ; find source and go back to line start | |
spec: match-bracket find src #"[" ; skip spec | |
end: match-bracket find spec #"[" ; skip body | |
src: copy/part src end ; copy func source | |
; Red header | |
headers: read env-link | |
hdr: find headers head append form word #":" | |
end: back match-bracket spec: next find hdr #"[" ; get spec | |
spec: copy/part next spec end ; copy func source | |
if equal? newline spec/1 [remove spec] | |
; output | |
print [ | |
uppercase form word "is" mold type "so its source is not available." newline | |
newline | |
"Here is the latest version of its Red/System source code" newline | |
"which may or may not be the same version as you are using" newline | |
newline | |
"Native specs:" newline | |
newline | |
indent spec 0 | |
newline | |
"Native Red/System source:" newline | |
newline | |
indent src 0 | |
newline | |
] | |
] | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Tweaked a couple bits of text and added experimental
action!
support.