[PD-cvs] packages/patches help_browser-0.38.4.patch, NONE, 1.1 extended-help-menu.patch, 1.3, NONE
Hans-Christoph Steiner
eighthave at users.sourceforge.net
Thu Dec 29 02:00:30 CET 2005
Update of /cvsroot/pure-data/packages/patches
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13293
Added Files:
help_browser-0.38.4.patch
Removed Files:
extended-help-menu.patch
Log Message:
ditched the help menu hack and finally wrote a help browser in Tk
--- extended-help-menu.patch DELETED ---
--- NEW FILE: 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 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 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 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 at.or.at>
- 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". <hans at at.or.at>
- menu $name.m.docs -tearoff $pd_tearoff
- $name.m add cascade -label Help -menu $name.m.docs
- }
menu_addstd $name.m
More information about the Pd-cvs
mailing list