Here's a revised version of the search-plugin that Hans started:
* fixed problem with double results if a path dir was a subdir of another
* can search for phrases by using double quotes
* search for whole words or partial matches
* search for all or any terms
* better scrollbar (ttk::scrollbar)
* Google-style search history (press the down-arrow in the search box to
make it appear, Escape to make it go away)
* hacked a proc to get <control-delete> to delete previous word
Requires tcl/tk 8.5. Works best with the revised pddp docs (i.e., if you
want to search by the keywords listed you'll need them).
-Jonathan
# plugin to allow searching all the documentation using a regexp
# check the Help menu for the Search item to use it
# Bugs:
# tiny text in combobox dropdown menu on Windows
# can't interrupt long searches on Windows (never get them in Fedora 15)
# Todo:
# try to clean up user input prevent regex error messages
package require Tk 8.5
package require pd_bindings
package require pd_menucommands
namespace eval ::dialog_search:: {
variable searchtext {}
variable search_history {}
variable count {}
variable genres [list [_ "All documents"] \
[_ "Object Help Patches"] \
[_ "All About Pd"] \
[_ "Tutorials"] \
[_ "Manual"] \
[_ "Uncategorized"]
]
}
# TODO check line formatting options
# find_doc_files
# basedir - the directory to start looking in
proc ::dialog_search::find_doc_files { basedir } {
# 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 $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 $helpbrowser::doctypes] {
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
# (if it's not already in Pd's search path) and
# append any new files to the results
set nomatch [lsearch [concat [file join $::sys_libdir doc] $::sys_searchpath $::sys_staticpath] $dirName]
if { $nomatch eq "-1" } {
set subDirList [find_doc_files $dirName]
if { [llength $subDirList] > 0 } {
foreach subDirFile $subDirList {
lappend fileList $subDirFile
}
}
}
}
return $fileList
}
proc ::dialog_search::open_file { xpos ypos textwidget } {
set i [$textwidget index @$xpos,$ypos]
set range [$textwidget tag nextrange filename $i]
set filename [eval $textwidget get $range]
set range [$textwidget tag nextrange basedir $i]
set basedir [eval $textwidget get $range]
append basedir "/"
if {$filename ne ""} {
menu_doc_open $basedir $filename
}
}
# only does keywords for now-- maybe expand this to handle any meta tags
proc ::dialog_search::grab_metavalue { xpos ypos textwidget } {
# offset y to correct for tag indention-- not sure why it has to be so
# large...
set xpos_offset 20
set xpos [expr {$xpos + $xpos_offset}]
set i [$textwidget index @$xpos,$ypos]
set range [$textwidget tag prevrange metavalue $i]
set value [eval $textwidget get $range]
set text {keywords.*}
append text $value
set ::dialog_search::searchtext ""
set ::dialog_search::searchtext $text
search
}
# show/hide results based on genre
proc ::dialog_search::filter_results { combobox text } {
variable genres
set elide {}
if { [$combobox current] eq "0" } {
foreach genre $genres {
$text tag configure [join $genre "_"] -elide off
set tag [join $genre "_"]
append tag "_count"
$text tag configure $tag -elide on
}
set tag [join [lindex $genres 0] "_"]
append tag "_count"
$text tag configure $tag -elide off
} else {
foreach genre $genres {
if { [$combobox get] ne $genre } {
$text tag configure [join $genre "_"] -elide on
set tag [join $genre "_"]
append tag "_count"
$text tag configure $tag -elide on
} else {
$text tag configure [join $genre "_"] -elide off
set tag [join $genre "_"]
append tag "_count"
$text tag configure $tag -elide off
}
}
}
$combobox selection clear
focus $text
}
proc ::dialog_search::readfile {filename} {
set fp [open $filename]
set file_contents [split [read $fp] \n]
close $fp
return $file_contents
}
proc ::dialog_search::search { } {
variable searchtext
variable search_history
if {$searchtext eq ""} return
if { [lsearch $search_history $searchtext] eq "-1" } {
lappend search_history $searchtext
.search.searchtextentry configure -values $search_history
}
.search.searchtextentry selection clear
.search.searchtextentry configure -foreground gray -background gray90
.search.resultstext configure -state normal
.search.resultstext delete 0.0 end
update idletasks
do_search
# BUG? the above might cause weird bugs, so consider http://wiki.tcl.tk/1255
# and http://wiki.tcl.tk/1526
# after idle [list after 10 ::dialog_search::do_search]
}
proc ::dialog_search::do_search { } {
variable searchtext
variable count
variable genres
set count {}
foreach genre $genres {
lappend count "0"
}
set widget .search.resultstext
# Get rid of pesky leading/trailing spaces...
set formatted_searchtext [string trim $searchtext]
# ...and double spaces between terms
regsub -all {\s+} $formatted_searchtext { } formatted_searchtext
# For quoted phrases, substitute literal "\s" characters for spaces...
while { [regexp {"\m[a-zA-Z0-9\\]+\M(?: \m[a-zA-Z0-9]+\M)+"} $formatted_searchtext] } {
regsub {("\m[a-zA-Z0-9\\]+\M)\s(\m[a-zA-Z0-9]+\M)((?:\s\m[a-zA-Z0-9]+\M)*")} \
$formatted_searchtext {\1\s\2\3} formatted_searchtext
}
# ... then remove quotes
regsub -all {"(\m[a-zA-Z0-9\\]+\M)"} $formatted_searchtext {\1} formatted_searchtext
foreach basedir [concat [file join $::sys_libdir doc] $::sys_searchpath $::sys_staticpath] {
# 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 [file normalize $basedir]
foreach docfile [find_doc_files $basedir] {
searchfile $formatted_searchtext [readfile $docfile] $widget \
[string replace $docfile 0 [string length $basedir]] $basedir
}
}
.search.searchtextentry configure -foreground black -background white
$widget insert 0.0 " matching docs.\n"
set i 0
foreach genre $genres {
set tag [join $genre "_"]
append tag "_count"
$widget insert 0.0 [lindex $count $i] $tag
incr i
}
$widget insert 0.0 " Found "
$widget insert 0.0 "Home" "link intro"
$widget configure -state disabled
}
proc ::dialog_search::searchfile {searchtext file_contents widget filename basedir} {
variable count
variable genres
set match 0
set description ""
set keywords ""
set genre ""
set metadata ""
set title ""
set terms_to_match 1
if { $::dialog_search::matchall == 1 } {
set terms_to_match [llength [split $searchtext]]
}
if {[regexp -nocase -- ".*-help\.pd" $filename]} {
# object help
set genre 1
regsub -nocase -- "(^.*)(5.reference/)(.*)-help.pd" $filename {\1\3} title
} elseif {[regexp -nocase -- "all_about_.*\.pd" $filename]} {
regsub -nocase -- ".*all_about_(.)(.*)\.pd" $filename {\1\2} title
regsub -all -- "_" $title " " title
# all about pd
set genre 2
} elseif {[regexp -nocase -- "\.html?" $filename]} {
set title $filename
# Pd Manual (or some html page in the docs)
set genre 4
} else {
set title $filename
}
set terms [split $searchtext]
foreach term $terms {
set parsefile 1
if { $::dialog_search::matchwords == 1 } {
if {[regexp -nocase -- [join [list {\m} $term {\M}] ""] $filename]} {
incr match
set parsefile 0
}
} else {
if {[regexp -nocase -- "$term" $filename]} {
pdtk_post "matched $term against $filename\n"
incr match
set parsefile 0
}
}
if { $parsefile } {
foreach line $file_contents {
if { $::dialog_search::matchwords == 1 } {
if {[regexp -nocase -- [join [list {\m} $term {\M}] ""] $line]} {
incr match
break
}
} else {
if {[regexp -nocase -- "$term" $line]} {
incr match
break
}
}
}
}
}
if { $match >= $terms_to_match } {
set len [llength [split $searchtext]]
regexp -nocase -- "#X text \[0-9\]+ \[0-9\]+ description\[:\]? (.*?);.*" $file_contents -> description
regsub -all {[{}\\]} $description {} description
regexp -nocase -- "#X text \[0-9\]+ \[0-9\]+ keywords\[:\]? (.*?);.*" $file_contents -> keywords
regsub -all {[{}]} $keywords {} keywords
if {[regexp -nocase -- "#X text \[0-9\]+ \[0-9\]+ genre tutorial" $file_contents]} {
set genre 3
}
if { $genre eq "" } {
set genre 5
}
lset count $genre [expr [lindex $count $genre] + 1]
set genre [join [lindex $genres $genre] "_"]
lset count 0 [expr [lindex $count 0] + 1]
# print out the match results
$widget insert end "$title" "title link $genre"
$widget insert end "$filename" filename
$widget insert end "$basedir" basedir
if { $description eq "" } {
set description "No DESCRIPTION tag."
}
$widget insert end "\n$description\n" "description $genre"
if { $keywords ne "" } {
$widget insert end "Keywords:" "keywords $genre"
foreach value $keywords {
$widget insert end " " $genre
$widget insert end $value "metavalue keywords link $genre"
}
$widget insert end "\n" $genre
}
}
}
proc ::dialog_search::ok {mytoplevel} {
# this is a placeholder for the standard dialog bindings
}
proc ::dialog_search::cancel {mytoplevel} {
wm withdraw .search
}
proc ::dialog_search::open_search_dialog {mytoplevel} {
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
} else {
create_dialog $mytoplevel
}
}
proc ::dialog_search::sa { widget } {
$widget selection range 0 end
break
}
proc ::dialog_search::intro { t } {
$t configure -state normal
$t delete 0.0 end
$t insert end "Pure Data Documentation Search\n\n" homepage_title
$t insert end "Enter search terms above and " homepage_description
$t insert end "use the dropdown menu to choose a category.\n\n" homepage_description
$t insert end "You can also click on one of the tags below " homepage_description
$t insert end "to start your search.\n\n" homepage_description
$t insert end "Keywords\n" homepage_title
$t insert end "abstraction" "metavalue link keywords"
$t insert end " object itself is written in Pure Data\n" def
$t insert end "abstraction_op" "metavalue link keywords"
$t insert end " object that only makes sense in terms of" def
$t insert end " abstractions\n" def
$t insert end "analysis" "metavalue link keywords"
$t insert end " object that does analysis\n" def
$t insert end "anything_op" "metavalue link keywords"
$t insert end " store or manipulate an anything\n" def
$t insert end "array" "metavalue link keywords"
$t insert end " objects for creating and editing arrays\n" def
$t insert end "bandlimited" "metavalue link keywords"
$t insert end " objects that describe themselves as being" def
$t insert end "bandlimited\n" def
$t insert end "block_oriented" "metavalue link keywords"
$t insert end " see Matju's definition\n" def
$t insert end "canvas_op" "metavalue link keywords"
$t insert end " object whose behavior only makes sense in terms " def
$t insert end "of a canvas\n" def
$t insert end "control" "metavalue link keywords"
$t insert end " control rate objects\n" def
$t insert end "conversion" "metavalue link keywords"
$t insert end " convert from one set of units to another\n" def
$t insert end "data_structure" "metavalue link keywords"
$t insert end " objects for creating and managing data structures\n" def
$t insert end "filter" "metavalue link keywords"
$t insert end " object that filters the data\n" def
$t insert end "GUI" "metavalue link keywords"
$t insert end " objects that provide a graphical user interface\n" def
$t insert end "list_op" "metavalue link keywords"
$t insert end " object that manipulates or stores a list\n" def
$t insert end "MIDI" "metavalue link keywords"
$t insert end " objects that provide MIDI functionality\n" def
$t insert end "needs_work" "metavalue link keywords"
$t insert end " help patches under construction\n" def
$t insert end "network" "metavalue link keywords"
$t insert end " object that provides access to or sends/receives " def
$t insert end "data over a network connection.\n" def
$t insert end "nonlocal" "metavalue link keywords"
$t insert end " objects that can make nonlocal connections to " def
$t insert end "other objects (i.e., communicate with other objects " def
$t insert end "without wires\n" def
$t insert end "orphan" "metavalue link keywords"
$t insert end " help patches that can't get accessed by right-clicking" def
$t insert end {on the corresponding object (like [drawsymbol])} def
$t insert end "\n" def
$t insert end "patchfile_op" "metavalue link keywords"
$t insert end " object whose behavior only makes sense in " def
$t insert end "terms of a patchfile\n" def
$t insert end "pd_op" "metavalue link keywords"
$t insert end " object that can report on or manipulate global Pd " def
$t insert end "operation\n" def
$t insert end "ramp" "metavalue link keywords"
$t insert end " a ramp\n" def
$t insert end "random" "metavalue link keywords"
$t insert end " object outputs a random value, list, or signal\n" def
$t insert end "signal" "metavalue link keywords"
$t insert end " audiorate objects\n" def
$t insert end "soundfile" "metavalue link keywords"
$t insert end " object that can play, manipulate, and/or save a " def
$t insert end "sound file (wav, ogg, mp3, etc.)\n" def
$t insert end "storage" "metavalue link keywords"
$t insert end " objects whose main function is to store a value\n" def
$t insert end "symbol_op" "metavalue link keywords"
$t insert end " object that manipulates or stores a symbol\n" def
$t insert end "time" "metavalue link keywords"
$t insert end " objects that measure time or which the user can " def
$t insert end "use to manipulate time\n" def
$t insert end "trigonometry" "metavalue link keywords"
$t insert end " objects that provide trigonometric functionality\n" def
$t configure -state disabled
}
# hack to get <ctrl-backspace> to delete the word to the left of the cursor
proc ::dialog_search::ctrl_bksp {mytoplevel} {
set last [$mytoplevel index insert]
set first $last
while { $first > 0 } {
set char [string index [$mytoplevel get] $first-1]
set prev [string index [$mytoplevel get] $first]
if { $char eq " " && $first < $last && $prev ne " " || [$mytoplevel selection present] } { break }
incr first -1
}
incr first
$mytoplevel delete $first $last
}
proc ::dialog_search::create_dialog {mytoplevel} {
variable selected_file
variable genres
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Search"]
# style tweak: get rid of arrow so it looks like a simple entry widget
ttk::style configure Entry.TCombobox -arrowsize 0
ttk::style configure Genre.TCombobox
# widgets
ttk::combobox $mytoplevel.searchtextentry -textvar ::dialog_search::searchtext \
-font "Helvetica 12" -style "Entry.TCombobox" -cursor "xterm"
ttk::button $mytoplevel.searchbutton -text [_ "Search"] -takefocus 0 \
-command ::dialog_search::search
ttk::frame $mytoplevel.f -padding 2
ttk::combobox $mytoplevel.f.genrebox -values $genres -state readonly -style "Genre.TCombobox"
$mytoplevel.f.genrebox current 0
ttk::checkbutton $mytoplevel.f.matchall_check -text [_ "Match all terms"] \
-variable ::dialog_search::matchall
ttk::checkbutton $mytoplevel.f.matchwords_check -text [_ "Match whole words only"] \
-variable ::dialog_search::matchwords
label $mytoplevel.advancedlabel -text [_ "Advanced"] -foreground "#0000ff"
text $mytoplevel.resultstext -yscrollcommand "$mytoplevel.yscrollbar set" \
-bg white -highlightcolor blue -height 30 -wrap word -state disabled
ttk::scrollbar $mytoplevel.yscrollbar -command "$mytoplevel.resultstext yview" \
-takefocus 0
grid $mytoplevel.f.genrebox $mytoplevel.f.matchall_check \
$mytoplevel.f.matchwords_check -padx 3
grid $mytoplevel.searchtextentry -column 0 -columnspan 3 -row 0 -padx 3 -pady 2 -sticky ew
grid $mytoplevel.searchbutton -column 3 -columnspan 2 -row 0 -padx 3 -sticky ew
grid $mytoplevel.f -column 0 -columnspan 3 -row 1 -sticky ew
grid $mytoplevel.advancedlabel -column 3 -columnspan 2 -row 1 -sticky w
grid $mytoplevel.resultstext -column 0 -columnspan 4 -row 2 -sticky nsew
grid $mytoplevel.yscrollbar -column 4 -row 2 -sticky ns
grid columnconfigure $mytoplevel 0 -weight 1
grid columnconfigure $mytoplevel 4 -weight 0
grid rowconfigure $mytoplevel 2 -weight 1
# tags
$mytoplevel.resultstext tag configure title -foreground "#0000ff" -underline on \
-font "helvetica 14" -lmargin1 5 -lmargin2 5 -spacing1 5
$mytoplevel.resultstext tag configure filename -elide on
$mytoplevel.resultstext tag configure metavalue -foreground "#0000ff"
$mytoplevel.resultstext tag configure basedir -elide on
$mytoplevel.resultstext tag configure description -font "helvetica 12" \
-lmargin1 5 -lmargin2 5
$mytoplevel.resultstext tag configure homepage_title -font "helvetica 12" \
-justify center -lmargin1 5 -lmargin2 5
$mytoplevel.resultstext tag configure homepage_description \
-lmargin1 5 -lmargin2 5
$mytoplevel.resultstext tag configure keywords \
-lmargin1 5 -lmargin2 5 -font "helvetica 12"
$mytoplevel.resultstext tag configure def \
-lmargin1 5 -lmargin2 5 -font "helvetica 10"
$mytoplevel.resultstext tag configure link -foreground "#0000ff"
$mytoplevel.resultstext tag bind intro <Button-1> " ::dialog_search::intro \
$mytoplevel.resultstext "
$mytoplevel.resultstext tag bind metavalue <Button-1> " ::dialog_search::grab_metavalue %x %y \
$mytoplevel.resultstext "
$mytoplevel.resultstext tag bind title <Button-1> " ::dialog_search::open_file %x %y \
$mytoplevel.resultstext "
$mytoplevel.resultstext tag bind link <Enter> " $mytoplevel.resultstext configure \
-cursor hand2 "
$mytoplevel.resultstext tag bind link <Leave> " $mytoplevel.resultstext configure \
-cursor xterm "
# search window bindings
bind $mytoplevel.searchtextentry <Return> "$mytoplevel.searchbutton invoke"
bind $mytoplevel.searchtextentry <$::modifier-Key-BackSpace> \
"::dialog_search::ctrl_bksp $mytoplevel.searchtextentry"
bind $mytoplevel.searchtextentry <$::modifier-Key-a> \
"$mytoplevel.searchtextentry selection range 0 end; break"
bind $mytoplevel.f.genrebox <<ComboboxSelected>> "::dialog_search::filter_results \
$mytoplevel.f.genrebox $mytoplevel.resultstext"
bind $mytoplevel.f.matchall_check <Return> "$mytoplevel.searchbutton invoke"
bind $mytoplevel.f.matchwords_check <Return> "$mytoplevel.searchbutton invoke"
bind $mytoplevel.advancedlabel <Enter> "$mytoplevel.advancedlabel configure \
-cursor hand2 "
bind $mytoplevel.advancedlabel <Leave> "$mytoplevel.advancedlabel configure \
-cursor xterm "
bind $mytoplevel.advancedlabel <Button-1> \
{menu_doc_open doc/5.reference all_about_finding_objects.pd}
::pd_bindings::dialog_bindings $mytoplevel "search"
# Add state and set focus
$mytoplevel.searchtextentry insert 0 "Enter search terms"
$mytoplevel.searchtextentry selection range 0 end
# go ahead and set tags for the default genre
filter_results $mytoplevel.f.genrebox $mytoplevel.resultstext
focus $mytoplevel.searchtextentry
::dialog_search::intro $mytoplevel.resultstext
set ::dialog_search::matchall 1
set ::dialog_search::matchwords 1
}
# create the menu item on load
set mymenu .menubar.help
set inserthere [$mymenu index [_ "Report a bug"]]
$mymenu insert $inserthere separator
$mymenu insert $inserthere command -label [_ "Search"] \
-command {::dialog_search::open_search_dialog .search}
_______________________________________________
Pd-dev mailing list
[email protected]
http://lists.puredata.info/listinfo/pd-dev
