From 82d1e1591037c2371773466874fc28a73f1e19b2 Mon Sep 17 00:00:00 2001 From: Hans-Christoph Steiner Date: Wed, 12 Jan 2011 03:58:45 +0000 Subject: first working version of search plugin svn path=/trunk/scripts/guiplugins/search-plugin/; revision=14709 --- LICENSE.txt | 30 ++++++++++++++++ search-plugin.tcl | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 131 insertions(+) create mode 100644 LICENSE.txt create mode 100644 search-plugin.tcl 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 \ + {search $searchtext .searchwindow.resultslistbox} + # TODO add history like in the find box + bind .searchwindow.searchtextentry {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 <> \ + {selectline [.searchwindow.resultslistbox get \ + [.searchwindow.resultslistbox curselection]]} + bind .searchwindow.resultslistbox \ + {menu_doc_open $::sys_libdir "$::selected_file"} + bind .searchwindow.resultslistbox \ + {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 -- cgit v1.2.1