Skip to content

Instantly share code, notes, and snippets.

@meijeru
Last active April 6, 2020 09:06
Show Gist options
  • Save meijeru/2665add5f9e72378c7ffdb3fda3adddf to your computer and use it in GitHub Desktop.
Save meijeru/2665add5f9e72378c7ffdb3fda3adddf to your computer and use it in GitHub Desktop.
Word-finder: find occurrences of any word in the toolchain source files
Red [
Title: "Word finder"
Purpose: {Find occurrences of words in the source files
of the Red toolchain and display them}
Author: "Rudolf W. MEIJER"
File: %word-finder.red
Needs: 'View
Rights: "Copyright (c) 2019 Rudolf W. MEIJER"
History: [
[0.0 23-Jan-2019 {Start of project}]
[0.1 24-Jan-2019 {Proof of concept}]
[0.2 25-Jan-2019 {First working version}]
[0.3 25-Jan-2019 {Tested on actual toolchain}]
[0.4 26-Jan-2019 {First version for publication}]
]
Notes: {Inspired by comparable work of @toomasv and @hiiamboris
and using my own previous work on the red-concordance}
Language: 'English
Tabs: 4
] ; end prologue
;---|----1----|----2----|----3----|----4----|----5----|----6----|----7----|-
;---------------------------------------------------------------------------
; constants
;---------------------------------------------------------------------------
delim: charset " ^-[](){}':/;^"#" ; used by high-light
;---------------------------------------------------------------------------
; choose files and folders that are to be ignored from the Red sources
; as stored in the red-sources-dir folder
;---------------------------------------------------------------------------
ignore-sources: [
%github/
%build/
%docs/
%environment/console/GUI/old/
%quick-test/
%system/assets/
%system/formats/
%system/library/
%system/targets/
%system/tests/
%system/utils/
%tests/
] ; end ignore-sources
;---------------------------------------------------------------------------
; globals
;---------------------------------------------------------------------------
red-sources-dir: what-dir ; to be set by user
nr-sources: 0 ; calculated by index-sources
word-index: make map! 12000 ; filled by analyze
source-pos: 1 ; used by high-light
;---------------------------------------------------------------------------
; functions
;---------------------------------------------------------------------------
high-light: func [
{find the next (or previous) occurrence of the selected word
and set the high-light in the source-text field}
/back ; find previous
/local w ls pos line
][
w: pick word-list word-selector/selected
pos: source-pos
either back
[
while [pos <> 1][
pos: pos - 1
line: split source-text/data/:pos delim
if find line w [
source-text/selected: pos
source-pos: pos
break
]
]
][
ls: length? source-text/data
while [pos <> ls][
pos: pos + 1
line: split source-text/data/:pos delim
if find line w [
source-text/selected: pos
source-pos: pos
break
]
]
]
] ; end high-light
detab: func [
{replaces tabs by spaces, in place}
str [string!]
/size nsp "number of spaces"
/local s r
][
s: str
unless size [nsp: 4]
while [not tail? s][
either s/1 = #"^-"
[
s: change s #" "
unless zero? r: remainder index? s nsp [
s: insert/dup s #" " nsp - r
]
][
s: next s
]
]
str
] ; end detab
make-listing: func [
{prepare source-text for display in source-text field
with line numbers added and tabs replaced by spaces}
/local text line line-nr word
][
text: read/lines rejoin [
red-sources-dir pick file-selector/data file-selector/selected
]
line-nr: 0
forall text [
line: detab text/1
line-nr: line-nr + 1
insert line " "
insert line pad/left line-nr 5
]
source-text/data: text
source-pos: 1
high-light
] ; end make-listing
store: func [
w "any-word or refinement" file [file!]
/local g
][
g: to-string w
either find word-index g
[
unless find word-index/:g file [
insert tail word-index/:g file
]
][
word-index/:g: reduce [file]
]
] ; end store
analyze: func [
{recursively find words in the parsed source text of the given file}
source [any-list!] file [file!]
/local p w
][
; local function to avoid passing file argument around
p: source
while [not tail? p][
w: p/1
case [
any-word? w [
store w file
]
refinement? w [
store w file
]
any-path? w [
store first to-path w file
]
any-list? w [
analyze w file
]
map? w [
analyze body-of w file
]
]
p: next p
]
]
index-sources: func [
{***********************************************************************
Recursively check source folders and subfolders for files
and treat the .red and .reds ones; load their text, and
search it for word occurrences and store these in word-index
by means of function analyze
***********************************************************************}
pdir [file!] consider [logic!]
/local sdir files f parsed-text
][
sdir: find/tail pdir red-sources-dir ; short dir
files: read pdir
if any [not consider find ignore-sources sdir][
consider: false
]
foreach f files [
either #"/" <> last f
[
if all [
consider
find [%.red %.reds] suffix? f
not find ignore-sources rejoin [sdir f]
][
parsed-text: skip load rejoin [pdir f] 2
print ["analyzing" mold rejoin [sdir f]]
do-events/no-wait
analyze parsed-text rejoin [sdir f]
nr-sources: nr-sources + 1
]
][
index-sources rejoin [pdir f] consider
]
]
] ; end index-sources
;---------------------------------------------------------------------------
; window construction
;---------------------------------------------------------------------------
win: layout compose [
title "Word finder, by Rudolf W. MEIJER"
style label: text bold font-size 11
at 10x10 file-selector: text-list 600x95 font-name "Courier New" on-change [
make-listing
]
at 620x10 label 200 "(3) Select a file and then"
at 620x30 label 200 "step through occurrences"
at 620x80 button 80 "Prev" [high-light/back]
at 730x80 button 80 "Next" [high-light]
at 820x10 label 200 "(1) Type a search phrase"
at 820x45 search-field: field 200 font-name "Courier New" on-change [
w: word-selector/data t: search-field/text
either empty? t
[
word-selector/selected: 1
][
forall w [
if find/match w/1 t [
word-selector/selected: index? w
break
]
]
]
]
at 10x120 source-text: text-list 800x500 font-name "Courier New" ""
at 820x80 word-selector: text-list 200x540 font-name "Courier New"
at 10x630 button "Quit" [quit]
at 550x634 label 430 "(2) Select a word and then show files containing this word"
at 940x630 button 80 "Show" [
file-selector/data: select word-index pick word-list word-selector/selected
either empty? file-selector/data
[
clear source-text/data
][
file-selector/selected: 1
make-listing
]
]
]
;---------------------------------------------------------------------------
; start of program
;---------------------------------------------------------------------------
; try to establish red-sources-dir
forever [
if exists? %boot.red [break]
unless red-sources-dir: request-dir/title "Navigate to Red sources folder" [quit]
change-dir red-sources-dir
]
index-sources red-sources-dir true
word-list: sort keys-of word-index
print [length? word-list "words found in" nr-sources "source files"]
word-selector/data: copy word-list
word-selector/selected: 1
view win
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment