Index: u_main.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v retrieving revision 1.7.2.4 diff -u -w -r1.7.2.4 u_main.tk --- u_main.tk 21 Feb 2005 04:20:20 -0000 1.7.2.4 +++ u_main.tk 29 Dec 2005 00:53:29 -0000 @@ -24,6 +24,8 @@ # Tearoff is set to true by default: set pd_tearoff 1 + +#################### init for Windows #################### if {$pd_nt == 1} { global pd_guidir global pd_tearoff @@ -34,6 +36,7 @@ set pd_tearoff 1 } +##################### init for Mac OS X/Darwin #################### if {$pd_nt == 2} { # turn on James Tittle II's fast drawing (wait until I can test this...): # set tk::mac::useCGDrawing 1 @@ -60,6 +63,7 @@ # hack so you can easily test-run this script in linux... define pd_guidir # (which is normally defined at startup in pd under linux...) +#################### init for GNU/Linux #################### if {$pd_nt == 0} { if {! [info exists pd_guidir]} { global pd_guidir @@ -68,6 +72,15 @@ } } + +#################### init for all platforms #################### + +set help_top_directory $pd_guidir/doc +# init last help directory browsed +set help_directory $help_top_directory + + + # it's unfortunate but we seem to have to turn off global bindings # for Text objects to get control-s and control-t to do what we want for # "text" dialogs below. Also we have to get rid of tab's changing the focus. @@ -95,25 +108,15 @@ if {$pd_nt != 2} { .mbar add cascade -label "Windows" -menu .mbar.windows .mbar add cascade -label "Media" -menu .mbar.audio -# a menu on the main menubar named $whatever.help while be treated -# as a special menu with specific behaviors on different platforms. -# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm - menu .mbar.help -tearoff $pd_tearoff - .mbar add cascade -label "Help" -menu .mbar.help } else { menu .mbar.apple -tearoff 0 .mbar add cascade -label "Apple" -menu .mbar.apple # arrange menus according to Apple HIG .mbar add cascade -label "Media" -menu .mbar.audio .mbar add cascade -label "Window" -menu .mbar.windows -# a menu on the main menubar named "$whatever.help" while be treated -# as a special menu with specific behaviors on different platforms. -# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm -# Apple doesn't allow cascading menus in their Help so I had to call this -# one $mbar.docs # - menu .mbar.docs -tearoff $pd_tearoff - .mbar add cascade -label "Help" -menu .mbar.docs } +menu .mbar.help -tearoff $pd_tearoff +.mbar add cascade -label "Help" -menu .mbar.help set ctrls_audio_on 0 set ctrls_meter_on 0 @@ -371,25 +374,15 @@ } } -set help_directory $pd_guidir/doc -set help_top_directory $pd_guidir/doc - +################## menu_documentation ######################### proc menu_documentation {} { global help_directory global pd_nt global pd_guidir - if {$pd_nt == 2} { - exec rm -rf /tmp/pd-documentation - exec cp -pr $pd_guidir/doc /tmp/pd-documentation - set filename [tk_getOpenFile -defaultextension .pd \ - -filetypes { {{documentation} {.pd .txt .htm}} } \ - -initialdir /tmp/pd-documentation] - } else { set filename [tk_getOpenFile -defaultextension .pd \ - -filetypes { {{documentation} {.pd .txt .htm}} } \ + -filetypes { {{documentation} {.pd .txt .htm .html}} } \ -initialdir $help_directory] - } if {$filename != ""} { if {[string first .txt $filename] >= 0} { menu_opentext $filename @@ -411,35 +404,120 @@ set dirname $pd_guidir/$subdir + set file_type [file type $dirname/$basename] + if { $file_type == "directory" } { + pd [concat pd open [pdtk_enquote $basename] \ + [pdtk_enquote $dirname] \;] + } else { if {[regexp ".*\.(txt|c)$" $basename]} { menu_opentext $dirname/$basename + } elseif {[regexp ".*\.(pd|max)$" $basename]} { + pd [concat pd open [pdtk_enquote $basename] \ + [pdtk_enquote $dirname] \;] } elseif {[regexp ".*\.html?$" $basename]} { menu_openhtml $dirname/$basename } else { - pd [concat pd open [pdtk_enquote $basename] \ - [pdtk_enquote $dirname] \;] + menu_openhtml $dirname/$basename + } +} +} + +################## prototype help browser ######################### + +proc menu_doc_browser {dir} { + global .mbar + if {![file isdirectory $dir]} { + puts stderr "menu_doc_browser non-directory $dir\n" + } + if { [winfo exists .help_browser.frame] } { + raise .help_browser + } else { + toplevel .help_browser -menu .mbar + wm title .help_browser "Pure Documentation Browser" + frame .help_browser.frame + pack .help_browser.frame -side top -fill both + doc_make_listbox .help_browser.frame $dir 0 + } +} + +proc doc_make_listbox {base dir count} { + global pd_guidir + if {![file isdirectory $dir]} { + regsub -- $pd_guidir [file dirname $dir] "" subdir + set file [file tail $dir] + if { [catch {menu_doc_open $subdir $file} fid] } { + puts stderr "Could not open $pd_guidir/$subdir/$file\n" + } + return; + } + # check for [file readable]? + if { [info tclversion] >= 8.5 } { + # requires Tcl 8.5 but probably deals with special chars better +# destroy {expand}[lrange [winfo children $base] [expr { 2 * $count }] end] + } else { + if { [catch { eval destroy [lrange [winfo children $base] \ + [expr { 2 * $count }] end] } \ + errorMessage] } { + puts stderr "doc_make_listbox: error listing $dir\n" } } + # exportselection 0 looks good, but selection gets easily out-of-sync + set current_listbox [listbox "[set b "$base.listbox$count"]-list" -yscrollcommand \ + [list "$b-scroll" set] -height 20 -exportselection 0] + pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \ + -side left -expand 1 -fill y -anchor w + foreach item [concat [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] \ + [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- *]]] { + $current_listbox insert end "[file tail $item][expr {[file isdirectory $item] ? {/} : {}}]" + } + bind $current_listbox [list doc_navigate $dir [incr count] %W %x %y] +} -proc doc_submenu {helpmenu subdir} { - global help_top_directory pd_tearoff +proc doc_navigate {dir count width x y} { + if {[set subdir [$width get [$width index "@$x,$y"]]] eq {}} { + return + } + doc_make_listbox [winfo parent $width] [file join $dir $subdir] $count +} - set menudir $help_top_directory/$subdir - regsub -all "\\\." $subdir "" submenu +################## menu_doc_submenu ######################### +# this is a recursive function to generation a nested menu in the help menu +# which shows the complete contents of the doc directory +proc menu_doc_submenu {helpmenu base_dir sub_dir} { + global pd_tearoff + global help_top_directory + + set menu_dir $help_top_directory/$base_dir/$sub_dir + + catch { + foreach file [ lsort [ glob -nocomplain -dir $menu_dir * ] ] { + set file_type [file type $file] + regsub {.*/(.*$)} $file {\1} file_name + + # If links are going to be used then there needs to be a check to + # see if each link might cause this function to recurse forever + # + if { $file_type == "link"} { + puts stderr "Warning doc_submenu found a link: $file" + } + if { $file_type == "file" } { + # only put certain file types on the menu + if {[regexp ".*\.(htm|html|c|pd|txt|tk|pdf|wav|aif|aiff)$" $file]} { + $helpmenu add command -label $file_name \ + -command "menu_doc_open doc/$base_dir/$sub_dir $file_name" + } + } elseif { $file_type == "directory" } { + regsub -all "\\\." [string tolower $file_name] "" submenu menu $helpmenu.$submenu -tearoff $pd_tearoff - regsub -all "\\\." $subdir " " submenuname + regsub -all "\\\." $file_name " " submenuname $helpmenu add cascade -label $submenuname \ -menu $helpmenu.$submenu - -# use this glob pattern to exclude the supporting files -# foreach file [ lsort [ glob -dir $menudir {*[0-9][0-9]*} ] ] - foreach file [ lsort [ glob -dir $menudir * ] ] { - set filename "" - regsub {.*/(.*\..+$)} $file {\1} filename - $helpmenu.$submenu add command -label $filename \ - -command "menu_doc_open doc/$subdir $filename" + menu_doc_submenu $helpmenu.$submenu $base_dir/$sub_dir \ + [file tail $file] + } + } } } @@ -490,34 +568,15 @@ -command {pd pd audio-properties \;} $mbar.apple.preferences add command -label "MIDI settings..." \ -command {pd pd midi-properties \;} + } else { + $mbar.help add command -label "About Pd..." -command \ + {menu_doc_open doc/1.manual 1.introduction.txt} } - -# the "Help" menu - if {$pd_nt != 2} { -# a menu on the main menubar named "$whatever.help" while be treated -# as a special menu with specific behaviors on different platforms. -# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm - $mbar.help add command -label {About Pd} \ - -command {menu_doc_open doc/1.manual 1.introduction.txt} - $mbar.help add command -label {Pure Documentation...} \ - -command {menu_documentation} - # add menu items for each section instead of using Pd patches - $mbar.help add separator - set helpmenuname help - } else { -# Apple doesn't allow cascading menus in their Help so I had to call this -# one "docs" - set helpmenuname docs - } - - $mbar.$helpmenuname add command -label {1 manual...} \ + $mbar.help add command -label {Pure Documentation Browser} \ + -command {menu_doc_browser $help_top_directory} + $mbar.help add command -label {Pd Manual} \ -command {menu_doc_open doc/1.manual index.htm} - doc_submenu $mbar.$helpmenuname 2.control.examples - doc_submenu $mbar.$helpmenuname 3.audio.examples - doc_submenu $mbar.$helpmenuname 4.fft.examples - doc_submenu $mbar.$helpmenuname 5.reference - doc_submenu $mbar.$helpmenuname 6.externs } #################### the "File" menu for the Pd window ############## @@ -1077,15 +1136,8 @@ # a menu on the main menubar named "$whatever.help" while be treated # as a special menu with specific behaviors on different platforms. # See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm - if {$pd_nt != 2} { menu $name.m.help -tearoff $pd_tearoff $name.m add cascade -label Help -menu $name.m.help - } else { - # Apple doesn't allow cascading menus in their Help - # so I had to call this one "docs". - menu $name.m.docs -tearoff $pd_tearoff - $name.m add cascade -label Help -menu $name.m.docs - } menu_addstd $name.m