first working version of search pluginsvn2git-root

svn path=/trunk/scripts/guiplugins/search-plugin/; revision=14709

2 files changed, 131 insertions, 0 deletions

diff --git a/LICENSE.txt b/LICENSE.txt
new file mode 100644
index 0000000..a56a51e
--- /dev/null
+++ b/LICENSE.txt
@@ -0,0 +1,30 @@
+This software is copyrighted by Miller Puckette and others.  The following
+terms (the "Standard Improved BSD License") apply to all files associated with
+the software unless explicitly disclaimed in individual files:
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above  
+   copyright notice, this list of conditions and the following 
+   disclaimer in the documentation and/or other materials provided
+   with the distribution.
+3. The name of the author may not be used to endorse or promote
+   products derived from this software without specific prior 
+   written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR
+BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,   
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/search-plugin.tcl b/search-plugin.tcl
new file mode 100644
index 0000000..378979b
--- /dev/null
+++ b/search-plugin.tcl
@@ -0,0 +1,101 @@
+
+package require Tk 8.5
+package require tile
+package require pd_menucommands
+
+set selected_file {}
+
+# findFiles
+# basedir - the directory to start looking in
+# pattern - A pattern, as defined by the glob command, that the files must match
+proc findFiles { basedir pattern } {
+
+    # Fix the directory name, this ensures the directory name is in the
+    # native format for the platform and contains a final directory seperator
+    set basedir [string trimright [file join [file normalize $basedir] { }]]
+    set fileList {}
+
+    # Look in the current directory for matching files, -type {f r}
+    # means ony readable normal files are looked at, -nocomplain stops
+    # an error being thrown if the returned list is empty
+    foreach fileName [glob -nocomplain -type {f r} -path $basedir $pattern] {
+        lappend fileList $fileName
+    }
+
+    # Now look for any sub direcories in the current directory
+    foreach dirName [glob -nocomplain -type {d  r} -path $basedir *] {
+        # Recusively call the routine on the sub directory and append any
+        # new files to the results
+        set subDirList [findFiles $dirName $pattern]
+        if { [llength $subDirList] > 0 } {
+            foreach subDirFile $subDirList {
+                lappend fileList $subDirFile
+            }
+        }
+    }
+    return $fileList
+}
+
+proc ui {} {
+    toplevel .searchwindow
+    wm title .searchwindow [_ "Search Window"]
+    entry .searchwindow.searchtextentry -bg white -textvar searchtext
+    bind .searchwindow.searchtextentry <Return> \
+        {search $searchtext .searchwindow.resultslistbox}
+    # TODO add history like in the find box
+    bind .searchwindow.searchtextentry <Up> {set searchtext ""}
+    listbox .searchwindow.resultslistbox -yscrollcommand ".searchwindow.yscrollbar set" \
+        -bg white -height 20 -width 40
+    scrollbar .searchwindow.yscrollbar -command ".searchwindow.resultslistbox yview"
+    bind .searchwindow.resultslistbox <<ListboxSelect>> \
+        {selectline [.searchwindow.resultslistbox get \
+                         [.searchwindow.resultslistbox curselection]]}
+    bind .searchwindow.resultslistbox <Key-Return> \
+        {menu_doc_open $::sys_libdir "$::selected_file"}
+	bind .searchwindow.resultslistbox <Double-ButtonRelease-1> \
+        {menu_doc_open $::sys_libdir "$::selected_file"}
+
+    grid .searchwindow.searchtextentry - -sticky ew
+    grid .searchwindow.resultslistbox .searchwindow.yscrollbar -sticky news
+    grid columnconfig . 0 -weight 1
+    grid rowconfig    . 1 -weight 1
+}
+proc selectline {line} {
+    set ::selected_file [string replace $line [string first ":" $line] end]
+}
+proc readfile {file varName} {
+    upvar \#0 $varName data
+    set fp [open $file]
+    set data [split [read $fp] \n]
+    close $fp
+}
+proc search {searchtext widget} {
+    $widget delete 0 end
+    foreach docfile $::allDocFiles {
+        readfile $docfile data
+        searchfile $searchtext $widget \
+            [string replace $docfile 0 [string length $::sys_libdir]]
+    }
+}
+proc searchfile {searchtext widget filename} {
+    global data
+    set n 0
+    foreach line $data {
+        if {[regexp -nocase -- $searchtext $line]} {
+            $widget insert end "$filename: $line"
+            incr n
+        }
+    }
+#    $widget insert end "Found $n lines"
+    $widget see end
+}
+
+#set sys_libdir "/home/hans/code/pure-data/trunk/pd/doc"
+set allDocFiles [findFiles $sys_libdir "*.pd"]
+#readfile $f data
+#ui
+
+set mymenu .menubar.help
+set inserthere [$mymenu index [_ "Report a bug"]]
+$mymenu insert $inserthere separator
+$mymenu insert $inserthere command -label [_ " Search"] -command ui