rebol [ title: "Function counter" file: %rebol-script-function-counter.r date: 2012-02-14 version: 1.0.0 author: "Maxim Olivier-Adlhoch" license: "public domain" library: [ level: 'intermediate platform: none type: [tool ] domain: [debug file-handling parse text-processing] tested-under: [view 2.7.8] support: none license: pd see-also: none ] ] ;---------------------------------------------------------------------------------------------------- ; ;- GLOBALS ; ;---------------------------------------------------------------------------------------------------- system-words: copy words-of system/words word-list: [] ; word count failed-reads: [] paths: none ;---------------------------------------------------------------------------------------------------- ; ;- FUNCTIONS ; ;---------------------------------------------------------------------------------------------------- ;------------------- ;- is-dir?() ;------------------- is-dir?: func [path [string! file!]][ path: to-string path replace/all path "\" "/" all [ path: find/last/tail path "/" tail? path ] ] ;----------------- ;- dir-tree() ;----------------- dir-tree: func [ path [file!] /root rootpath [file! none!] /absolute "returns absolute paths" /local list item data subpath dirpath rval ][ rval: copy [] either root [ unless exists? rootpath [ to-error rejoin [ "compiler/dir-tree()" path " does not exist" ] ] ][ either is-dir? path [ rootpath: path path: %./ ][ to-error rejoin [ "compiler/dir-tree()" path " MUST be a directory." ] ] ] dirpath: clean-path append copy rootpath path either is-dir? dirpath [ ; list directory content list: read dirpath ; append that path to the file list append rval path foreach item list [ subpath: join path item ; list content of this new path item (files are returned directly) either absolute [ data: dir-tree/root/absolute subpath rootpath ][ data: dir-tree/root subpath rootpath ] if (length? data) > 0 [ append rval data ] ] ][ if absolute [ path: clean-path join rootpath path ] ; when the path is a file, just return it, it will be compiled with the rest. rval: path ] if block? rval [ rval: new-line/all head sort rval true ] rval ] ;-------------------------- ;- ext-part() ;-------------------------- ext-part: func [ file [file! string! none!] /local ext ][ all [ file ext: find/last/tail file "." copy ext ; helps GC. ] ] ;-------------------------- ;- get-arg-paths() ;-------------------------- ; purpose: get all the paths from the command-line args ; ; returns: a block of file! items or none if no paths where found. ; ; notes: expects well formed CLI arguments, or none at all ;-------------------------- get-arg-paths: func [ /local paths args path outpaths ][ outpaths: none if args: system/script/args [ ?? args args: parse/all system/script/args " " ?? args paths: read/lines to-rebol-file args/1 ?? paths until [ if path: pick paths 1 [ if string? path [ path: to-rebol-file path ] if dir? path [ path: dirize path ] ] change paths path tail? paths: next paths ] paths: head paths outpaths: copy [] foreach path paths [ either dir? path [ append outpaths dir-tree/absolute dirize path ][ append outpaths path ] ] outpaths ] ] ;-------------------------- ;- filter-path-list() ;-------------------------- ; purpose: filter out unrequired files and directories ; ; inputs: things to use and exclude from the input paths (user selection or command-line args). ; ; returns: a new filtered block ;-------------------------- filter-path-list: func [ paths [block!] valid-extensions [string! file! block!] "List of file extensions to load scripts from, no '.' in the name. If block! is given, a list of strings is expected" invalid-path-parts [string! block! file!] "any folder or its children which has this name, is invalid. If block! is given, a list of strings is expected" invalid-paths [block! file!] "if block! is given, a list of explicit, absolute file! paths is expected" /local path pat remove? ][ paths: copy paths until [ path: first paths pat: parse/all path "/" remove?: false if any [ string? valid-extensions file? valid-extensions ][ valid-extensions: compose [(to-string valid-extensions)] ] if any [ string? invalid-path-parts file? invalid-path-parts ][ invalid-path-parts: compose [(to-string invalid-path-parts)] ] if any [ string? invalid-paths file? invalid-paths ][ invalid-paths: compose [(invalid-paths)] ] ; filter invalid path parts foreach item invalid-path-parts [ if find pat item [ remove?: true break ] ] ; filter complete ignored paths if find invalid-paths path [ ;ask ["removing path: " path ] remove?: true ] ; filter by FILENAME extension (incidently removes most dir paths) if all [ not remove? not find valid-extensions (ext-part last pat) ][ remove?: true ] either remove? [ ; removing the current item implies we are now at next item. remove paths ][ paths: next paths ] tail? paths ] head paths ] ;-------------------------- ;- count-word() ;-------------------------- ; purpose: given a single word, determine if it should be counted or not based on its type and spelling. ; ; inputs: a word (binding non-relevant) ;-------------------------- count-word: func [ word [word! path!] /local counter ][ if path? word [ word: first to-block word ] if all [ find system-words :word any-function? get/any in system/words :word ][ ;prin word either counter: find word-list :word [ change next counter add second counter 1 ][ append word-list reduce [word 1] ] ] ] ;-------------------------- ;- count-words() ;-------------------------- ; purpose: counts the occurence of system function words in files ; ; inputs: a list of files to scan ; ; returns: word-count block consisting of word and its occurences in all files ;-------------------------- count-words: func [ "counts the occurence of system function words in files" paths [block!] "a block of file! paths to scan for words... directories are ignored." ][ rule: [ some [ set val word! ( count-word val ) | set val path! (count-word val) | into rule | skip ] ] failed-reads: copy [] foreach path paths [ path: clean-path path print [ "counting: " path] either all [ not is-dir? path ; just in case exists? path script: attempt [load/all path] ][ parse script rule ][ print " file read failed!" append failed-reads path ] ] ;---------------------------- ; cleanup results ;---------------------------- sort/skip/compare/reverse word-list 2 2 ; sort by count, highest count first new-line/skip word-list true 2 ; setup the data as two columns ] ;---------------------------------------------------------------------------------------------------- ; ;- SETUP ; ;---------------------------------------------------------------------------------------------------- exclude-path-parts: [ "distribution" "distributions" "backup" "libs-backup" "encap"] exclude-paths: [%/c/dev/projects/glass/encap/glass-package-source.r] file-types: [ "r" "r3" ] ; uncomment if you want to specify the list directly within the script ;paths: dir-tree/absolute clean-path %./ ;---------------------------------------------------------------------------------------------------- ; ;- MAIN EXECUTION ; ;---------------------------------------------------------------------------------------------------- ;---------------------------- ;- generate file list ;---------------------------- unless paths [ unless paths: get-arg-paths [ if (path: request-file/only/keep/title/file "Pick file to count, type '[dir]' as filename to list the folder itself" "open" "[dir]") [ path: to-file dehex path ;?? path either (spath: find/last/tail path "/") = %"[dir]" [ ;?? head spath clear spath path: head spath paths: dir-tree/absolute path ][ paths: reduce [path] ] ] ] ] unless paths [ halt ] paths: FILTER-PATH-LIST paths file-types exclude-path-parts exclude-paths ;---------------------------- ; accumulate & display word count for ALL files ;---------------------------- count-words paths probe word-list unless empty? failed-reads [ print "These files failed to load!:" probe new-line/all failed-reads true ] print ["^/^/Count-words:"] help count-words print ["^/^/^/try counting another file or foler, using COUNT-WORDS"] halt