puredata-gui 0.46.7-3 / usr / lib / puredata / tcl / helpbrowser.tcl

This file is indexed.

/usr/lib/puredata/tcl/helpbrowser.tcl is in puredata-gui 0.46.7-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
package provide helpbrowser 0.1

namespace eval ::helpbrowser:: {
    variable libdirlist
    variable helplist
    variable reference_count
    variable reference_paths
    variable doctypes "*.{pd,pat,mxb,mxt,help,txt,htm,html,pdf}"

    namespace export open_helpbrowser
}

# TODO remove the doc_ prefix on procs where its not needed
# TODO rename .help_browser to .helpbrowser
# TODO enter and up/down/left/right arrow key bindings for nav

################## help browser and support functions #########################
proc ::helpbrowser::open_helpbrowser {} {
    if { [winfo exists .help_browser.frame] } {
        wm deiconify .help_browser
        raise .help_browser
    } else {
        toplevel .help_browser -class HelpBrowser
        wm group .help_browser .
        wm transient .help_browser
        wm title .help_browser [_ "Help Browser"]
        bind .help_browser <$::modifier-Key-w> "wm withdraw .help_browser"

        if {$::windowingsystem eq "aqua"} {
            .help_browser configure -menu $::dialog_menubar
        }

        wm resizable .help_browser 0 0
        frame .help_browser.frame
        pack .help_browser.frame -side top -fill both
        build_references
        make_rootlistbox .help_browser.frame
    }
}

# make the root listbox of the help browser using the pre-built lists
proc ::helpbrowser::make_rootlistbox {base} {
    variable libdirlist
    variable helplist
    # exportselection 0 looks good, but selection gets easily out-of-sync
	set current_listbox [listbox "[set b $base.root]" -yscrollcommand "$b-scroll set" \
                             -highlightbackground white -highlightthickness 5 \
                             -highlightcolor "#D6E5FC" -selectborderwidth 0 \
                             -height 20 -width 23 -exportselection 0 -bd 0]
	pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
        -side left -fill both -expand 1
    # first show the directories (for easier navigation)
    foreach item [lsort  $libdirlist] {
        $current_listbox insert end $item
    }
    # then show the (potentially) long list of patches
    foreach item [lsort $helplist] {
        $current_listbox insert end $item
    }

	bind $current_listbox <Button-1> \
        [list ::helpbrowser::root_navigate %W %x %y]
    bind $current_listbox <Key-Return> \
        [list ::helpbrowser::root_navigate %W %x %y]
	bind $current_listbox <Double-ButtonRelease-1> \
        [list ::helpbrowser::root_doubleclick %W %x %y]
	bind $current_listbox <$::modifier-Key-o> \
        [list ::helpbrowser::root_doubleclick %W %x %y]
}

# navigate into a library/directory from the root
proc ::helpbrowser::root_navigate {window x y} {
    variable reference_paths
    if {[set item [$window get [$window index "@$x,$y"]]] eq {}} {
        return
    }
    set filename $reference_paths($item)
    if {[file isdirectory $filename]} {
        make_liblistbox [winfo parent $window] $filename
    }
}

# double-click action to open the folder
proc ::helpbrowser::root_doubleclick {window x y} {
    variable reference_paths
    if {[set listname [$window get [$window index "@$x,$y"]]] eq {}} {
        return
    }
    set dir [file dirname $reference_paths($listname)]
    set filename [file tail $reference_paths($listname)]
    ::pdwindow::verbose 0 "menu_doc_open $dir $filename"
    if { [catch {menu_doc_open $dir $filename} fid] } {
        ::pdwindow::error "Could not open $dir/$filename\n"
    }
}

# make the listbox to show the first level contents of a libdir
proc ::helpbrowser::make_liblistbox {base dir} {
    variable doctypes
    catch { eval destroy [lrange [winfo children $base] 2 end] } errorMessage
    # exportselection 0 looks good, but selection gets easily out-of-sync
	set current_listbox [listbox "[set b $base.listbox0]" -yscrollcommand "$b-scroll set" \
                             -highlightbackground white -highlightthickness 5 \
                             -highlightcolor "#D6E5FC" -selectborderwidth 0 \
                             -height 20 -width 23 -exportselection 0 -bd 0]
	pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
        -side left -fill both -expand 1
	foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
        if {[glob -directory $item -nocomplain -types {f} -- $doctypes] ne "" ||
            [glob -directory $item -nocomplain -types {d} -- *] ne ""} {
            $current_listbox insert end "[file tail $item]/"
        }
    }
    foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
                                         *-{help,meta}.pd]]  {
        $current_listbox insert end [file tail $item]
	}
    $current_listbox insert end "___________________________"
    foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
                                         *.txt]]  {
        $current_listbox insert end [file tail $item]
	}
	bind $current_listbox <Button-1> \
        [list ::helpbrowser::dir_navigate $dir 1 %W %x %y]
	bind $current_listbox <Double-ButtonRelease-1> \
        [list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
	bind $current_listbox <Key-Return> \
        [list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
}

proc ::helpbrowser::doc_make_listbox {base dir count} {
    variable doctypes
    # check for [file readable]?
	# requires Tcl 8.5 but probably deals with special chars better:
	#        destroy {*}[lrange [winfo children $base] [expr {2 * $count}] end]
	if { [catch { eval destroy [lrange [winfo children $base] \
									[expr { 2 * $count }] end] } errorMessage] } {
		::pdwindow::error "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 "$b-scroll set" \
                             -highlightbackground white -highlightthickness 5 \
                             -highlightcolor "#D6E5FC" -selectborderwidth 0 \
                             -height 20 -width 23 -exportselection 0 -bd 0]
	pack $current_listbox [scrollbar "$b-scroll" -command "$current_listbox yview"] \
        -side left -fill both -expand 1
	foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
		$current_listbox insert end "[file tail $item]/"
    }
	foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
                                         $doctypes]]  {
		$current_listbox insert end [file tail $item]
	}
	bind $current_listbox <Button-1> \
        "::helpbrowser::dir_navigate {$dir} $count %W %x %y"
    bind $current_listbox <Key-Right> \
        "::helpbrowser::dir_navigate {$dir} $count %W %x %y"
	bind $current_listbox <Double-ButtonRelease-1> \
        "::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
    bind $current_listbox <Key-Return> \
        "::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
}

