path: root/packages/patches/help_browser-0.38.4.patch

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