1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
Index: u_main.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v
retrieving revision 1.17
diff -u -w -r1.17 u_main.tk
--- u_main.tk 15 Oct 2005 23:14:28 -0000 1.17
+++ u_main.tk 20 Sep 2006 15:41:10 -0000
@@ -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,26 +406,74 @@
}
}
-proc doc_submenu {helpmenu subdir} {
- global help_top_directory pd_tearoff
- set menudir $help_top_directory/$subdir
+################## 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
+ }
+ }
- regsub -all "\\\." $subdir "" submenu
+proc doc_make_listbox {base dir count} {
+ # 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 $count %W %x %y]
+ bind $current_listbox <Double-Button-1> [list doc_double_button $dir $count %W %x %y]
+}
- 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"
+proc doc_navigate {dir count width x y} {
+ if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set dir_to_open [file join $dir $newdir]
+ if {[file isdirectory $dir_to_open]} {
+ doc_make_listbox [winfo parent $width] $dir_to_open [incr count]
+ }
+}
+
+proc doc_double_button {dir count width x y} {
+ global pd_guidir
+ if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set dir_to_open [file join $dir $newdir]
+ if {[file isdirectory $dir_to_open]} {
+ doc_navigate $dir $count $width $x $y
+ } else {
+ regsub -- $pd_guidir [file dirname $dir_to_open] "" subdir
+ set file [file tail $dir_to_open]
+ if { [catch {menu_doc_open $subdir $file} fid] } {
+ puts stderr "Could not open $pd_guidir/$subdir/$file\n"
}
+ return;
}
}
@@ -526,7 +541,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 ##############
|