# navigate into an actual directory
proc ::helpbrowser::dir_navigate {dir count window x y} {
    if {[set newdir [$window get [$window index "@$x,$y"]]] eq {}} {
        return
    }
    set dir_to_open [file join $dir $newdir]
    if {[file isdirectory $dir_to_open]} {
        doc_make_listbox [winfo parent $window] $dir_to_open [incr count]
    }
}

proc ::helpbrowser::dir_doubleclick {dir count window x y} {
    if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
        return
    }
    if { [catch {menu_doc_open $dir $filename} fid] } {
        ::pdwindow::error "Could not open $dir/$filename\n"
    }
}

proc ::helpbrowser::rightclickmenu {dir count window x y} {
    if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
        return
    }
    if { [catch {menu_doc_open $dir $filename} fid] } {
        ::pdwindow::error "Could not open $dir/$filename\n"
    }
}

#------------------------------------------------------------------------------#
# build help browser trees

# TODO check file timestamp against timestamp of when tree was built

proc ::helpbrowser::findfiles {basedir pattern} {
    set basedir [string trimright [file join [file normalize $basedir] { }]]
    set filelist {}

    # Look in the current directory for matching files, -type {f r}
    # means ony readable normal files are looked at, -nocomplain stops
    # an error being thrown if the returned list is empty
    foreach filename [glob -nocomplain -type {f r} -path $basedir $pattern] {
        lappend filelist $filename
    }

    foreach dirName [glob -nocomplain -type {d  r} -path $basedir *] {
        set subdirlist [findfiles $dirName $pattern]
        if { [llength $subdirlist] > 0 } {
            foreach subdirfile $subdirlist {
                lappend filelist $subdirfile
            }
        }
    }
    return $filelist
}

proc ::helpbrowser::add_entry {reflist entry} {
    variable libdirlist
    variable helplist
    variable reference_paths
    variable reference_count
    set entryname [file tail $entry]
    # if we are checking libdirs, then check to see if there is already a
    # libdir with that name that has been discovered in the path.  If so, dump
    # a warning. The trailing slash on $entryname is added below when
    # $entryname is a dir
    if {$reflist eq "libdirlist" && [lsearch -exact $libdirlist $entryname/] > -1} {
        ::pdwindow::error "WARNING: duplicate '$entryname' library found!\n"
        ::pdwindow::error "  '$reference_paths($entryname/)' is active\n"
        ::pdwindow::error "  '$entry' is duplicate\n"
        incr reference_count($entryname)
        append entryname "/ ($reference_count($entryname))"
    } else {
        set reference_count($entryname) 1
        if {[file isdirectory $entry]} {
            append entryname "/"
        }
    }
    lappend $reflist $entryname
    set reference_paths($entryname) $entry
}

proc ::helpbrowser::build_references {} {
    variable libdirlist {" Pure Data/" "-----------------------"}
    variable helplist {}
    variable reference_count
    variable reference_paths

    array set reference_count {}
    array set reference_paths [list \
                                   " Pure Data/" $::sys_libdir/doc \
                                   "-----------------------" "" \
                                  ]
    foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
        if { ! [file isdirectory $pathdir]} {continue}
        # Fix the directory name, this ensures the directory name is in the
        # native format for the platform and contains a final directory seperator
        set dir [string trimright [file join [file normalize $pathdir] { }]]
        ## find the libdirs
        foreach filename [glob -nocomplain -type d -path $dir "*"] {
            add_entry libdirlist $filename
        }
        ## find the stray help patches
        foreach filename [glob -nocomplain -type f -path $dir "*-help.pd"] {
            add_entry helplist $filename
        }
    }
}

APT Browse - Built by Thomas Orozco.