Skip to content

Instantly share code, notes, and snippets.

@greggirwin
Forked from rebolek/nsource.red
Last active June 13, 2017 05:27
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save greggirwin/ab10ae521654d7f74dd4c784de6b32a2 to your computer and use it in GitHub Desktop.
Save greggirwin/ab10ae521654d7f74dd4c784de6b32a2 to your computer and use it in GitHub Desktop.
Provides source of Red native functions
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
]
]
]
@greggirwin
Copy link
Author

Tweaked a couple bits of text and added experimental action! support.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment