Word-finder: find occurrences of any word in the toolchain source files

word-finder.red

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