ported help browser to 0.39.2

svn path=/trunk/; revision=4604

2 files changed, 143 insertions, 297 deletions

diff --git a/packages/patches/help_browser-0.38.4.patch b/packages/patches/help_browser-0.38.4.patch
deleted file mode 100644
index d97ff712..00000000
--- a/packages/patches/help_browser-0.38.4.patch
+++ /dev/null
@@ -1,297 +0,0 @@
-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 # <hans@at.or.at>
--	 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 <Button-1> [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 <hans@at.or.at>
-+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
-+	    # <hans@at.or.at>
-+	    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"  <hans@at.or.at>
--		  set helpmenuname docs
--	 }
--
--	 $mbar.$helpmenuname add command -label {1 manual...} \
-+    $mbar.help add command -label {Browser...} \
-+	-command {menu_doc_browser $help_top_directory} 
-+    $mbar.help add command -label {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". <hans@at.or.at>
--		  menu $name.m.docs -tearoff $pd_tearoff
--		  $name.m add cascade -label Help -menu  $name.m.docs
--	 }
- 
-     menu_addstd $name.m
- 
diff --git a/packages/patches/help_browser-0.39.2.patch b/packages/patches/help_browser-0.39.2.patch
new file mode 100644
index 00000000..1e357c0d
--- /dev/null
+++ b/packages/patches/help_browser-0.39.2.patch
@@ -0,0 +1,143 @@
+--- u_main.tk	2006-02-21 23:31:26.000000000 -0500
++++ ../../pd-MAIN/src/u_main.tk	2005-12-31 15:55:25.000000000 -0500
+@@ -89,6 +89,8 @@
+     }
+ }
+ 
++set help_top_directory $pd_guidir/doc
++
+ # 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.
+@@ -389,41 +391,6 @@
+     }
+ }
+ 
+-set help_directory $pd_guidir/doc
+-set help_top_directory $pd_guidir/doc
+-
+-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}} } \
+-        -initialdir $help_directory]
+-    }    
+-    if {$filename != ""} {
+-        if {[string first .txt $filename] >= 0} {
+-            menu_opentext $filename
+-        } elseif {[string first .htm $filename] >= 0} {
+-                                menu_openhtml $filename
+-        } else {
+-            set help_directory [string range $filename 0 \
+-                [expr [string last / $filename ] - 1]]
+-            set basename [string range $filename \
+-                [expr [string last / $filename ] + 1] end]
+-            pd [concat pd open [pdtk_enquote $basename] \
+-                 [pdtk_enquote $help_directory] \;]
+-        }
+-    }
+-}
+-
+ proc menu_doc_open {subdir basename} {
+     global pd_guidir
+  
+@@ -439,27 +406,62 @@
+     }
+ }
+ 
+-proc doc_submenu {helpmenu subdir} {
+-         global help_top_directory pd_tearoff
+-
+-         set menudir $help_top_directory/$subdir
+ 
+-    regsub -all "\\\." $subdir "" submenu
+-
+-         menu $helpmenu.$submenu -tearoff $pd_tearoff
+-    regsub -all "\\\." $subdir " " submenuname
+-         $helpmenu add cascade -label $submenuname \
+-                  -menu $helpmenu.$submenu
+-    catch {
+-# 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"
++################## help browser and support functions #########################
++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 "Pd 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 <Button-1> [list doc_navigate $dir [incr count] %W %x %y]
++}
++
++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
+ }
+ 
+ ############# routine to add media, help, and apple menu items ###############
+@@ -526,7 +528,7 @@
+     $mbar.help add command -label {Html ...} \
+         -command {menu_doc_open doc/1.manual index.htm} 
+     $mbar.help add command -label {Browser ...} \
+-        -command {menu_documentation} 
++        -command {menu_doc_browser $help_top_directory} 
+ }
+ 
+ #################### the "File" menu for the Pd window ##############