# META NAME PdExternalsSearch # META DESCRIPTION Search for externals zipfiles on puredata.info # META AUTHOR chris@mccormick.cx # META AUTHOR zmoelnig@iem.at # ex: set setl sw=2 sts=2 et # Search URL: # http://deken.puredata.info/search?name=foobar # TODOs ## + open embedded README ## - open README on homepage (aka "More info...") ## + remove library before unzipping ## + only show valid arch ## - only show most recent version (of each arch) ## - check whether the "cd" thing during unzip works on w32 and multiple drives ## - redirect ::deken::post to ::pdwindow::post (that is: use the results pane only for results) ## + make the "add to path" thingy configurable # The minimum version of TCL that allows the plugin to run package require Tcl 8.4 9 # If Tk or Ttk is needed #package require Ttk # Any elements of the Pd GUI that are required # + require everything and all your script needs. # If a requirement is missing, # Pd will load, but the script will not. package require http 2 # try enabling https if possible if { [catch {package require tls} ] } {} else { ::tls::init -ssl2 false -ssl3 false -tls1 true ::http::register https 443 ::tls::socket } # try enabling PROXY support if possible if { [catch {package require autoproxy} ] } {} else { ::autoproxy::init if { ! [catch {package present tls} stdout] } { ::http::register https 443 ::autoproxy::tls_socket } } package require pdwindow 0.1 package require pd_menucommands 0.1 package require pd_guiprefs namespace eval ::deken:: { variable version variable installpath variable userplatform variable hideforeignarch variable hideoldversions # whether to use http:// or https:// variable protocol # results: {{title} {cmd} {description} {url} {ctxmenu}} variable results # selected: {library} {cmd} ... variable selected {} } namespace eval ::deken::preferences { variable installpath variable userinstallpath # automatically detected platform variable platform # user specified platform variable userplatform # boolean whether non-matching archs should be hidden variable hideforeignarch variable hideoldversions } namespace eval ::deken::utilities { } ## only register this plugin if there isn't any newer version already registered ## (if ::deken::version is defined and is higher than our own version) proc ::deken::versioncheck {version} { if { [info exists ::deken::version ] } { set v0 [split $::deken::version "."] set v1 [split $version "."] foreach x $v0 y $v1 { if { $x > $y } { set msg [format [_ "\[deken\] installed version \[%1\$s\] > %2\$s...skipping!" ] $::deken::version $version ] ::pdwindow::debug "${msg}\n" return 0 } if { $x < $y } { set msg [format [_ "\[deken\] installed version \[%1\$s\] < %2\$s...overwriting!" ] $::deken::version $version ] ::pdwindow::debug "$msg\n" set ::deken::version $version return 1 } } set msg [format [_ "\[deken\] installed version \[%1\$s\] == %2\$s...skipping!" ] $::deken::version $version ] ::pdwindow::debug "${msg}\n" return 0 } set ::deken::version $version return 1 } ## put the current version of this package here: if { [::deken::versioncheck 0.9.18] } { namespace eval ::deken:: { namespace export open_searchui variable winid .externals_searchui variable resultsid ${winid}.results variable infoid ${winid}.results variable platform variable architecture_substitutes variable installpath variable statustext variable statustimer variable backends variable progressvar variable progresstext variable progresstimer namespace export register } namespace eval ::deken::search:: { } ## FIXXXXME only initialize vars if not yet set set ::deken::backends {} set ::deken::installpath {} set ::deken::userplatform {} set ::deken::hideforeignarch false set ::deken::hideoldversions false set ::deken::show_readme 1 set ::deken::remove_on_install 1 set ::deken::add_to_path 0 set ::deken::keep_package 0 set ::deken::verify_sha256 1 set ::deken::searchtype name set ::deken::statustimer {} set ::deken::progresstimer {} set ::deken::preferences::installpath {} set ::deken::preferences::userinstallpath {} set ::deken::preferences::platform {} set ::deken::preferences::userplatform {} set ::deken::preferences::hideforeignarch {} set ::deken::preferences::hideoldversions {} set ::deken::preferences::show_readme {} set ::deken::preferences::remove_on_install {} set ::deken::preferences::add_to_path {} set ::deken::preferences::add_to_path_temp {} set ::deken::preferences::keep_package {} set ::deken::preferences::verify_sha256 {} set ::deken::platform(os) $::tcl_platform(os) set ::deken::platform(machine) $::tcl_platform(machine) set ::deken::platform(bits) [ expr [ string length [ format %X -1 ] ] * 4 ] set ::deken::platform(floatsize) 32 # architectures that can be substituted for each other array set ::deken::architecture_substitutes {} set ::deken::architecture_substitutes(x86_64) [list "amd64" ] set ::deken::architecture_substitutes(amd64) [list "x86_64" ] set ::deken::architecture_substitutes(i686) [list "i586" "i386"] set ::deken::architecture_substitutes(i586) [list "i386"] set ::deken::architecture_substitutes(armv6) [list "armv6l" "arm"] set ::deken::architecture_substitutes(armv6l) [list "armv6" "arm"] set ::deken::architecture_substitutes(armv7) [list "armv7l" "armv6l" "armv6" "arm"] set ::deken::architecture_substitutes(armv7l) [list "armv7" "armv6l" "armv6" "arm"] set ::deken::architecture_substitutes(PowerPC) [list "ppc"] set ::deken::architecture_substitutes(ppc) [list "PowerPC"] set ::deken::architecture_normalize(x86_64) "amd64" set ::deken::architecture_normalize(i686) "i386" set ::deken::architecture_normalize(i586) "i386" set ::deken::architecture_normalize(i486) "i386" set ::deken::architecture_normalize(armv6l) "armv6" set ::deken::architecture_normalize(armv7l) "armv7" set ::deken::architecture_normalize(PowerPC) "ppc" # normalize W32 OSs if { [ string match "Windows *" "$::deken::platform(os)" ] > 0 } { # we are not interested in the w32 flavour, so we just use 'Windows' for all of them set ::deken::platform(os) "Windows" } # normalize W32 CPUs if { "Windows" eq "$::deken::platform(os)" } { # in redmond, intel only produces 32bit CPUs,... if { "intel" eq "$::deken::platform(machine)" } { set ::deken::platform(machine) "i686" } # ... and all 64bit CPUs are manufactured by amd #if { "amd64" eq "$::deken::platform(machine)" } { set ::deken::platform(machine) "x86_64" } } catch { set ::deken::platform(machine) $::deken::architecture_normalize($::deken::platform(machine)) } set ::deken::protocol "http" if { ! [catch {package present tls} stdout] } { set ::deken::protocol "https" } # ###################################################################### # ################ compatibility ####################################### # ###################################################################### # list-reverter (compat for tcl<8.5) if {[info commands lreverse] == ""} { proc lreverse list { set res {} set i [llength $list] while {$i} { lappend res [lindex $list [incr i -1]] } set res } ;# RS } # ###################################################################### # ################ utilities ########################################## # ###################################################################### proc ::deken::utilities::bool {value {fallback 0}} { catch {set fallback [expr bool($value) ] } stdout return $fallback } proc ::deken::utilities::tristate {value {offset 0} {fallback 0} } { catch {set fallback [expr (int($value) + int($offset))% 3 ]} stdout return $fallback } proc ::deken::utilities::expandpath {path} { set map "@PD_PATH@" lappend map $::sys_libdir string map $map $path } proc ::deken::utilities::get_tmpfilename {{path ""} {ext ""} {prefix dekentmp}} { for {set i 0} {true} {incr i} { set tmpfile [file join ${path} ${prefix}.${i}${ext}] if {![file exists $tmpfile]} { return $tmpfile } } } proc ::deken::utilities::get_tmpdir {} { proc _iswdir {d} { "expr" [file isdirectory $d] * [file writable $d] } set tmpdir "" # TRASH_FOLDER: very old Macintosh. Mac OS X doesn't have this. # TMPDIR: unices # TMP, TEMP: windows # TEPMDIR: for symmetry :-) foreach {d} {TRASH_FOLDER TMPDIR TEMPDIR TEMP TMP} { if { [info exists ::env($d) ] } { set tmpdir $::env($d) if {[_iswdir $tmpdir]} {return $tmpdir} } } set tmpdir "/tmp" if {[_iswdir $tmpdir]} {return $tmpdir} set tmpdir [pwd] if {[_iswdir $tmpdir]} {return $tmpdir} } proc ::deken::utilities::is_writabledir {path} { set fs [file separator] set access [list RDWR CREAT EXCL TRUNC] set tmpfile [::deken::utilities::get_tmpfilename $path] # try creating tmpfile if {![catch {open $tmpfile $access} channel]} { close $channel file delete $tmpfile return true } return false } proc ::deken::utilities::get_writabledir {paths} { foreach p $paths { set xp [ ::deken::utilities::expandpath $p ] if { [ ::deken::utilities::is_writabledir $xp ] } { return $p } } return } proc ::deken::utilities::rmrecursive {path} { # recursively remove ${path} if it exists, traversing into each directory # to delete single items (rather than just unlinking the parent directory) set errors 0 set myname [lindex [info level 0] 0] set children [glob -nocomplain -directory $path -types hidden *] lappend children {*}[glob -nocomplain -directory $path *] foreach child $children[set children {}] { if {[file tail $child] in {. ..}} { continue } if {[file isdirectory $child]} { if {[file type $child] ne "link"} { incr errors [$myname $child] } } if { [ catch { file delete -force $child } ] } { incr errors } } return $errors } # http://rosettacode.org/wiki/URL_decoding#Tcl proc ::deken::utilities::urldecode {str} { set specialMap {"[" "%5B" "]" "%5D"} set seqRE {%([0-9a-fA-F]{2})} set replacement {[format "%c" [scan "\1" "%2x"]]} set modStr [regsub -all $seqRE [string map $specialMap $str] $replacement] encoding convertfrom utf-8 [subst -nobackslashes -novariables $modStr] } proc ::deken::utilities::verbose {level message} { ::pdwindow::verbose ${level} "\[deken\] ${message}\n" } proc ::deken::utilities::debug {message} { set winid ${::deken::winid} if {[winfo exists ${winid}.tab.info]} { ::deken::post $message debug } else { ::pdwindow::debug "\[deken\] ${message}\n" } } if { [catch {package require tkdnd} ] } { proc ::deken::utilities::dnd_init {windowid} { } } else { proc ::deken::utilities::dnd_init {windowid} { ::tkdnd::drop_target register $windowid DND_Files bind $windowid <> {::deken::utilities::dnd_drop_files %D} } proc ::deken::utilities::dnd_drop_files {files} { foreach f $files { if { [regexp -all -nocase "\.(zip|dek|tgz|tar\.gz)$" ${f} ] } { set msg [format [_ "installing deken package '%s'" ] $f] ::deken::statuspost ${msg} ::deken::install_package_from_file $f } else { set msg [format [_ "ignoring '%s': doesn't look like a deken package" ] $f] ::deken::statuspost ${msg} } } return "link" } } if { [catch {package require zipfile::decode} ] } { proc ::deken::utilities::unzipper {zipfile {path .}} { ## this is w32 only if {$::tcl_platform(platform) ne "windows"} { return 0 } ## create script-file set vbsscript [::deken::utilities::get_tmpfilename [::deken::utilities::get_tmpdir] ".vbs" ] set script { On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") 'The location of the zip file. ZipFile = fso.GetAbsolutePathName(WScript.Arguments.Item(0)) 'The folder the contents should be extracted to. ExtractTo = fso.GetAbsolutePathName(WScript.Arguments.Item(1)) 'If the extraction location does not exist create it. If NOT fso.FolderExists(ExtractTo) Then fso.CreateFolder(ExtractTo) End If 'Extract the contents of the zip file. set objShell = CreateObject("Shell.Application") set FilesInZip=objShell.NameSpace(ZipFile).items objShell.NameSpace(ExtractTo).CopyHere(FilesInZip) 'In case of an error, exit If Err.Number <> 0 Then Err.Clear WScript.Quit 1 End If Set fso = Nothing Set objShell = Nothing } if {![catch {set fileId [open $vbsscript "w"]}]} { puts $fileId $script close $fileId } if {![file exists $vbsscript]} { ## still no script, give up return 0 } ## try to call the script ## (and windows requires the file to have a .zip extension!!!) if { [ catch { set zipfilezip ${zipfile}.zip file rename ${zipfile} ${zipfilezip} exec cscript "${vbsscript}" "${zipfilezip}" . file rename ${zipfilezip} ${zipfile} } stdout ] } { catch { file rename ${zipfilezip} ${zipfile} } catch { file delete "${vbsscript}" } ::deken::utilities::debug "VBS-unzip($vbsscript): $stdout" return 0 } catch { file delete "${vbsscript}" } return 1 } } else { # successfully imported zipfile::decode proc ::deken::utilities::unzipper {zipfile {path .}} { if { [catch { ::zipfile::decode::unzipfile "${zipfile}" "${path}" } stdout ] } { ::deken::utilities::debug "unzip: $stdout" return 0 } return 1 } } proc ::deken::utilities::extract {installdir filename fullpkgfile {keep_package 1}} { if { ! [ file isdirectory "${installdir}" ] } { return 0 } ::deken::statuspost [format [_ "Installing '%s'" ] $filename ] debug set PWD [ pwd ] cd $installdir set success 1 if { [ string match *.dek $fullpkgfile ] } then { if { ! [ ::deken::utilities::unzipper $fullpkgfile $installdir ] } { if { [ catch { exec unzip -uo $fullpkgfile } stdout ] } { ::deken::utilities::debug "$stdout" set success 0 } } } elseif { [ string match *.zip $fullpkgfile ] } then { if { ! [ ::deken::utilities::unzipper $fullpkgfile $installdir ] } { if { [ catch { exec unzip -uo $fullpkgfile } stdout ] } { ::deken::utilities::debug "$stdout" set success 0 } } } elseif { [ string match *.tar.* $fullpkgfile ] || [ string match *.tgz $fullpkgfile ] } then { if { [ catch { exec tar xf $fullpkgfile } stdout ] } { ::deken::utilities::debug "$stdout" set success 0 } } cd $PWD if { $success > 0 } { ::deken::post [format [_ "Successfully unzipped %1\$s into %2\$s."] $filename $installdir ] debug if { ! "${keep_package}" } { catch { file delete $fullpkgfile } } } else { # Open both the fullpkgfile folder and the zipfile itself # NOTE: in tcl 8.6 it should be possible to use the zlib interface to actually do the unzip set msg [_ "Unable to extract package automatically." ] ::deken::post "${msg}" warn ::pdwindow::error "${msg}\n" set msg "" append msg [_ "Please perform the following steps manually:" ] append msg "\n" append msg [format [_ "1. Unzip %s." ] $fullpkgfile ] append msg "\n" if { [string match "*.dek" $fullpkgfile] } { append msg " " append msg [_ "You might need to change the file-extension from .dek to .zip" ] append msg "\n" } append msg [format [_ "2. Copy the contents into %s." ] $installdir] append msg "\n" append msg [format [_ "3. Remove %s. (optional)" ] $fullpkgfile ] append msg "\n" ::deken::post "$msg" pd_menucommands::menu_openfile $fullpkgfile pd_menucommands::menu_openfile $installdir } return $success } proc ::deken::utilities::uninstall {path library} { # recursively remove ${path}/${library} if it exists set fullpath [file join ${path} ${library}] if {[file exists ${fullpath}]} { ::deken::post [format [_ "Removing '%s'" ] ${fullpath} ] debug if { [catch { file delete -force "${fullpath}" } stdout ] } { set msg [format [_ "Uninstalling %1\$s from %2\$s failed!"] ${library} ${path}] ::deken::utilities::debug "$msg\n $stdout" return 0 } } return 1 } proc ::deken::utilities::sha256_sha256sum {filename} { set hash {} catch { set hash [lindex [exec sha256sum $filename] 0] } return $hash } proc ::deken::utilities::sha256_shasum {filename} { set hash {} catch { set hash [lindex [exec shasum -a 256 $filename] 0] } return $hash } proc ::deken::utilities::sha256_powershell {filename} { set batscript [::deken::utilities::get_tmpfilename [::deken::utilities::get_tmpdir] ".bat" ] set script { @echo off powershell -Command " & {Get-FileHash -Algorithm SHA256 -LiteralPath \"%1\" | Select-Object -ExpandProperty Hash}" } if {![catch {set fileId [open $batscript "w"]}]} { puts $fileId $script close $fileId } if {![file exists $batscript]} { ## still no script, give up return "" } if { [ catch { set hash [exec "${batscript}" "${filename}"] } stdout ] } { # ouch, couldn't run powershell script ::deken::utilities::verbose 1 "sha256.ps1 error: $stdout" set hash "" } catch { file delete "${batscript}" } return $hash } proc ::deken::utilities::sha256_msw {filename} { set hash {} catch { set hash [join [exec certUtil -hashfile $filename SHA256 | findstr /v "hash"] ""] } return $hash } if { [catch {package require sha256} ] } { proc ::deken::utilities::sha256_tcllib {filename} {} } else { proc ::deken::utilities::sha256_tcllib {filename} { set hash {} catch { set hash [::sha2::sha256 -hex -filename $filename] } return $hash } } proc ::deken::utilities::verify_sha256 {url pkgfile} { set msg [format [_ "Skipping SHA256 verification of '%s'." ] $url ] ::deken::statuspost $msg return -100 } foreach impl {sha256sum shasum powershell msw tcllib} { if { [::deken::utilities::sha256_${impl} $::argv0] ne "" } { set ::deken::utilities::sha256_implementation ::deken::utilities::sha256_${impl} proc ::deken::utilities::verify_sha256 {url pkgfile} { ::deken::statuspost [format [_ "SHA256 verification of '%s'" ] $pkgfile ] debug ::deken::syncgui set retval 1 set isremote 1 set hashfile "" # check if $url really is a local file if { [file normalize $url] eq $url } { # $url is really an absolute filename # use it, if it exists set hashfile "${url}.sha256" set isremote 0 if { [file isfile ${hashfile} ] && [file readable ${hashfile}] } { } else { set msg [format [_ "Unable to fetch reference SHA256 for '%s'." ] $url ] ::deken::utilities::verbose 0 $msg ::deken::statuspost $msg warn 0 return -10 } } else { # otherwise fetch it from the internet if { [ catch { set hashfile [::deken::utilities::download_file ${url}.sha256 [::deken::utilities::get_tmpfilename [::deken::utilities::get_tmpdir] ".sha256" ] ] } stdout ] } { ::deken::utilities::verbose 0 "${stdout}" # unable to download set msg [format [_ "Unable to fetch reference SHA256 for '%s'." ] $url ] ::deken::utilities::verbose 0 $msg ::deken::statuspost $msg warn 0 return -10 } } if { "${hashfile}" eq "" } { set retval -10 } if { [ catch { set fp [open $hashfile r] set reference [string trim [string tolower [read $fp] ] ] close $fp if { $isremote } { catch { file delete $hashfile } } # get hash of file set hash [${::deken::utilities::sha256_implementation} $pkgfile ] set hash [string trim [string tolower $hash ] ] # check if hash is sane if { [string length $hash] != 64 || ! [string is xdigit $hash] } { ::deken::statuspost [format [_ "File checksum looks invalid: '%s'." ] $hash] warn 0 } # check if reference is sane if { [string length $reference] != 64 || ! [string is xdigit $reference] } { # this is more grave than the sanity check for the file hash # (since for the file hash we depend on the user's machine being able to # produce a proper SHA256 hash) ::deken::statuspost [format [_ "Reference checksum looks invalid: '%s'." ] $reference] error 0 } if { [string first ${reference} ${hash}] >= 0 } { set retval 1 } else { # SHA256 verification failed... set retval 0 } } stdout ] } { ::deken::utilities::verbose 0 "${stdout}" # unable to verify set msg [format [_ "Unable to perform SHA256 verification for '%s'." ] $url ] ::deken::utilities::verbose 0 $msg ::deken::statuspost $msg warn 0 set retval -20 } return ${retval} } # it seems we found a working sha256 implementation, don't try the other ones... break } } proc ::deken::utilities::httpuseragent {} { set httpagent [::http::config -useragent] set pdversion "Pd/$::PD_MAJOR_VERSION.$::PD_MINOR_VERSION.$::PD_BUGFIX_VERSION$::PD_TEST_VERSION" set platformstring [::deken::platform2string] set tclversion "Tcl/[info patchlevel]" ::http::config -useragent "Deken/${::deken::version} ($platformstring) ${pdversion} $tclversion" return $httpagent } # download a file to a location # http://wiki.tcl.tk/15303 proc ::deken::utilities::download_file {url outputfilename {progressproc {}}} { set URL [string map {{[} "%5b" {]} "%5d"} $url] set downloadfilename [::deken::utilities::get_tmpfilename [file dirname $outputfilename] ] set f [open $downloadfilename w] fconfigure $f -translation binary set httpagent [::deken::utilities::httpuseragent] if { [catch { if { $progressproc eq {} } { set httpresult [::http::geturl $URL -binary true -channel $f] } else { set httpresult [::http::geturl $URL -binary true -progress ${progressproc} -channel $f] } set ncode [::http::ncode $httpresult] if {$ncode != 200} { ## FIXXME: we probably should handle redirects correctly (following them...) set err [::http::code $httpresult] set msg [format [_ "Unable to download from %1\$s \[%2\$s\]" ] $url $err ] ::deken::post "$msg" debug set outputfilename "" } ::http::cleanup $httpresult } stdout ] } { set msg [format [_ "Unable to download from '%s'!" ] $url ] tk_messageBox \ -title [_ "Download failed" ] \ -message "${msg}\n$stdout" \ -icon error -type ok \ -parent $::deken::winid set outputfilename "" } ::http::config -useragent $httpagent flush $f close $f if { "$outputfilename" != "" } { catch { file delete $outputfilename } if {[file exists $outputfilename]} { ::deken::utilities::debug [format [_ "Unable to remove stray file '%s'" ] $outputfilename ] set outputfilename "" } } if { $outputfilename != "" && "$outputfilename" != "$downloadfilename" } { if {[catch { file rename $downloadfilename $outputfilename}]} { ::deken::utilities::debug [format [_ "Unable to rename downloaded file to '%s'" ] $outputfilename ] set outputfilename "" } } if { "$outputfilename" eq "" } { file delete $downloadfilename } return $outputfilename } # parse a deken-packagefilename into it's components: # v0:: [-v-]?{()}-externals. # v1:: [\[)} # return: list [list ...] proc ::deken::utilities::parse_filename {filename} { set pkgname $filename set archs [list] set version "" if { [ string match "*.dek" $filename ] } { ## deken filename v1: [v]()().dek set archstring "" regexp {^([^\[\]\(\)]+)((\[[^\[\]\(\)]+\])*)((\([^\[\]\(\)]+\))*)\.dek$} $filename _ pkgname optionstring _ archstring foreach {o _} [lreplace [split $optionstring {[]}] 0 0] { if {![string first v ${o}]} { set version [string range $o 1 end] } else { # ignoring unknown option... } } foreach {a _} [lreplace [split $archstring "()"] 0 0] { lappend archs $a } } elseif { [ regexp {(.*)-externals\..*} $filename _ basename] } { ## deken filename v0 set pkgname $basename # basename [-v-]?{()} ## strip off the archs set baselist [split $basename () ] # get pkgname + version set pkgver [lindex $baselist 0] if { ! [ regexp "(.*)-v(.*)-" $pkgver _ pkgname version ] } { set pkgname $pkgver set version "" } # get archs foreach {a _} [lreplace $baselist 0 0] { # in filename.v0 the semantics of the last arch field ("bits") was unclear # since this format predates float64 builds, we just force it to 32 regsub -- {-[0-9]+$} $a {-32} a lappend archs $a } if { "x$archs$version" == "x" } { # try again as -v if { ! [ regexp "(.*)-v(.*)" $pkgver _ pkgname version ] } { set pkgname $pkgver set version "" } } } list $pkgname $version $archs } # split filename extension from deken-packagefilename proc ::deken::utilities::get_filenameextension {filename} { if { [ regexp {.*(\.tar\.[^.]*)$} $filename _ ext ] } { return $ext } return [file extension $filename] } # ###################################################################### # ################ preferences ######################################### # ###################################################################### proc ::deken::preferences::newwidget {basename} { # calculate a widget name that has not yet been taken set i 0 while {[winfo exists ${basename}${i}]} {incr i} return ${basename}${i} } proc ::deken::preferences::create_pathpad {toplevel row {padx 2} {pady 2}} { set pad [::deken::preferences::newwidget ${toplevel}.pad] frame $pad -relief groove -borderwidth 2 -width 2 -height 2 grid ${pad} -sticky ew -row ${row} -column 0 -columnspan 3 -padx ${padx} -pady ${pady} } proc ::deken::preferences::create_packpad {toplevel {padx 2} {pady 2} } { set mypad [::deken::preferences::newwidget ${toplevel}.pad] frame $mypad pack $mypad -padx ${padx} -pady ${pady} -expand 1 -fill "y" return $mypad } proc ::deken::preferences::userpath_doit { winid } { set installdir [::deken::do_prompt_installdir ${::deken::preferences::userinstallpath} $winid] if { "${installdir}" != "" } { set ::deken::preferences::userinstallpath "${installdir}" } } proc ::deken::preferences::path_doit {rdb ckb path {mkdir true}} { # handler for the check/create button # if the path does not exist, disable the radiobutton and suggest to Create it # if the path exists, check whether it is writable # if it is writable, enable the radiobutton and disable the check/create button # if it is not writable, keep the radiobutton disabled and suggest to (Re)Check ${ckb} configure -state normal ${rdb} configure -state disabled if { ! [file exists ${path}] } { ${ckb} configure -text [_ "Create"] if { $mkdir } { catch { file mkdir $path } } } if { [file exists ${path}] } { ${ckb} configure -text [_ "Check"] } if { [::deken::utilities::is_writabledir ${path} ] } { ${ckb} configure -state disabled ${rdb} configure -state normal } } proc ::deken::preferences::create_pathentry {toplevel row var path {generic false}} { # only add absolute paths to the pathentries set xpath [ ::deken::utilities::expandpath $path ] if {! $generic} { if { [file pathtype $xpath] != "absolute"} { return } } set rdb [::deken::preferences::newwidget ${toplevel}.path] set chk [::deken::preferences::newwidget ${toplevel}.doit] set pad [::deken::preferences::newwidget ${toplevel}.pad] radiobutton ${rdb} -value ${path} -text "${path}" -variable $var frame ${pad} button ${chk} -text "..." -command "::deken::preferences::path_doit ${rdb} ${chk} ${xpath}" grid ${rdb} -sticky "w" -row ${row} -column 2 grid ${pad} -sticky "" -row ${row} -column 1 -padx 10 grid ${chk} -sticky nsew -row ${row} -column 0 if {! $generic} { ::deken::preferences::path_doit ${rdb} ${chk} ${xpath} false } list ${rdb} ${chk} } proc ::deken::preferences::create {winid} { # urgh...we want to know when the window gets drawn, # so we can query the size of the pathentries canvas # in order to get the scrolling-region right!!! # this seems to be so wrong... bind $winid "::deken::preferences::mapped %W" ::deken::bind_globalshortcuts $winid set ::deken::preferences::installpath $::deken::installpath set ::deken::preferences::hideforeignarch $::deken::hideforeignarch set ::deken::preferences::hideoldversions $::deken::hideoldversions if { $::deken::userplatform == "" } { set ::deken::preferences::platform DEFAULT set ::deken::preferences::userplatform [ ::deken::platform2string ] } else { set ::deken::preferences::platform USER set ::deken::preferences::userplatform $::deken::userplatform } set ::deken::preferences::installpath USER set ::deken::preferences::userinstallpath $::deken::installpath set ::deken::preferences::show_readme $::deken::show_readme set ::deken::preferences::keep_package $::deken::keep_package set ::deken::preferences::verify_sha256 $::deken::verify_sha256 set ::deken::preferences::remove_on_install $::deken::remove_on_install set ::deken::preferences::add_to_path $::deken::add_to_path set ::deken::preferences::add_to_path_temp $::deken::preferences::add_to_path # this dialog allows us to select: # - which directory to extract to # - including all (writable) elements from $::sys_staticpath # and option to create each of them # - a directory chooser # - whether to delete directories before re-extracting # - whether to filter-out non-matching architectures labelframe $winid.installdir -text [_ "Install externals to directory:" ] -padx 5 -pady 5 -borderwidth 1 canvas $winid.installdir.cnv \ -confine true scrollbar $winid.installdir.scrollv \ -command "$winid.installdir.cnv yview" scrollbar $winid.installdir.scrollh \ -orient horizontal \ -command "$winid.installdir.cnv xview" $winid.installdir.cnv configure \ -xscrollincrement 0 \ -xscrollcommand " $winid.installdir.scrollh set" $winid.installdir.cnv configure \ -yscrollincrement 0 \ -yscrollcommand " $winid.installdir.scrollv set" \ pack $winid.installdir.cnv -side left -fill both -expand 1 pack $winid.installdir.scrollv -side right -fill "y" pack $winid.installdir.scrollh -side bottom -fill "x" -before $winid.installdir.cnv pack $winid.installdir -fill both set pathsframe [frame $winid.installdir.cnv.f] set row 0 ### dekenpath: directory-chooser # FIXME: should we ask user to add chosen directory to PATH? set pathdoit [::deken::preferences::create_pathentry ${pathsframe} ${row} ::deken::preferences::installpath "USER" true] incr row [lindex $pathdoit 0] configure \ -foreground blue \ -value "USER" \ -textvariable ::deken::preferences::userinstallpath \ -variable ::deken::preferences::installpath [lindex $pathdoit 1] configure \ -text "..." \ -command "::deken::preferences::userpath_doit $winid" ::deken::preferences::create_pathpad ${pathsframe} ${row} incr row ### dekenpath: default directories if {[namespace exists ::pd_docsdir] && [::pd_docsdir::externals_path_is_valid]} { foreach p [::pd_docsdir::get_externals_path] { ::deken::preferences::create_pathentry ${pathsframe} ${row} ::deken::preferences::installpath $p incr row } ::deken::preferences::create_pathpad ${pathsframe} ${row} incr row } set extradir [file join ${::sys_libdir} extra ] foreach p $::sys_staticpath { if { [file normalize $p] == $extradir } { set p [file join @PD_PATH@ extra] } ::deken::preferences::create_pathentry ${pathsframe} ${row} ::deken::preferences::installpath $p incr row } ::deken::preferences::create_pathpad ${pathsframe} ${row} incr row foreach p $::sys_searchpath { ::deken::preferences::create_pathentry ${pathsframe} ${row} ::deken::preferences::installpath $p incr row } pack $pathsframe -fill "x" $winid.installdir.cnv create window 0 0 -anchor "nw" -window $pathsframe ## installation options labelframe $winid.install -text [_ "Installation options:" ] -padx 5 -pady 5 -borderwidth 1 pack $winid.install -side top -fill "x" -anchor "w" checkbutton $winid.install.verify256 -text [_ "Try to verify the libraries' checksum before (re)installing them"] \ -variable ::deken::preferences::verify_sha256 pack $winid.install.verify256 -anchor "w" checkbutton $winid.install.remove -text [_ "Try to remove libraries before (re)installing them"] \ -variable ::deken::preferences::remove_on_install pack $winid.install.remove -anchor "w" checkbutton $winid.install.readme -text [_ "Show README of newly installed libraries (if present)"] \ -variable ::deken::preferences::show_readme pack $winid.install.readme -anchor "w" checkbutton $winid.install.keeppackage -text [_ "Keep package files after installation"] \ -variable ::deken::preferences::keep_package pack $winid.install.keeppackage -anchor "w" checkbutton $winid.install.add_to_path -text [_ "Add newly installed libraries to Pd's search path"] \ -variable ::deken::preferences::add_to_path catch { $winid.install.add_to_path configure \ -tristatevalue 1 \ -onvalue 2 \ -command {set ::deken::preferences::add_to_path \ [set ::deken::preferences::add_to_path_temp \ [::deken::utilities::tristate $::deken::preferences::add_to_path_temp 1 0]]} set msg "- Always add to search path\n- Never add to search path\n- Prompt before adding" bind $winid.install.add_to_path "::deken::balloon::show $winid.install_balloon %X \[winfo rooty %W\] \{$msg\} 0 30" bind $winid.install.add_to_path [list ::deken::balloon::hide $winid.install_balloon] } stdout pack $winid.install.add_to_path -anchor "w" ## platform filter settings labelframe $winid.platform -text [_ "Platform settings:" ] -padx 5 -pady 5 -borderwidth 1 pack $winid.platform -side top -fill "x" -anchor "w" # default architecture vs user-defined arch radiobutton $winid.platform.default -value "DEFAULT" \ -text [format [_ "Default platform: %s" ] [::deken::platform2string ] ] \ -variable ::deken::preferences::platform \ -command "$winid.platform.userarch.entry configure -state disabled" pack $winid.platform.default -anchor "w" frame $winid.platform.userarch radiobutton $winid.platform.userarch.radio -value "USER" \ -text [_ "User-defined platform:" ] \ -variable ::deken::preferences::platform \ -command "$winid.platform.userarch.entry configure -state normal" entry $winid.platform.userarch.entry -textvariable ::deken::preferences::userplatform if { "$::deken::preferences::platform" == "DEFAULT" } { $winid.platform.userarch.entry configure -state disabled } pack $winid.platform.userarch -anchor "w" pack $winid.platform.userarch.radio -side left pack $winid.platform.userarch.entry -side right -fill "x" # hide non-matching architecture? ::deken::preferences::create_packpad $winid.platform 2 10 checkbutton $winid.platform.hide_foreign -text [_ "Hide foreign architectures"] \ -variable ::deken::preferences::hideforeignarch pack $winid.platform.hide_foreign -anchor "w" checkbutton $winid.platform.only_newest -text [_ "Only show the newest version of a library\n(treats other versions like foreign architectures)"] \ -variable ::deken::preferences::hideoldversions -justify "left" pack $winid.platform.only_newest -anchor "w" # Use two frames for the buttons, since we want them both bottom and right frame $winid.nb pack $winid.nb -side bottom -fill "x" -pady 2m # buttons frame $winid.nb.buttonframe pack $winid.nb.buttonframe -side right -fill "x" -padx 2m button $winid.nb.buttonframe.cancel -text [_ "Cancel"] \ -command "::deken::preferences::cancel $winid" pack $winid.nb.buttonframe.cancel -side left -expand 1 -fill "x" -padx 15 -ipadx 10 if {$::windowingsystem ne "aqua"} { button $winid.nb.buttonframe.apply -text [_ "Apply"] \ -command "::deken::preferences::apply $winid" pack $winid.nb.buttonframe.apply -side left -expand 1 -fill "x" -padx 15 -ipadx 10 } button $winid.nb.buttonframe.ok -text [_ "OK"] \ -command "::deken::preferences::ok $winid" pack $winid.nb.buttonframe.ok -side left -expand 1 -fill "x" -padx 15 -ipadx 10 } proc ::deken::preferences::mapped {winid} { set cnv $winid.installdir.cnv catch { set bbox [$cnv bbox all] if { "$bbox" != "" } { $cnv configure -scrollregion $bbox } } stdout } proc ::deken::preferences::show {{winid .deken_preferences}} { if {[winfo exists $winid]} { wm deiconify $winid raise $winid } else { toplevel $winid -class DialogWindow wm title $winid [format [_ "Deken %s Preferences"] $::deken::version] frame $winid.frame pack $winid.frame -side top -padx 6 -pady 3 -fill both -expand true ::deken::preferences::create $winid.frame } } proc ::deken::preferences::apply {winid} { set installpath "${::deken::preferences::installpath}" if { "$installpath" == "USER" } { set installpath "${::deken::preferences::userinstallpath}" } ::deken::set_installpath "$installpath" set plat "" if { "${::deken::preferences::platform}" == "USER" } { set plat "${::deken::preferences::userplatform}" } ::deken::set_platform_options ${plat} ${::deken::preferences::hideforeignarch} ${::deken::preferences::hideoldversions} ::deken::set_install_options \ "${::deken::preferences::remove_on_install}" \ "${::deken::preferences::show_readme}" \ "${::deken::preferences::add_to_path}" \ "${::deken::preferences::keep_package}" \ "${::deken::preferences::verify_sha256}" } proc ::deken::preferences::cancel {winid} { ## FIXXME properly close the window/frame (for reuse in a tabbed pane) destroy .deken_preferences } proc ::deken::preferences::ok {winid} { ::deken::preferences::apply $winid ::deken::preferences::cancel $winid } # ###################################################################### # ################ core ################################################ # ###################################################################### if { [ catch { set ::deken::installpath [::pd_guiprefs::read dekenpath] } stdout ] } { # this is a Pd without the new GUI-prefs proc ::deken::set_installpath {installdir} { set ::deken::installpath $installdir } proc ::deken::set_platform_options {platform hideforeignarch {hideoldversions 0}} { set ::deken::userplatform $platform set ::deken::hideforeignarch [::deken::utilities::bool $hideforeignarch ] set ::deken::hideoldversions [::deken::utilities::bool $hideoldversions ] } proc ::deken::set_install_options {remove readme add keep verify256} { set ::deken::remove_on_install [::deken::utilities::bool $remove] set ::deken::show_readme [::deken::utilities::bool $readme] set ::deken::add_to_path [::deken::utilities::tristate $add 0 0] set ::deken::keep_package [::deken::utilities::bool $keep] set ::deken::verify_sha256 [::deken::utilities::bool $verify256] } } else { catch {set ::deken::installpath [lindex ${::deken::installpath} 0]} # Pd has a generic preferences system, that we can use proc ::deken::set_installpath {installdir} { set ::deken::installpath $installdir ::pd_guiprefs::write dekenpath [list $installdir] } # user requested platform (empty = DEFAULT) set ::deken::userplatform [::pd_guiprefs::read deken_platform] catch {set ::deken::userplatform [lindex ${deken::userplatform} 0 ]} # urgh, on macOS an empty :deken::userplatform ({}, which is promoted to [list {}] on save) # got saved as a literal "{}" (actually "\\\\{\\\\}") # which then gets restored as "\\{\\}"... # the bogus write behaviour was fixed with v0.9.8, but we need to handle old prefs... set ::deken::userplatform [string trim [string trim ${::deken::userplatform} "\\\{\}" ] ] set ::deken::hideforeignarch [::deken::utilities::bool [::pd_guiprefs::read deken_hide_foreign_archs] 1] set ::deken::hideoldversions [::deken::utilities::bool [::pd_guiprefs::read deken_hide_old_versions] 1] proc ::deken::set_platform_options {platform hideforeignarch {hideoldversions 0}} { set ::deken::userplatform $platform if { $platform == "" } { set platformlist [list] } else { set platformlist [list $platform] } set ::deken::hideforeignarch [::deken::utilities::bool $hideforeignarch ] set ::deken::hideoldversions [::deken::utilities::bool $hideoldversions ] ::pd_guiprefs::write deken_platform $platformlist ::pd_guiprefs::write deken_hide_foreign_archs $::deken::hideforeignarch ::pd_guiprefs::write deken_hide_old_versions $::deken::hideoldversions } set ::deken::remove_on_install [::deken::utilities::bool [::pd_guiprefs::read deken_remove_on_install] 1] set ::deken::show_readme [::deken::utilities::bool [::pd_guiprefs::read deken_show_readme] 1] set ::deken::keep_package [::deken::utilities::bool [::pd_guiprefs::read deken_keep_package] 0] set ::deken::verify_sha256 [::deken::utilities::bool [::pd_guiprefs::read deken_verify_sha256] 1] set ::deken::add_to_path [::deken::utilities::tristate [::pd_guiprefs::read deken_add_to_path] ] proc ::deken::set_install_options {remove readme path keep verify256} { set ::deken::remove_on_install [::deken::utilities::bool $remove] set ::deken::show_readme [::deken::utilities::bool $readme] set ::deken::add_to_path [::deken::utilities::tristate $path] set ::deken::keep_package [::deken::utilities::bool $keep] set ::deken::verify_sha256 [::deken::utilities::bool $verify256] ::pd_guiprefs::write deken_remove_on_install "$::deken::remove_on_install" ::pd_guiprefs::write deken_show_readme "$::deken::show_readme" ::pd_guiprefs::write deken_add_to_path "$::deken::add_to_path" ::pd_guiprefs::write deken_keep_package "$::deken::keep_package" ::pd_guiprefs::write deken_verify_sha256 "$::deken::verify_sha256" } } proc ::deken::normalize_result {title cmd {match 1} {subtitle ""} {statusline ""} {contextcmd {}} {pkgname ""} {version ""} {uploader ""} {timestamp ""} args} { ## normalize a search-result # the function parameters are guaranteed to be a stable API (with the exception or args) # but the value returned by this function is an implementation detail # the primary line displayed for the search-result # - <cmd> the full command to run to install the library # - <match> boolean value to indicate whether this entry matches the current architecture # - <subtitle> additional text to be shown under the <name> # - <statusline> additional text to be shown in the STATUS line if the mouse hovers over the result # - <contextcmd> the full command to be executed when the user right-clicks the menu-entry # - <pkgname> the library name (typically this gets parsed from the package filename) # - <uploader> who provided the package # - <timestamp> the upload date of the package # - <args> RESERVED FOR FUTURE USE (this is a variadic placeholder. do not use!) list "" $title $cmd $match $subtitle $statusline $contextcmd $pkgname $version $uploader $timestamp } # find an install path, either from prefs or on the system # returns an empty string if nothing was found proc ::deken::find_installpath {{ignoreprefs false}} { set installpath "" if { [ info exists ::deken::installpath ] && !$ignoreprefs } { ## any previous choice? return $::deken::installpath } if { "$installpath" == "" } { ## search the default paths set installpath [ ::deken::utilities::get_writabledir $::sys_staticpath ] } if { "$installpath" == "" } { # let's use the first of $::sys_staticpath, if it does not exist yet set userdir [lindex $::sys_staticpath 0] if { ! [file exists ${userdir} ] } { set installpath $userdir } } return $installpath } proc ::deken::platform2string {{verbose 0}} { if { $verbose } { return $::deken::platform(os)-$::deken::platform(machine)-float$::deken::platform(floatsize) } else { return $::deken::platform(os)-$::deken::platform(machine)-$::deken::platform(floatsize) } } # allow overriding deken platform from Pd-core proc ::deken::set_platform {os machine bits floatsize} { set bits [expr int($bits)] set floatsize [expr int($floatsize)] if { $os != $::deken::platform(os) || $machine != $::deken::platform(machine) || $bits != $::deken::platform(bits) || $floatsize != $::deken::platform(floatsize) } { set ::deken::platform(os) ${os} set ::deken::platform(machine) ${machine} set ::deken::platform(bits) ${bits} set ::deken::platform(floatsize) ${floatsize} set msg [format [_ "Platform re-detected: %s" ] [::deken::platform2string 1] ] ::pdwindow::verbose 0 "\[deken\] ${msg}\n" } if { [info procs ::pdwindow::update_title] ne ""} { after idle {::pdwindow::update_title .pdwindow} } } proc ::deken::versioncompare {a b} { # compares two versions, the Debian way # each version string is split into numeric and non-numeric elements # the elements are compared pairwise # "~" sorts before everything else # sidenote: in practice the version we get here are of the form "<date>/<library>/<version>/<date>" # we probably should only use this version-comparision for the <version> part, # and use 'string compare' for the other parts foreach x [regexp -all -inline {\d+|\D+} [string map {~ \t} $a]] y [regexp -all -inline {\d+|\D+} [string map {~ \t} $b]] { if { "$x" == "" } { set x " " } if { "$y" == "" } { set y " " } if { [catch { set c [dict get {1 0 {0 1} -1 {1 0} 1} [lsort -indices -dictionary -unique [list $x $y]]] } stdout ] } { # Tcl<8.5 (as found the PowerPC builds) lacks 'dict' and 'lsort -indices' if { [catch { # "string compare" does not sort numerically set c [expr 2 * ($x > $y) + ($x == $y) - 1] } stdout] } { set c [string compare $x $y] } } if { $c != "0" } {return $c} } return 0 } proc ::deken::verify_sha256_gui {url pkgfile} { ## verify that the SHA256 of the $pkgfile matches that from $url ## in case of failure, this displays a dialog asking the user how to proceed ## (if the preferences indicate we require checking) ## returns ## - 1 on success ## - 0 on failure ## - negative numbers indicate failures to be ignored ## - one digit: user requested ignore ## - -1 user requested ignore via prefs ## - -2 user requested ignore via dialog ## - two digits: unable to verify ## - -10 reference could not be read ## - -20 an exception occurred while verifying ## - three digits: ## - -100 no sha256 verifier implemented set err_msg [format [_ "SHA256 verification of '%s' failed!" ] $pkgfile ] set err_title [_ "SHA256 verification failed" ] set err_status [format [_ "Checksum mismatch for '%s'" ] $url] while 1 { set hash_ok [::deken::utilities::verify_sha256 ${url} ${pkgfile}] if { ${hash_ok} } { return ${hash_ok} } ::deken::statuspost $err_status warn 0 if { ! $::deken::verify_sha256 } { return -1 } set result [tk_messageBox \ -title ${err_title} \ -message ${err_msg} \ -icon error -type abortretryignore \ -parent $::deken::winid] switch -- ${result} { abort { return 0 } ignore { return -2 } } } return 0 } proc ::deken::install_package_from_file {{pkgfile ""}} { set types {} lappend types [list [_ "Deken Packages" ] .dek] lappend types [list [_ "ZIP Files" ] .zip] if {$::tcl_platform(platform) ne "windows"} { lappend types [list [_ "TAR Files" ] {.tgz} ] if {$::windowingsystem eq "aqua"} { # stupid bug on macOS>=12: an extension with two dots crashes the fileselector lappend types [list [_ "TAR Files" ] {.gz} ] } else { lappend types [list [_ "TAR Files" ] {.tar.gz} ] } } lappend types [list [_ "All Files" ] * ] if { "${pkgfile}" eq ""} { set pkgfile [tk_getOpenFile -defaultextension dek -filetypes $types] } if { "${pkgfile}" eq "" } { return } # user picked one # perform checks and install it set pkgfile [file normalize $pkgfile] set result [::deken::verify_sha256_gui ${pkgfile} ${pkgfile}] if { ! $result } { return } ::deken::install_package ${pkgfile} "" "" 1 } proc ::deken::install_package {fullpkgfile {filename ""} {installdir ""} {keep 1}} { # fullpkgfile: the file to extract # filename : the package file name (usually the basename of $fullpkgfile) # but might be different depending on the download) # installdir : where to put stuff into # keep : whether to remove the fullpkgfile after successful extraction if { "${filename}" == "" } { set filename [file tail ${fullpkgfile}] } set installdir [::deken::ensure_installdir ${installdir} ${filename}] set parsedname [::deken::utilities::parse_filename $filename] set extname [lindex $parsedname 0] set extpath [file join $installdir $extname] set deldir "" if { "$::deken::remove_on_install" } { ::deken::statuspost [format [_ "Uninstalling previous installation of '%s'" ] $extname ] info if { ! [::deken::utilities::uninstall $installdir $extname] } { # ouch uninstalling failed. # on msw, lets assume this is because some of the files in the folder are locked. # so move the folder out of the way and proceed set deldir [::deken::utilities::get_tmpfilename $installdir] if { [ catch { file mkdir $deldir file rename [file join ${installdir} ${extname}] [file join ${deldir} ${extname}] } ] } { ::deken::utilities::debug [format [_ "Temporarily moving %1\$s into %2\$s failed." ] $extname $deldir ] set deldir "" } } } ::deken::statuspost [format [_ "Installing package '%s'" ] $extname ] {} 0 ::deken::syncgui ::deken::progress 0 if { [::deken::utilities::extract $installdir $filename $fullpkgfile $keep] > 0 } { ::deken::progressstatus [_ "Installation completed!" ] set msg [format [_ "Successfully installed '%s'!" ] $extname ] ::deken::statuspost "${msg}" {} 0 ::deken::post "" ::pdwindow::post "\[deken\] $msg\n" set install_failed 0 } else { ::deken::progressstatus [_ "Installation failed!" ] set msg [format [_ "Failed to install '%s'!" ] $extname ] ::deken::statuspost ${msg} error 0 tk_messageBox \ -title [_ "Package installation failed" ] \ -message "${msg}" \ -icon error -type ok \ -parent $::deken::winid set install_failed 1 } if { "$deldir" != "" } { # try getting rid of the directory to be deleted # we already tried once (and failed), so this time we iterate over each file set rmerrors [::deken::utilities::rmrecursive $deldir] # and if there are still files around, ask the user to delete them. if { $rmerrors > 0 } { set result [tk_messageBox \ -message [format [_ "Failed to completely remove %1\$s.\nPlease manually remove the directory %2\$s after quitting Pd." ] $extname $deldir] \ -icon warning -type okcancel -default ok \ -parent $::deken::winid] switch -- $result { ok { ::pd_menucommands::menu_openfile $deldir } } } set deldir "" } if { ${install_failed} } { return } if { "$::deken::show_readme" } { foreach ext {pd html pdf txt} { set r [file join $extpath "README.deken.$ext"] if {[file exists $r]} { if { "$ext" == "pd" } { set directory [file normalize [file dirname $r]] set basename [file tail $r] pdsend "pd open [enquote_path $basename] [enquote_path $directory]" } else { pd_menucommands::menu_openfile $r } break } } } if { "$::deken::add_to_path" } { # add to the search paths? bail if the version of pd doesn't support it if {[uplevel 1 info procs add_to_searchpaths] eq ""} {return} if {![file exists $extpath]} { ::deken::utilities::debug [format [_ "Unable to add %s to search paths"] $extname] return } set result yes if { $::deken::add_to_path > 1 } { set result yes } else { set result [tk_messageBox \ -message [format [_ "Add %s to the Pd search paths?" ] $extname] \ -icon question -type yesno -default yes \ -parent $::deken::winid] } switch -- "${result}" { yes { add_to_searchpaths [file join $installdir $extname] ::deken::utilities::debug [format [_ "Added %s to search paths"] $extname] # if this version of pd supports it, try refreshing the helpbrowser if {[uplevel 1 info procs ::helpbrowser::refresh] ne ""} { ::helpbrowser::refresh } } no { return } } } } ##### GUI ######## proc ::deken::bind_globalshortcuts {toplevel} { set closescript "destroy $toplevel" bind $toplevel <$::modifier-Key-w> $closescript } proc ::deken::status {{msg ""} {timeout 5000}} { after cancel $::deken::statustimer if {"" ne $msg} { set ::deken::statustext "$msg" if { $timeout != "0" } { set ::deken::statustimer [after $timeout [list set "::deken::statustext" ""]] } } else { set ::deken::statustext "" } } proc ::deken::progressstatus {{msg ""} {timeout 5000}} { after cancel $::deken::progresstimer if {"" ne $msg} { set ::deken::progresstext "$msg" if { $timeout != "0" } { set ::deken::progresstimer [after $timeout [list set "::deken::progresstext" ""]] } } else { set ::deken::progresstext "" } } proc ::deken::syncgui {} { update idletasks } proc ::deken::scrollup {} { variable infoid if { [winfo exists $infoid] } { $infoid see 0.0 } } proc ::deken::post {msg args} { variable infoid if { [winfo exists $infoid] } { $infoid insert end "$msg\n" $args $infoid see end } } proc ::deken::statuspost {msg {tag info} {timeout 5000}} { post $msg $tag status $msg $timeout } proc ::deken::clearpost {} { variable infoid if { [winfo exists $infoid] } { $infoid delete 1.0 end } set ::deken::selected {} } proc ::deken::post_result {msg {tag ""}} { variable resultsid if { [winfo exists $resultsid] } { $resultsid insert end "$msg\n" $tag $resultsid see end } } proc ::deken::bind_resulttag {tagname key cmd} { variable resultsid if { [winfo exists $resultsid] } { $resultsid tag bind $tagname $key $cmd } } proc ::deken::highlightable_resulttag {tagname} { variable resultsid if { [winfo exists $resultsid] } { ::deken::bind_resulttag $tagname <Enter> \ "$resultsid tag add highlight [ $resultsid tag ranges $tagname ]" ::deken::bind_resulttag $tagname <Leave> \ "$resultsid tag remove highlight [ $resultsid tag ranges $tagname ]" # make sure that the 'highlight' tag is topmost $resultsid tag raise sel $resultsid tag raise highlight } } proc ::deken::bind_contextmenu {resultsid tagname cmd} { if { [winfo exists $resultsid] } { if {$::windowingsystem eq "aqua"} { $resultsid tag bind $tagname <2> $cmd } else { $resultsid tag bind $tagname <3> $cmd } } } proc ::deken::menu_installselected {resultsid} { set counter 0 foreach {k v} $::deken::selected { if { $v ne {} } { eval $v incr counter } } if { $counter == 0 } { ::deken::statuspost [_ "No packages selected for installation."] } elseif { $counter > 1 } { ::deken::statuspost [format [_ "Processed %d packages selected for installation."] $counter ] } # clear the selection set ::deken::selected {} ::deken::clear_selection $resultsid ::deken::update_installbutton $::deken::winid } proc ::deken::menu_uninstall_package {winid pkgname installpath} { ::deken::show_tab $winid info ::deken::statuspost [format [_ "Uninstalling previous installation of '%s'" ] $pkgname ] info ::deken::utilities::uninstall $installpath $pkgname } proc ::deken::do_prompt_installdir {path {winid {}}} { set msg [_ "Install externals to directory:"] if { $winid eq {} } { set winid $::deken::winid } if {[winfo exists $winid]} { tk_chooseDirectory -title "${msg}" -initialdir ${path} -parent $winid } else { tk_chooseDirectory -title "${msg}" -initialdir ${path} } } proc ::deken::prompt_installdir {} { set installdir [::deken::do_prompt_installdir $::fileopendir] if { "$installdir" != "" } { ::deken::set_installpath $installdir return 1 } return 0 } proc ::deken::update_searchbutton {winid} { if { [$winid.searchbit.entry get] == "" } { $winid.searchbit.button configure -text [_ "Show all" ] } else { $winid.searchbit.button configure -text [_ "Search" ] } } proc ::deken::update_installbutton {winid} { set installbutton ${winid}.status.install if { ! [winfo exists $installbutton] } { return } set counter 0 foreach {a b} $::deken::selected { if {$b ne {} } { incr counter } } if { $counter > 0 } { $installbutton configure -state normal -text [format [_ "Install (%d)" ] $counter] } else { $installbutton configure -state disabled -text [_ "Install" ] } } proc ::deken::progress {x} { ::deken::statuspost [format [_ "%s%% of download completed"] ${x}] } # this function gets called when the menu is clicked proc ::deken::open_searchui {winid} { if {[winfo exists $winid]} { wm deiconify $winid raise $winid } else { variable resultsid variable infoid ::deken::create_dialog $winid ::deken::bind_globalshortcuts $winid foreach dndid [list $winid.tab $winid.results] { if { [winfo exists $dndid] } { ::deken::utilities::dnd_init $dndid } } $infoid tag configure error -foreground red $infoid tag configure warn -foreground orange $infoid tag configure info -foreground black $infoid tag configure debug -foreground grey $infoid tag configure dekenurl -foreground blue $infoid tag bind dekenurl <1> "pd_menucommands::menu_openfile https://deken.puredata.info/" $infoid tag bind dekenurl <Enter> "$infoid tag configure dekenurl -underline 1" $infoid tag bind dekenurl <Leave> "$infoid tag configure dekenurl -underline 0" $resultsid tag configure highlight -foreground blue $resultsid tag configure archmatch $resultsid tag configure noarchmatch -foreground grey } ::deken::clearpost ::deken::post [_ "Enter an exact library or object name."] info set msg [_ "e.g. 'freeverb~'"] ::deken::post "\t${msg}" info ::deken::post [_ "Use the '*' wildcard to match any number of characters."] info set msg [_ "e.g. '*-plugin' will match 'deken-plugin' (and more)."] ::deken::post "\t${msg}" info ::deken::post [_ "You can restrict the search to only-libraries or only-objects."] info ::deken::post [_ "To get a list of all available externals, try an empty search."] info ::deken::post "" info ::deken::post [_ "Right-clicking a search result will give you more options..." ] info ::deken::post "" info ::deken::post [_ "You can also search for libraries & objects via your web browser:" ] info ::deken::post "https://deken.puredata.info" dekenurl } # build the externals search dialog window proc ::deken::create_dialog {winid} { variable resultsid toplevel $winid -class DialogWindow set ::deken::winid $winid set title [_ "Find externals"] wm title $winid "deken - $title" wm geometry $winid 670x550 wm minsize $winid 230 360 wm transient $winid $winid configure -padx 10 -pady 5 set m ${winid}_menu destroy $m menu $m menu $m.file $m add cascade -label [_ [string totitle "file"]] -underline 0 -menu $m.file $m.file add command -label [_ "Install DEK file..." ] -command "::deken::install_package_from_file" menu $m.edit $m add cascade -label [_ [string totitle "edit"]] -underline 0 -menu $m.edit $m.edit add command -label [_ "Preferences..." ] -command "::deken::preferences::show" $winid configure -menu $m frame $winid.searchbit pack $winid.searchbit -side top -fill "x" entry $winid.searchbit.entry -font 18 -relief sunken -highlightthickness 1 -highlightcolor blue pack $winid.searchbit.entry -side left -padx 6 -fill "x" -expand true bind $winid.searchbit.entry <Key-Return> "::deken::initiate_search $winid" bind $winid.searchbit.entry <KeyRelease> "::deken::update_searchbutton $winid" focus $winid.searchbit.entry button $winid.searchbit.button -text [_ "Show all"] -default active -command "::deken::initiate_search $winid" pack $winid.searchbit.button -side right -padx 6 -pady 3 -ipadx 10 frame $winid.objlib pack $winid.objlib -side top -fill "x" label $winid.objlib.label -text [_ "Search for: "] radiobutton $winid.objlib.libraries -text [_ "libraries"] -variable ::deken::searchtype -value libraries radiobutton $winid.objlib.objects -text [_ "objects"] -variable ::deken::searchtype -value objects radiobutton $winid.objlib.both -text [_ "both"] -variable ::deken::searchtype -value name foreach x {label libraries objects both} { pack $winid.objlib.$x -side left -padx 6 } # for Pd that supports it, add a 'translation' radio if {[uplevel 2 info procs add_to_helppaths] ne ""} { radiobutton $winid.objlib.translations -text [_ "translations"] -variable ::deken::searchtype -value translations pack $winid.objlib.translations -side left -padx 6 } frame $winid.warning pack $winid.warning -side top -fill "x" label $winid.warning.label -text [_ "Only install externals uploaded by people you trust."] pack $winid.warning.label -side left -padx 6 if { [catch { if {$::windowingsystem eq "aqua" && [::deken::versioncompare 8.6 [info patchlevel]] < 0 && [::deken::versioncompare 8.6.12 [info patchlevel]] > 0 } { ::deken::utilities::debug [_ "Disabling tabbed view: incompatible Tcl/Tk detected"] error [_ "Disabling tabbed view: incompatible Tcl/Tk detected"] } ttk::notebook $winid.tab pack $winid.tab -side top -padx 6 -pady 3 -fill both -expand true text $winid.tab.info -takefocus 0 -cursor hand2 -height 100 -yscrollcommand "$winid.tab.info.ys set" scrollbar $winid.tab.info.ys -orient vertical -command "$winid.tab.info yview" pack $winid.tab.info.ys -side right -fill "y" if { [catch { set treeid $winid.tab.results ttk::treeview $treeid \ -height 10 \ -selectmode browse \ -columns {version title uploader date} \ -displaycolumns {version uploader date} \ -yscrollcommand "$winid.tab.results.ys set" $treeid heading #0 -text [_ "Library" ] -anchor center -command "::deken::treeresults::columnsort $treeid" $treeid heading version -text [_ "Version" ] -anchor center -command "::deken::treeresults::columnsort $treeid version" $treeid heading title -text [_ "Description" ] -anchor center -command "::deken::treeresults::columnsort $treeid title" $treeid heading uploader -text [_ "Uploader" ] -anchor center -command "::deken::treeresults::columnsort $treeid uploader" $treeid heading date -text [_ "Date" ] -anchor center -command "::deken::treeresults::columnsort $treeid date" $treeid column #0 -stretch 0 $treeid tag configure library -background lightgrey $treeid tag configure noarchmatch -foreground lightgrey $treeid tag configure selpkg -background lightblue bind $treeid <<TreeviewSelect>> "::deken::treeresults::selection_changed %W" bind $treeid <<TreeviewOpen>> "::deken::treeresults::selection_skip %W 1" bind $treeid <<TreeviewClose>> "::deken::treeresults::selection_skip %W 1" bind $treeid <Motion> "::deken::treeresults::motionevent %W %x %y" bind $treeid <Leave> "::deken::treeresults::leaveevent %W" bind $treeid <Double-ButtonRelease-1> "::deken::treeresults::doubleclick %W %x %y" proc ::deken::show_results {resultsid} { ::deken::treeresults::show $resultsid} proc ::deken::clear_results {resultsid} { ::deken::treeresults::clear $resultsid} proc ::deken::clear_selection {resultsid} { ::deken::treeresults::clear_selection $resultsid } scrollbar $winid.tab.results.ys -orient vertical -command "$winid.tab.results yview" pack $winid.tab.results.ys -side right -fill "y" } ] } { text $winid.tab.results -takefocus 0 -cursor hand2 -height 100 -yscrollcommand "$winid.tab.results.ys set" scrollbar $winid.tab.results.ys -orient vertical -command "$winid.tab.results yview" pack $winid.tab.results.ys -side right -fill "y" } $winid.tab add $winid.tab.results -text [_ "Search Results"] $winid.tab add $winid.tab.info -text [_ "Log"] ::deken::show_tab $winid info variable infoid set resultsid $winid.tab.results set infoid $winid.tab.info } ] } { text $winid.results -takefocus 0 -cursor hand2 -height 100 -yscrollcommand "$winid.results.ys set" scrollbar $winid.results.ys -orient vertical -command "$winid.results yview" pack $winid.results.ys -side right -fill "y" pack $winid.results -side top -padx 6 -pady 3 -fill both -expand true } frame $winid.progress pack $winid.progress -side top -fill "x" if { ! [ catch { ttk::progressbar $winid.progress.bar -orient horizontal -length 640 -maximum 100 -mode determinate -variable ::deken::progressvar } stdout ] } { pack $winid.progress.bar -side top -fill "x" proc ::deken::progress {x} { set ::deken::progressvar $x } label ${winid}.progress.label -textvariable ::deken::progresstext -padx 0 -borderwidth 0 place ${winid}.progress.label -in ${winid}.progress.bar -x 1 } frame $winid.status pack $winid.status -side bottom -fill "x" -pady 3 label $winid.status.label -textvariable ::deken::statustext -relief sunken -anchor "w" pack $winid.status.label -side bottom -fill "x" button $winid.status.install -text [_ "Install" ] \ -state disabled \ -command "::deken::menu_installselected $resultsid" pack $winid.status.install -side right -padx 6 -pady 3 -ipadx 10 } proc ::deken::show_tab {winid tab} { if { [winfo exists ${winid}.tab.${tab}] } { ${winid}.tab select ${winid}.tab.${tab} } } proc ::deken::open_search_xxx {searchtype xxx} { set winid $::deken::winid ::deken::open_searchui $winid ::deken::clearpost set searchterm {} if { $::deken::searchtype eq "${searchtype}" } { append searchterm [$winid.searchbit.entry get] } if { ${searchterm} ne {} } { append searchterm " " } foreach xx $xxx { foreach x $xx { lappend searchterm $x } } ${winid}.searchbit.entry delete 0 end ${winid}.searchbit.entry insert end ${searchterm} set ::deken::searchtype "${searchtype}" ::deken::update_searchbutton $winid } proc ::deken::open_search_objects {args} { ::deken::open_search_xxx "objects" $args } proc ::deken::open_search_libraries {args} { ::deken::open_search_xxx "libraries" $args } proc ::deken::open_search_translations {args} { ::deken::open_search_xxx "translations" $args } proc ::deken::open_search_missing_libraries {args} { # LATER this should only display not-installed libraries ::deken::open_search_xxx "libraries" $args } proc ::deken::initiate_search {winid} { set searchterm [$winid.searchbit.entry get] # let the user know what we're doing ::deken::show_tab $winid info ::deken::clearpost ::deken::statuspost [format [_ "Searching for \"%s\"..." ] ${searchterm} ] set ::deken::progressvar 0 ::deken::progressstatus "" if { [ catch { set results [::deken::search_for ${searchterm}] } stdout ] } { ::deken::utilities::debug [format [_ "online? %s" ] $stdout ] ::deken::statuspost [_ "Unable to perform search. Are you online?" ] error } else { # delete all text in the results variable resultsid ::deken::clear_results $resultsid set ::deken::selected {} set ::deken::results $results set matchcount 0 foreach r $results { foreach {_ _ match} $r {break} if { $match } { incr matchcount } } if {[llength $results] != 0} { ::deken::show_results $resultsid set msg [format [_ "Found %1\$d usable packages (of %2\$d packages in total)." ] $matchcount [llength $results]] ::deken::statuspost [format {"%s": %s} ${searchterm} ${msg}] if { $matchcount } { ::deken::show_tab $winid results } else { ::deken::post [_ "It appears that there are no matching packages for your architecture." ] warn } } else { ::deken::statuspost [_ "No matching externals found." ] set msg [_ "Try using the full name e.g. 'freeverb~'." ] ::deken::post " ${msg}" set msg [_ "Or use wildcards like 'freeverb*'." ] ::deken::post " ${msg}" } } } ## deken::textresults: show versions of libraries in a simple text widget namespace eval ::deken::textresults:: { } # display a single found entry in a simple text widget proc ::deken::textresults::show_result {resultsid counter result showmatches} { foreach {title cmd match comment status contextcmd pkgname} $result {break} set tag ch$counter set tags [list $tag [expr ${match}?"archmatch":"noarchmatch" ] ] if { "$pkgname" ne "" } {lappend tags "/$pkgname"} if {($match == $showmatches)} { set comment [string map {"\n" "\n\t"} $comment] ::deken::post_result "$title\n\t$comment\n" $tags ::deken::highlightable_resulttag $tag ::deken::bind_resulttag $tag <Enter> "+::deken::status {$status}" ::deken::bind_resulttag $tag <1> "$cmd" if { "" ne $contextcmd } { ::deken::bind_contextmenu $resultsid $tag $contextcmd } } } # display all found entries in a simple text widget proc ::deken::textresults::show {resultsid} { set counter 0 # build the list UI of results foreach r $::deken::results { ::deken::textresults::show_result $resultsid $counter $r 1 incr counter } if { "${::deken::hideforeignarch}" } { # skip display of non-matching archs } else { set counter 0 foreach r $::deken::results { ::deken::textresults::show_result $resultsid $counter $r 0 incr counter } } if { [winfo exists $resultsid] } { $resultsid see 0.0 } } proc ::deken::textresults::clear {resultsid} { if { [winfo exists $resultsid] } { $resultsid delete 1.0 end } } proc ::deken::textresults::selectpackage {resultsid pkgname installcmd} { # set/unset the selection in a "dict" set state {} set counter 1 foreach {k v} $::deken::selected { if { $k eq $pkgname } { if { $v ne $installcmd } { set state 1 lset ::deken::selected $counter $installcmd } else { set state 0 lset ::deken::selected $counter {} } break } incr counter 2 } if { ${state} eq {} } { # not found in the dict; just add it lappend ::deken::selected $pkgname $installcmd set state 1 } # set/unset the visual representation (via tags) set counter 0 foreach {a b} [$resultsid tag ranges /$pkgname] {$resultsid tag remove sel $a $b} if { $state } { foreach r $::deken::results { if { [lindex $r 1] eq ${installcmd} } { foreach {a b} [$resultsid tag ranges ch$counter] {$resultsid tag add sel $a $b} } incr counter } } ::deken::update_installbutton [winfo toplevel $resultsid] } proc ::deken::textresults::clear_selection {resultsid} { if { [winfo exists $resultsid] } { foreach {a b} [${resultsid} tag ranges sel] {${resultsid} tag remove sel $a $b} } } ## deken::treeresults: show versions of libraries in a tree-view # TASKs # - each library (distinguished by name) is a separate (expandable/collapsible) node # - expanding a library node shows all versions # - the library node shows which version of the library is going to be installed (if any) # - the tree can be sorted in both directions by clicking on any of the headings # SELECTING which library to install # - clicking on a version # - if the version was currently selected for installation, it is now deselected # - otherwise select this version to be installed # - clicking on a library node # - if no version of the given library has been selected, this selects the most recent compatible version # - otherwise the library is deselected from installation # - multiple selections # - ideally we would just forbid ctrl-clicking for multiple selections # - otherwise, this would select the the most recent compatible version # # CAVEATs # - interaccting with the selection for library 'x' should not interfere with the selection of library 'y' # - incompatible archs should be marked somehow # - incompatible archs must always be explicitly selected # - TODO: what about multi-selecting incompatible archs of only a single library? # - TODO: what about multi-selecting a couple of libraries where some only have incompatible archs? namespace eval ::deken::treeresults:: { } array set ::deken::treeresults::colsort {} array set ::deken::treeresults::skipclick {} array set ::deken::treeresults::activecell {} proc ::deken::treeresults::columnsort {treeid {col "#0"}} { # do we want to sort increasing or decreasing? variable colsort if {! [info exists colsort($col) ] } { set colsort($col) 1 } set colsort($col) [expr ! $colsort($col)] set dir -increasing if { $colsort($col) } { set dir -decreasing } # do the actual sorting if { $col eq "#0" } { set sortable {} foreach lib [$treeid children {}] { lappend sortable [list [$treeid item $lib -text] $lib] } set pkgs {} foreach x [lsort -nocase $dir -index 0 $sortable] { lappend pkgs [lindex $x 1] } $treeid children {} $pkgs } else { foreach lib [$treeid children {}] { set sortable {} foreach pkg [$treeid children $lib] { lappend sortable [list [$treeid set $pkg $col] $pkg] } set pkgs {} foreach x [lsort -nocase $dir -index 0 -command ::deken::versioncompare $sortable] { lappend pkgs [lindex $x 1] } $treeid children $lib $pkgs } } ## add some decoration to the header indicating the sort-direction set label_incr "\u2b07" set label_decr "\u2b06" set dirsym "${label_incr}" if { $dir eq "-decreasing" } { set dirsym "${label_decr}" } # clear all the increasing/decreasing indicators from the headings foreach c [$treeid cget -columns] { $treeid heading $c -text [regsub "(${label_decr}|${label_incr})$" [$treeid heading $c -text] {}] } set c "#0" $treeid heading $c -text [regsub "(${label_decr}|${label_incr})$" [$treeid heading $c -text] {}] # and finally set the increasing/decreasing indicator for the sorted column $treeid heading $col -text [$treeid heading $col -text]$dirsym } proc ::deken::treeresults::focusbyindex {treeid index} { # make sure that the entry <index> is visible $treeid yview $index } proc ::deken::treeresults::getselected {treeid} { set sel {} foreach id [$treeid children {}] { set data [$treeid item $id -values] if { "${data}" eq {} } { continue } lappend sel [linsert $data 0 [$treeid item $id -text]] } return $sel } proc ::deken::treeresults::selection_skip {treeid {state 1}} { # expanding/collapsing a node results in a selection message # so we set a flag to skip it variable skipclick if { ! [info exists skipclick($treeid)] } { set skipclick($treeid) 0 } set skip $skipclick($treeid) set skipclick($treeid) $state return $skip } proc ::deken::treeresults::selection_changed {treeid} { if { [::deken::treeresults::selection_skip $treeid 0] } { return } $treeid tag remove selpkg foreach sel [$treeid selection] { set lib [$treeid parent $sel] if { $lib eq {} } { # library node set lib $sel if { [$treeid item $sel -values] eq {} } { # currently no data, find the best match! set children {} foreach child [$treeid children $lib] { set data [$treeid item $child -values] if {[lindex $data 4]} { lappend children [list [lindex $data 0] $child] } } set children [lsort -decreasing -index 0 -command ::deken::versioncompare $children] set sel {} foreach child $children { foreach {version sel} $child {break} break } if { $sel != {}} { $treeid item $lib -values [$treeid item $sel -values] $treeid tag add selpkg $sel } } else { $treeid item $lib -values {} } } else { # package (leaf) set data [$treeid item $sel -values] if { $data eq [$treeid item $lib -values] } { # we were already selected, so deselect us $treeid item $lib -values {} } else { $treeid item $lib -values $data $treeid tag add selpkg $sel } } } ## fixup the selection set bound [bind $treeid <<TreeviewSelect>>] bind $treeid <<TreeviewSelect>> {} # unselect the old ones, and select the new ones $treeid selection remove [$treeid selection] set counter 0 set ::deken::selected {} foreach id [$treeid children {}] { set data [$treeid item $id -values] if { $data eq {} } { continue } $treeid selection add $id lappend ::deken::selected [$treeid item $id -text] [lindex $data 5] } ::deken::update_installbutton [winfo toplevel $treeid] after idle "bind $treeid <<TreeviewSelect>> \{$bound\}" } proc ::deken::treeresults::presorter {A B} { # <a>, <b>: [<pkgname> <version> <title> <uploader> <timestamp> <match> <cmd> <contextcmd>] # compare to library lists: <pkgname> (ascending), <match> (descending), <version> (descending), <date> (descending) foreach {a_name a_ver _ _ a_time a_match} $A {break} foreach {b_name b_ver _ _ b_time b_match} $B {break} if {$a_name < $b_name} { return 1 } elseif {$a_name > $b_name} { return -1 } if {$a_match < $b_match} { return -1 } elseif {$a_match > $b_match} { return 1 } set v [::deken::versioncompare $a_ver $b_ver] if { $v != "0" } {return $v} if {$a_time < $b_time} { return -1 } elseif {$a_time > $b_time} { return 1 } return 0 } proc ::deken::treeresults::motionevent {treeid x y} { set item [$treeid identify item $x $y] set data [$treeid item $item -values] if {! [info exists ::deken::treeresults::activecell($treeid) ] } { set ::deken::treeresults::activecell($treeid) {} } set title [lindex $data 1] set status [lindex $data 7] set subtitle [lindex $data 8] # the status bar if { "$status" != "" } { ::deken::status $status } # the balloon if { $::deken::treeresults::activecell($treeid) != $item } { set ::deken::treeresults::activecell($treeid) $item set X [expr "[winfo rootx $treeid] + 10"] set Y [expr "[winfo rooty $treeid] + $y + 10"] ::deken::balloon::show ${treeid}_balloon $X $Y [string trim "$title\n$subtitle"] } } proc ::deken::treeresults::leaveevent {treeid} { set ::deken::treeresults::activecell($treeid) {} ::deken::balloon::hide ${treeid}_balloon } proc ::deken::treeresults::doubleclick {treeid x y} { set item [$treeid identify item $x $y] set installitem $item if { [$treeid bbox $item] eq {} } { set installitem {} } if { $installitem eq {} } { # the user double-clicked on a column heading set column [$treeid identify column $x $y] if { $column eq "#0" } { # we don't want to sort by column#0 # instead we open/close the items set have_open 0 set have_close 0 foreach lib [$treeid children {}] { if { [$treeid item $lib -open] } { incr have_open } else { incr have_close } } set do_open [expr $have_close > $have_open] foreach lib [$treeid children {}] { $treeid item $lib -open $do_open } return } set column [$treeid column $column -id] # do we want to sort increasing or decreasing? variable colsort if {! [info exists colsort($column) ] } { set colsort($column) 1 } set dir -increasing if { $colsort($column) } { set dir -decreasing } set sortable {} foreach lib [$treeid children {}] { foreach pkg [$treeid children $lib] { lappend sortable [list [$treeid set $pkg $column] $lib] break } } set pkgs {} foreach x [lsort -nocase $dir -index 0 -command ::deken::versioncompare $sortable] { lappend pkgs [lindex $x 1] } $treeid children {} $pkgs if { $item eq {} } { # yikes: if we are not scrolled down, the double-click will trigger columnsort twice # so we do an extra round here... ::deken::treeresults::columnsort $treeid $column } return } set data [$treeid item $item -values] set cmd [lindex $data 5] if { $cmd != "" } { ::deken::post "" eval $cmd } } proc ::deken::treeresults::show {treeid} { # shown: library, version, title, uploader, date set libraries {} foreach r $::deken::results { foreach {title cmd match subtitle statusline contextcmd pkgname version uploader timestamp} $r {break} if { "${::deken::hideforeignarch}" } { if { ! ${match} } { continue } } lappend libraries [list $pkgname $version $title $uploader $timestamp $match $cmd $contextcmd $statusline $subtitle] } # sort the libraries set libraries [lsort -decreasing -command ::deken::treeresults::presorter $libraries] set lastlib {} set index {} ##foreach v {"#0" version title uploader date} { ## set width($v) 0 ##} #puts [time { foreach lib $libraries { set l [lindex $lib 0] set data [lrange $lib 1 end] if {$l ne $lastlib} { set lastlib $l set index [$treeid insert {} end -text $l -open 0 -tags {library}] ##set w [font measure {-underline false} -displayof $treeid $l] ##if {$w > $width(#0)} {set width(#0) $w} } set archtag noarchmatch if { [lindex $lib 5] } { set archtag archmatch } set x [$treeid insert $index end -values $data -tags [list package $archtag]] ##set vidx 0 ##foreach v {version title uploader date} { ## set w [font measure {-underline false} -displayof $treeid [lindex $data $vidx]] ## incr vidx ## if { $w > $width($v) } {set width($v) $w } ##} $treeid tag add $x $x ::deken::bind_contextmenu $treeid $x [lindex $lib 7] } #}] ### setting the width as a few caveats ## - we end up with cut off texts anyhow ## (i guess this is mostly a problem with requiring too much text) ## - the widths don#t get fully applied automatically ## (as soon as you drag one of the column delimiters, the other snap into place) ## - it takes forever. ## (simply calculating the required widths for 148 entries takes ~7200ms, ## as opposed to ~1.2ms for not calculating them) ## #foreach v {version title uploader date} { # incr width($v) 10 # $treeid column $v -width $width($v) #} } proc ::deken::treeresults::clear {resultsid} { $resultsid delete [$resultsid children {}] } proc ::deken::treeresults::clear_selection {treeid} { if { ! [winfo exists $treeid] } { return } set bound [bind $treeid <<TreeviewSelect>>] bind $treeid <<TreeviewSelect>> {} # unselect the old ones, and select the new ones $treeid selection remove [$treeid selection] $treeid tag remove selpkg foreach item [$treeid children {}] { $treeid item $item -values {} } after idle "bind $treeid <<TreeviewSelect>> \{$bound\}" } ######################################################## proc ::deken::show_results {resultsid} { ::deken::textresults::show $resultsid } proc ::deken::clear_results {resultsid} { ::deken::textresults::clear $resultsid } proc ::deken::clear_selection {resultsid} { ::deken::textresults::clear_selection $resultsid } ######################################################## ## tooltips # code based on example by Donal Fellows in 2001 # https://groups.google.com/g/comp.lang.tcl/c/IhNlXBxL1_I/m/sF4sNhpi7XQJ namespace eval ::deken::balloon { } proc ::deken::balloon::show {winid x y msg {x_offset 0} {y_offset 0}} { set ::deken::balloon::message($winid) $msg if {![winfo exist $winid]} { toplevel ${winid} wm overrideredirect ${winid} 1 label ${winid}.label \ -highlightthick 0 -relief solid -borderwidth 1 \ -textvariable ::deken::balloon::message($winid) pack ${winid}.label -expand 1 -fill x } if { $msg == {} } { wm withdraw ${winid} return } set g [format +%d+%d [expr $x + $x_offset] [expr $y + $y_offset]] # This is probably overdoing it, but better too much than too little wm geometry ${winid} $g wm deiconify ${winid} wm geometry ${winid} $g raise ${winid} after idle "[list wm geometry $winid $g]; raise $winid" } proc ::deken::balloon::hide {winid} { if {[winfo exist ${winid}]} { wm withdraw ${winid} } } ######################################################## proc ::deken::ask_installdir {{installdir ""} {extname ""}} { while {1} { if { "$installdir" == "" } { set result [tk_messageBox \ -message [_ "Please select a (writable) installation directory!"] \ -icon warning -type retrycancel -default retry \ -parent $::deken::winid] switch -- "${result}" { cancel {return} retry { if {[::deken::prompt_installdir]} { set installdir $::deken::installpath } else { continue } } } } else { set result [tk_messageBox \ -message [format [_ "Install %1\$s to %2\$s?" ] $extname $installdir] \ -icon question -type yesnocancel -default yes \ -parent $::deken::winid] switch -- "${result}" { cancel {return} yes { } no { set prevpath $::deken::installpath if {[::deken::prompt_installdir]} { set keepprevpath 1 set installdir $::deken::installpath # if docsdir is set & the install path is valid, # saying "no" is temporary to ensure the docsdir # hierarchy remains, use the Path dialog to override if {[namespace exists ::pd_docsdir] && [::pd_docsdir::path_is_valid] && [file writable [file normalize $prevpath]] } { set keepprevpath 0 } if {$keepprevpath} { set ::deken::installpath $prevpath } } else { continue } } } } if { "$installdir" != "" } { # try creating the installdir...just in case catch { file mkdir $installdir } } # check whether this is a writable directory set installdir [ ::deken::utilities::get_writabledir [list $installdir ] ] if { "$installdir" != "" } { # stop looping if we've found our dir break } } return $installdir } proc ::deken::ensure_installdir {{installdir ""} {extname ""}} { ## make sure that the destination path exists ### if ::deken::installpath is set, use the first writable item ### if not, get a writable item from one of the searchpaths ### if this still doesn't help, ask the user if { "$installdir" != "" } {return $installdir} set installdir [::deken::find_installpath] if { "$installdir" != "" } {return $installdir} if {[namespace exists ::pd_docsdir] && [::pd_docsdir::externals_path_is_valid]} { # if the docspath is set, try the externals subdir set installdir [::pd_docsdir::get_externals_path] } if { "$installdir" != "" } {return $installdir} # ask the user (and remember the decision) ::deken::prompt_installdir set installdir [ ::deken::utilities::get_writabledir [list $::deken::installpath ] ] return [::deken::ask_installdir [::deken::utilities::expandpath $installdir ] $extname] } # handle a clicked link proc ::deken::install_link {URL filename} { ## make sure that the destination path exists ### if ::deken::installpath is set, use the first writable item ### if not, get a writable item from one of the searchpaths ### if this still doesn't help, ask the user variable winid set installbutton ${winid}.status.install if {[winfo exists $installbutton]} { $installbutton configure -state disabled } ::deken::show_tab $winid info set installdir [::deken::ensure_installdir "" ${filename}] if { "${installdir}" == "" } { ::deken::utilities::debug [format [_ "Cancelling download of '%s': No installation directory given." ] $filename] ::deken::statuspost [format [_ "Installing to non-existent directory failed" ] $filename] error return } if { ! [file exists $installdir] } { ::deken::post [format [_ "Unable to install to '%s'" ] $installdir ] error set msg [_ "Directory does not exist!" ] ::deken::post "\t$msg" error return } if { [::deken::utilities::get_writabledir [list $installdir]] == "" } { ::deken::post [format [_ "Unable to install to '%s'" ] $installdir ] error set msg [_ "Directory is not writable!" ] ::deken::post "\t$msg" error return } set parsedfilename [::deken::utilities::parse_filename $filename] set fullpkgfile [::deken::utilities::get_tmpfilename $installdir [::deken::utilities::get_filenameextension $filename] "[lindex $parsedfilename 0]\[[lindex $parsedfilename 1]\]" ] ::deken::statuspost [format [_ "Downloading '%s'" ] $filename] info 0 ::deken::utilities::debug [format [_ "Commencing download of '%1\$s' into '%2\$s'..." ] $URL $installdir] ::deken::syncgui set fullpkgfile [::deken::utilities::download_file $URL $fullpkgfile "::deken::download_progress"] if { "$fullpkgfile" eq "" } { ::deken::utilities::debug [_ "aborting."] ::deken::statuspost [format [_ "Downloading '%s' failed" ] $filename] error ::deken::progressstatus [_ "Download failed!" ] ::deken::progress 0 return } set msg [_ "Download completed! Verifying..." ] ::deken::progressstatus $msg ::deken::post "$msg" info set result [::deken::verify_sha256_gui ${URL} ${fullpkgfile}] if { ! $result } { # verification failed if { ! "$::deken::keep_package" } { catch { file delete $fullpkgfile } } ::deken::progress 0 return } if { $result < 0 } { # verification failed, but we ignore it if { $result > -10 } { ::deken::statuspost [_ "Ignoring checksum mismatch" ] info 0 } elseif { $result > -100 } { ::deken::statuspost [_ "Ignoring checksum errors" ] info 0 } } ::deken::install_package ${fullpkgfile} ${filename} ${installdir} ${::deken::keep_package} ::deken::update_installbutton $winid } # print the download progress to the results window proc ::deken::download_progress {token total current} { if { $total > 0 } { ::deken::progress [expr {round(100 * (1.0 * $current / $total))}] } } # test for platform match with our current platform proc ::deken::architecture_match {archs} { if { "translations" eq "${::deken::searchtype}" } { foreach arch $archs { if { "i18n" eq "${arch}" } { return 1 } if {[string match "i18n-*" ${arch}] } { return 1 } } return 0 } # if there are no architecture sections this must be arch-independent if { ! [llength $archs] } { return 1} set OS "$::deken::platform(os)" set MACHINE "$::deken::platform(machine)" set BITS "$::deken::platform(bits)" set FLOATSIZE "$::deken::platform(floatsize)" if { "$::deken::userplatform" != "" } { ## FIXXME what if the user-supplied input isn't valid? regexp -- {(.*)-(.*)-(.*)} $::deken::userplatform _ OS MACHINE FLOATSIZE } # strip the little-endian indicator from arm-archs, it's the default regexp -- {(armv[0-9]*)[lL]} $MACHINE _ MACHINE # check each architecture in our list against the current one foreach arch $archs { if { [ regexp -- {(.*)-(.*)-(.*)} $arch _ os machine floatsize ] } { # normalize arm-architectures by stripping away sub-architectures # TODO: leave any big-endian indicator in place regexp -- {(armv[0-9]*)[^0-9]*} $machine _ machine if { ("${os}" eq "${OS}") && (("${floatsize}" eq "${FLOATSIZE}") || ("${floatsize}" eq "0"))} { ## so OS and floatsize match... ## check whether the CPU matches as well if { "${machine}" eq "${MACHINE}" } {return 1} ## not exactly; see whether it is in the list of compat CPUs if {[llength [array names ::deken::architecture_substitutes -exact "${MACHINE}"]]} { foreach cpu $::deken::architecture_substitutes(${MACHINE}) { if { "${machine}" eq "${cpu}" } {return 1} } } } } } return 0 } proc ::deken::search_for {term} { set result [list] foreach searcher $::deken::backends { if {[catch { foreach r [ $searcher $term ] { if { "" eq [lindex $r 0] } { # data is already normalized } else { # legacy data format foreach {title cmd match comment status} $r {break} set r [::deken::normalize_result $title $cmd $match $comment $status] } lappend result [lrange $r 1 end] } } stdout] } { ::deken::utilities::debug "$searcher: $stdout" } } return $result } proc ::deken::initialize {} { # console message to let them know we're loaded ## but only if we are being called as a plugin (not as built-in) if { "" != "$::current_plugin_loadpath" } { ::pdwindow::debug [format [_ "\[deken\] deken-plugin.tcl (Pd externals search) loaded from %s." ] $::current_plugin_loadpath ] ::pdwindow::debug "\n" } set msg [format [_ "\[deken\] Platform detected: %s" ] [::deken::platform2string 1] ] ::pdwindow::verbose 0 "${msg}\n" # try to set install path when plugin is loaded set ::deken::installpath [::deken::find_installpath] # create an entry for our search in the "help" menu (or reuse an existing one) set mymenu .menubar.help if { [catch { $mymenu entryconfigure [_ "Find externals"] -command {::deken::open_searchui $::deken::winid} } _ ] } { $mymenu add separator $mymenu add command -label [_ "Find externals"] -command {::deken::open_searchui $::deken::winid} } # bind all <$::modifier-Key-s> {::deken::open_helpbrowser .helpbrowser2} } # ###################################################################### # ################ search backends ##################################### # ###################################################################### proc ::deken::register {fun} { # register a searchfunction with deken. # the searchfunction <fun> will be called with a <searchterm>, # and must return a list of <result>. # <searchterm> is a list of (whitespace separated) words. # each word denotes a library or library-object to search for and may # contain wildcards ("*"). # the <result> should be normalized via ::deken::search::normalize_result # failing to do so, a <result> is a list <name> <cmd> <match> <comment> <status> <args...> # - <title> non-empty name of the library (to be shown to the user as search-result) # - <cmd> the full command to run to install the library # - <match> boolean value to indicate whether this entry matches the current architecture # - <subtitle> additional text to be shown under the <name> # - <status> additional text to be shown in the STATUS line if the mouse hovers over the result # - <args>... additional args (ignored) # the library <name> must be non-empty (and empty value is reserved for normalized results) set ::deken::backends [linsert $::deken::backends 0 $fun] } ## API draft # each backend is implemented via a single proc ## that takes a single argument "term", the term to search for ## an empty term indicates "search for all" # the backend then returns a list of results ## each result is a list of the following elements: ## <title> <cmd> <match> <comment> <status> ## title: the primary name to display ## (the user will select the element by this name) ## e.g. "frobscottle-1.10 (Linux/amd64)" ## cmd : a command that will install the selected library ## e.g. "[list ::deken::install_link http://bfg.org/frobscottle-1.10.zip frobscottle-1.10.zip]" ## match: an integer indicating whether this entry is actually usable ## on this host (1) or not (0) ## comment: secondary line to display ## e.g. "uploaded by the BFG in 1982" ## status: line to display in the status-line ## e.g. "http://bfg.org/frobscottle-1.10.zip" # note on sorting: ## the results ought to be sorted with most up-to-date first ## (filtering based on architecture-matches should be ignored when sorting!) # note on helper-functions: ## you can put whatever you like into <cmd>, even your own proc # registration ## to register a new search function, call `::deken::register $myfun` # namespace ## you are welcome to use the ::deken::search:: namespace ## #################################################################### ## searching puredata.info namespace eval ::deken::search::dekenserver { } proc ::deken::search::dekenserver::search {term} { set dekenurl "${::deken::protocol}://deken.puredata.info/search" catch {set dekenurl $::env(DEKENSERVER)} stdout catch {set dekenurl $::env(DEKEN_SEARCH_URL)} stdout set urls [list $dekenurl] # search all the urls array set results {} set urlcount 0 foreach s $urls { # skip empty urls if { $s eq {} } { continue } ::deken::post [format [_ "Searching on %s..."] $s ] debug set resultcount 0 # get the results from the given url, and add them to our results set foreach r [::deken::search::dekenserver::search_server $term $s] { set results($r) {} incr resultcount } ::deken::post [format [_ "Searching on %1\$s returned %2\$d results"] $s $resultcount] debug incr urlcount } if { $urlcount == 0 } { ::deken::post [format [_ "No usable servers for searching found..."] $s ] debug } set splitCont [array names results] if { [llength $splitCont] == 0 } { return $splitCont } set searchresults [list] # loop through the resulting tab-delimited table if { [catch { set latestrelease0 [dict create] set latestrelease1 [dict create] set newestversion [dict create] foreach ele $splitCont { set ele [ string trim $ele ] if { "" ne $ele } { foreach {name URL creator date} [ split $ele "\t" ] {break} set filename [ file tail $URL ] foreach {pkgname version archs} [ ::deken::utilities::parse_filename $filename ] {break} #if { $version eq "0.0.extended" } { set date "0000-00-00 00:02:00" } set olddate {} set match [::deken::architecture_match "$archs" ] if { ${match} } { catch { set olddate [dict get ${latestrelease1} $pkgname] } set oldversion {} catch { set oldversion [dict get ${newestversion} $pkgname]} if { [::deken::versioncompare $version $oldversion] > 0 } { dict set newestversion $pkgname $version } } else { catch { set olddate [dict get ${latestrelease0} $pkgname] } } if { $date > $olddate } { dict set latestrelease${match} $pkgname $date } } } } stdout ] } { set latestrelease0 {} set latestrelease1 {} set newestversion {} } set vsep "\u0001" foreach ele $splitCont { set ele [ string trim $ele ] if { "" ne $ele } { foreach {name URL creator date} [ split $ele "\t" ] {break} set decURL [::deken::utilities::urldecode $URL] set filename [ file tail $URL ] set cmd [list ::deken::install_link $decURL $filename] set pkgverarch [ ::deken::utilities::parse_filename $filename ] set pkgname [lindex $pkgverarch 0] set version [lindex $pkgverarch 1] set archs [lindex $pkgverarch 2] set match [::deken::architecture_match "$archs" ] set comment [format [_ "Uploaded by %1\$s @ %2\$s" ] $creator $date ] set status $URL set sortprefix "0000-00-00 00:01:00" if { ${match} == 0 } { catch { set sortprefix [dict get ${latestrelease0} $pkgname] } } else { if { "${::deken::hideoldversions}" } { # If this version is not the newest one, mark it as unmatched catch { set oldversion [dict get ${newestversion} $pkgname] if { [::deken::versioncompare $version $oldversion] < 0 } { set match 0 } } } } catch { set sortprefix [dict get ${latestrelease1} $pkgname] } # the ${vsep} should sort before all other characters that might appear in version strings, # as it unsures that "1.2" sorts before "1.2-1" # the space (or some other character that sorts after "\t") after the ${version} is important, # as it ensures that "0.2~1" sorts before "1.2" set sortname "${sortprefix}${vsep}${pkgname}${vsep}${version} ${vsep}${date}" set contextcmd [list ::deken::search::dekenserver::contextmenu %W %x %y $pkgname $URL] set res [list $sortname $filename $name $cmd $match $comment $status $contextcmd $pkgname $version $creator $date] lappend searchresults $res } } set sortedresult [] foreach r [lsort -command ::deken::versioncompare -decreasing -index 0 $searchresults ] { foreach {sortname filename title cmd match comment status menus pkgname version creator date} $r { lappend sortedresult [::deken::normalize_result $title $cmd $match $comment $status $menus $pkgname $version $creator $date] break } } return $sortedresult } proc ::deken::search::dekenserver::search_server {term dekenurl} { set queryterm {} if { ${::deken::searchtype} eq "translations" && ${term} eq "" } { # special handling of searching for all translations (so we ONLY get translations) set term {*} } foreach x $term {lappend queryterm ${::deken::searchtype} $x} if { [ catch {set queryterm [::http::formatQuery {*}$queryterm ] } stdout ] } { set queryterm [ join $term "&${::deken::searchtype}=" ] set queryterm "${::deken::searchtype}=${queryterm}" } # deken-specific socket config set httpaccept [::http::config -accept] set httpagent [::deken::utilities::httpuseragent] ::http::config -accept text/tab-separated-values # fetch search result if { [catch { set token [::http::geturl "${dekenurl}?${queryterm}"] } stdout ] } { set msg [format [_ "Searching for '%s' failed!" ] $term ] tk_messageBox \ -title [_ "Search failed" ] \ -message "${msg}\n$stdout" \ -icon error -type ok \ -parent $::deken::winid return } # restore http settings ::http::config -accept $httpaccept ::http::config -useragent $httpagent set ncode [::http::ncode $token] if { $ncode != 200 } { set err [::http::code $token] set msg [_ "Unable to perform search."] ::deken::utilities::debug "$msg\n ${err}" return {} } set contents [::http::data $token] ::http::cleanup $token return [split $contents "\n"] } proc ::deken::search::dekenserver::contextmenu {widget theX theY pkgname URL} { set winid ${::deken::winid} set resultsid ${::deken::resultsid} set with_installmenu 1 catch { # don't show the select/install entries when using a treeview $resultsid identify item 0 0 set with_installmenu 0 } set m .dekenresults_contextMenu destroy $m menu $m set saveURL [string map {"[" "%5B" "]" "%5D"} $URL] if { $with_installmenu } { set decURL [::deken::utilities::urldecode $URL] set filename [ file tail $URL ] set pkgverarch [ ::deken::utilities::parse_filename $filename ] set pkgname [lindex $pkgverarch 0] set cmd [list ::deken::install_link $decURL $filename] set selcount 0 set selected 0 foreach {k v} $::deken::selected { if { ${v} != {} } {incr selcount} if { ($k eq $pkgname) && ($v eq $cmd) } { set selected 1 break } } set msg [_ "Select package for installation" ] if { $selected } { set msg [_ "Deselect package" ] } $m add command -label "${msg}" -command "::deken::textresults::selectpackage $resultsid $pkgname {$cmd}" $m add separator } set infoq "url=${URL}" if {$::tcl_platform(platform) ne "windows"} { set infoq [::http::formatQuery url ${URL}] } $m add command -label [_ "Open package webpage" ] -command "pd_menucommands::menu_openfile \{https://deken.puredata.info/info?$infoq\}" $m add command -label [_ "Copy package URL" ] -command "clipboard clear; clipboard append $saveURL" $m add command -label [_ "Copy SHA256 checksum URL" ] -command "clipboard clear; clipboard append ${saveURL}.sha256" $m add command -label [_ "Copy OpenGPG signature URL" ] -command "clipboard clear; clipboard append ${saveURL}.asc" set installpath [::deken::find_installpath] if { "$installpath" ne {} } { if { [file isdir [file join $installpath $pkgname]] } { $m add separator $m add command -label [format [_ "Uninstall '%s'" ] $pkgname] -command [list ::deken::menu_uninstall_package $winid $pkgname $installpath] } } tk_popup $m [expr [winfo rootx $widget] + $theX] [expr [winfo rooty $widget] + $theY] } ::deken::initialize ::deken::register ::deken::search::dekenserver::search }