[SCM] deken/master: New upstream version 0.2.6
umlaeute at users.alioth.debian.org
umlaeute at users.alioth.debian.org
Sun Jan 14 20:30:42 UTC 2018
The following commit has been merged in the master branch:
commit 85819602e55542760a78f54e7953b0a1c58115ab
Author: IOhannes m zmölnig <zmoelnig at umlautS.umlaeute.mur.at>
Date: Sun Jan 14 21:22:01 2018 +0100
New upstream version 0.2.6
diff --git a/.gitignore b/.gitignore
deleted file mode 100644
index 428663d..0000000
--- a/.gitignore
+++ /dev/null
@@ -1,6 +0,0 @@
-.*.swp
-virtualenv*
-build
-workspace
-deken.cfg
-.DS_Store
diff --git a/README.md b/README.md
index 896647f..06e887a 100644
--- a/README.md
+++ b/README.md
@@ -13,11 +13,18 @@ so there is no need to manually install it.
Main development of the plugin is still happening in *this* repository,
so you might want to manually install the plugin to help testing new features.
-## Download ##
+When manually installing the `deken-plugin`, Pd will use it if (and only if) it has a greater version number
+than the one included in Pd.
+In this case you will see something like the following in the Pd-console (you first have to raise the verbosity to `Debug`):
+
+> `[deken]: installed version [0.2.1] < 0.2.3...overwriting!`
+> `deken-plugin.tcl (Pd externals search) in /home/frobnozzel/.local/lib/pd/extra/deken-plugin/ loaded.`
+
+## Download/Install ##
Click to download [deken-plugin.tcl](https://raw.githubusercontent.com/pure-data/deken/master/deken-plugin.tcl) and save it to your Pd folder:
- * Linux = `~/pd-externals/deken-plugin/`
+ * Linux = ~/.local/lib/pd/extra/deken-plugin/` (with Pd<0.47 try `~/pd-externals/deken-plugin/`)
* OSX = `~/Library/Pd/deken-plugin/`
* Windows = `%AppData%\Pd\deken-plugin\`
diff --git a/deken-extra-plugins/deken-xtra-apt-plugin.tcl b/deken-extra-plugins/deken-xtra-apt-plugin.tcl
index 372ddf1..d44eb3e 100644
--- a/deken-extra-plugins/deken-xtra-apt-plugin.tcl
+++ b/deken-extra-plugins/deken-xtra-apt-plugin.tcl
@@ -1,6 +1,6 @@
# META NAME PdExternalsSearch
-# META DESCRIPTION Search for externals zipfiles on puredata.info
-# META AUTHOR <Chris McCormick> chris at mccormick.cx
+# META DESCRIPTION Search for externals Debian-packages via apt
+# META AUTHOR IOhannes m zmölnig <zmoelnig at iem.at>
# ex: set setl sw=2 sts=2 et
# Search URL:
@@ -112,12 +112,7 @@ proc ::deken::apt::register { } {
if { [ catch { exec apt-cache madison } _ ] } { } {
if { [ catch { exec which grep-aptavail } _ ] } { } {
if { [ catch {
- ## oye a hack to get the apt-backend at the beginning of the backends
- if { [ info exists ::deken::backends ] } {
- set ::deken::backends [linsert $::deken::backends 0 ::deken::apt::search ]
- } {
- ::deken::register ::deken::apt::search
- }
+ ::deken::register ::deken::apt::search
} ] } {
::pdwindow::debug "Not using APT-backend for unavailable deken\n"
} {
diff --git a/deken-plugin.tcl b/deken-plugin.tcl
index 4fc4fdf..1daa25e 100644
--- a/deken-plugin.tcl
+++ b/deken-plugin.tcl
@@ -7,6 +7,16 @@
# 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
# If Tk or Ttk is needed
@@ -16,12 +26,46 @@ package require Tcl 8.4
# 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} ] } {} {
+ ::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} ] } {} {
+ ::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
+
+ # whether to use http:// or https://
+ variable protocol
+}
+
+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
}
+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)
@@ -31,16 +75,19 @@ proc ::deken::versioncheck {version} {
set v1 [split $version "."]
foreach x $v0 y $v1 {
if { $x > $y } {
- ::pdwindow::debug "\[deken\]: installed version \[$::deken::version\] > $version...skipping!\n"
+ ::pdwindow::debug [format [_ "\[deken\]: installed version \[%1\$s\] > %2\$s...skipping!" ] $::deken::version $version ]
+ ::pdwindow::debug "\n"
return 0
}
if { $x < $y } {
- ::pdwindow::debug "\[deken\]: installed version \[$::deken::version\] < $version...overwriting!\n"
+ ::pdwindow::debug [format [_ "\[deken\]: installed version \[%1\$s] < %2\$s...overwriting!" ] $::deken::version $version ]
+ ::pdwindow::debug "\n"
set ::deken::version $version
return 1
}
}
- ::pdwindow::debug "\[deken\]: installed version \[$::deken::version\] == $version...skipping!\n"
+ ::pdwindow::debug [format [_ "\[deken\]: installed version \[%1\$s\] == %2\$s...skipping!" ] $::deken::version $version ]
+ ::pdwindow::debug "\n"
return 0
}
set ::deken::version $version
@@ -48,7 +95,24 @@ proc ::deken::versioncheck {version} {
}
## put the current version of this package here:
-if { [::deken::versioncheck 0.2.1] } {
+if { [::deken::versioncheck 0.2.6] } {
+
+## FIXXXXME only initialize vars if not yet set
+set ::deken::installpath {}
+set ::deken::userplatform {}
+set ::deken::hideforeignarch 0
+set ::deken::show_readme 1
+set ::deken::remove_on_install 0
+set ::deken::add_to_path 0
+set ::deken::preferences::installpath {}
+set ::deken::preferences::userinstallpath {}
+set ::deken::preferences::platform {}
+set ::deken::preferences::userplatform {}
+set ::deken::preferences::hideforeignarch {}
+set ::deken::preferences::show_readme {}
+set ::deken::preferences::remove_on_install {}
+set ::deken::preferences::add_to_path {}
+set ::deken::preferences::add_to_path_temp {}
namespace eval ::deken:: {
namespace export open_searchui
@@ -59,35 +123,50 @@ namespace eval ::deken:: {
variable statustext
variable statustimer
variable backends
+ variable progressvar
namespace export register
}
namespace eval ::deken::search:: { }
+set ::deken::installpath ""
set ::deken::statustimer ""
+set ::deken::userplaform ""
+set ::deken::hideforeignarch false
-set ::deken::backends [list]
-proc ::deken::register {fun} {
- set ::deken::backends [linsert $::deken::backends 0 $fun]
+set ::deken::protocol "http"
+if { ! [catch {package present tls} stdout] } {
+ set ::deken::protocol "https"
}
-proc ::deken::gettmpdir {} {
- proc _iswdir {d} { expr [file isdirectory $d] * [file writable $d] }
- set tmpdir ""
- catch {set tmpdir $::env(TRASH_FOLDER)} ;# very old Macintosh. Mac OS X doesn't have this.
- if {[_iswdir $tmpdir]} {return $tmpdir}
- catch {set tmpdir $::env(TMP)}
- if {[_iswdir $tmpdir]} {return $tmpdir}
- catch {set tmpdir $::env(TEMP)}
- if {[_iswdir $tmpdir]} {return $tmpdir}
- set tmpdir "/tmp"
- set tmpdir [pwd]
- if {[_iswdir $tmpdir]} {return $tmpdir}
+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::is_writable_dir {path} {
+ set fs [file separator]
+ set access [list RDWR CREAT EXCL TRUNC]
+ set tmpfile [::deken::get_tmpfilename $path]
+ # try creating tmpfile
+ if {![catch {open $tmpfile $access} channel]} {
+ close $channel
+ file delete $tmpfile
+ return true
+ }
+ return false
}
-proc ::deken::vbs_unzipper {zipfile {path .}} {
+
+if { [catch {package require zipfile::decode} ] } {
+proc ::deken::utilities::unzipper {zipfile {path .}} {
## this is w32 only
if { "Windows" eq "$::deken::platform(os)" } { } { return 0 }
if { "" eq $::deken::_vbsunzip } {
- set ::deken::_vbsunzip [ file join [::deken::gettmpdir] unzip.vbs ]
+ set ::deken::_vbsunzip [ file join [::deken::gettmpdir] deken_unzip.vbs ]
}
if {[file exists $::deken::_vbsunzip]} {} {
@@ -122,35 +201,186 @@ Set objShell = Nothing
return 0
}
## try to call the script
- if { [ catch { exec cscript $::deken::_vbsunzip $zipfile .} stdout ] } {
+ if { [ catch { exec cscript $::deken::_vbsunzip "${zipfile}" .} stdout ] } {
::pdwindow::debug "\[deken\] VBS-unzip: $::deken::_vbsunzip\n$stdout\n"
return 0
}
return 1
}
+} { # successfully imported zipfile::decode
+proc ::deken::utilities::unzipper {zipfile {path .}} {
+ ::zipfile::decode::unzipfile "${zipfile}" "${path}"
+ return 1
+}
+}
set ::deken::_vbsunzip ""
-proc ::deken::get_writable_dir {paths} {
- set fs [file separator]
- set access [list RDWR CREAT EXCL TRUNC]
- foreach p $paths {
- #if { [ catch { file mkdir $p } ] } {}
- for {set i 0} {True} {incr i} {
- set tmpfile "${p}${fs}dekentmp.${i}"
- if {![file exists $tmpfile]} {
- break
+proc ::deken::utilities::extract {installdir filename fullpkgfile} {
+ # installdir fullpkgfile filename
+ set PWD [ pwd ]
+ cd $installdir
+ set success 1
+ if { [ string match *.zip $fullpkgfile ] } then {
+ if { [ ::deken::utilities::unzipper $fullpkgfile $installdir ] } { } {
+ if { [ catch { exec unzip -uo $fullpkgfile } stdout ] } {
+ ::pdwindow::debug "$stdout\n"
+ set success 0
}
}
- # try creating tmpfile
- if {![catch {open $tmpfile $access} channel]} {
- close $channel
- file delete $tmpfile
- return $p
+ } elseif { [ string match *.tar.* $fullpkgfile ]
+ || [ string match *.tgz $fullpkgfile ]
+ } then {
+ if { [ catch { exec tar xf $fullpkgfile } stdout ] } {
+ ::pdwindow::debug "$stdout\n"
+ set success 0
+ }
+ }
+ cd $PWD
+
+ if { $success > 0 } {
+ ::pdwindow::debug [_ "\[deken\]: " ]
+ ::pdwindow::debug [format [_ "Successfully unzipped %1\$s into %2\$s."] $filename $installdir ]
+ ::pdwindow::debug "\n"
+ 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
+ ::pdwindow::error [_ "\[deken\]: Unable to extract package automatically." ] warn
+ ::pdwindow::post [_ "Please perform the following steps manually:" ]
+ ::pdwindow::post [format [_ "1. Unzip %s." ] $fullpkgfile ]
+ pd_menucommands::menu_openfile $fullpkgfile
+ ::pdwindow::post [format [_ "2. Copy the contents into %s." ] $installdir]
+ ::pdwindow::post ""
+ pd_menucommands::menu_openfile $installdir
+ }
+}
+
+proc ::deken::utilities::uninstall {path library} {
+ # recursively remove ${path}/${library} if it exists
+ set fullpath [file join ${path} ${library}]
+ if {[file exists ${fullpath}]} {
+ ::pdwindow::debug [format [_ "\[deken\] uninstalling '%s'" ] ${fullpath} ]
+ ::pdwindow::debug "\n"
+ if { [catch {
+ file delete -force "${fullpath}"
+ } stdout ] } {
+ ::pdwindow::debug [format [_ "Uninstalling %1\$s from %2\$s failed!"] ${library} ${path}]
+ ::pdwindow::debug $stdout
+ ::pdwindow::debug "\n"
}
}
+}
+
+proc ::deken::utilities::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}
+}
+
+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 hide} {
+ set ::deken::userplatform $platform
+ set ::deken::hideforeignarch [::deken::utilities::bool $hide ]
+ }
+ proc ::deken::set_install_options {remove readme add} {
+ 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]
+ }
+} {
+ # Pd has a generic preferences system, that we can use
+ proc ::deken::set_installpath {installdir} {
+ set ::deken::installpath $installdir
+ ::pd_guiprefs::write dekenpath $installdir
+ }
+ # user requested platform (empty = DEFAULT)
+ set ::deken::userplatform [::pd_guiprefs::read deken_platform]
+ set ::deken::hideforeignarch [::deken::utilities::bool [::pd_guiprefs::read deken_hide_foreign_archs] ]
+ proc ::deken::set_platform_options {platform hide} {
+ set ::deken::userplatform $platform
+ set ::deken::hideforeignarch [::deken::utilities::bool $hide ]
+ ::pd_guiprefs::write deken_platform "$platform"
+ ::pd_guiprefs::write deken_hide_foreign_archs $::deken::hideforeignarch
+ }
+ set ::deken::remove_on_install [::deken::utilities::bool [::pd_guiprefs::read deken_remove_on_install] ]
+ set ::deken::show_readme [::deken::utilities::bool [::pd_guiprefs::read deken_show_readme] 1]
+ set ::deken::add_to_path [::deken::utilities::tristate [::pd_guiprefs::read deken_add_to_path] ]
+
+ proc ::deken::set_install_options {remove readme path} {
+ 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]
+ ::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"
+ }
+}
+
+set ::deken::backends [list]
+proc ::deken::register {fun} {
+ set ::deken::backends [linsert $::deken::backends 0 $fun]
+}
+proc ::deken::gettmpdir {} {
+ proc _iswdir {d} { expr [file isdirectory $d] * [file writable $d] }
+ set tmpdir ""
+ catch {set tmpdir $::env(TRASH_FOLDER)} ;# very old Macintosh. Mac OS X doesn't have this.
+ if {[_iswdir $tmpdir]} {return $tmpdir}
+ catch {set tmpdir $::env(TMP)}
+ if {[_iswdir $tmpdir]} {return $tmpdir}
+ catch {set tmpdir $::env(TEMP)}
+ if {[_iswdir $tmpdir]} {return $tmpdir}
+ set tmpdir "/tmp"
+ set tmpdir [pwd]
+ if {[_iswdir $tmpdir]} {return $tmpdir}
+}
+
+proc ::deken::get_tmpfilename {{path ""}} {
+ for {set i 0} {true} {incr i} {
+ set tmpfile [file join ${path} dekentmp.${i}]
+ if {![file exists $tmpfile]} {
+ return $tmpfile
+ }
+ }
+}
+
+proc ::deken::get_writable_dir {paths} {
+ foreach p $paths {
+ if { [ ::deken::utilities::is_writable_dir $p ] } { return $p }
+ }
return
}
+# 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?
+ set installpath [ ::deken::get_writable_dir [list $::deken::installpath ] ]
+ }
+ if { "$installpath" == "" } {
+ ## search the default paths
+ set installpath [ ::deken::get_writable_dir $::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 {} {
+ return $::deken::platform(os)-$::deken::platform(machine)-$::deken::platform(bits)
+}
+
# list-reverter (compat for tcl<8.5)
if {[info command lreverse] == ""} {
proc lreverse list {
@@ -163,47 +393,6 @@ if {[info command lreverse] == ""} {
} ;# RS
}
-
-## where to look for the config-files:
-## - near the deken-plugin.tcl file
-## + at some user-specific place (e.g. ~/pd-externals/deken-plugin/)
-## it's probably easiest to iterate through curdir and ::sys_staticpath (in reverse order)
-## and read all (existing) configurations
-#
-## the configfile's format is simple:
-# the first element of a line is the variable name, the rest the value. e.g.
-# foo bar baz
-# will create a variable '::deken::foo' with value [list bar baz]
-## LATER: this is rather insecure, as it allows people to overwrite
-## virtually everything... (e.g. ::deken::search_for)
-proc ::deken::readconfig {paths filename} {
- proc doreadconfig {fname} {
- if {[file exists $fname]} {
- set fp [open $fname r]
- while {![eof $fp]} {
- set data [gets $fp]
- if { [string is list $data ] } {
- if { [llength $data ] > 1 } {
- set ::deken::[lindex $data 0] [lrange $data 1 end]
- }
- }
- }
- return True
- }
- return False
- }
- set fs [file separator]
- doreadconfig "$::current_plugin_loadpath${fs}${filename}"
- foreach p0 [lreverse $paths] {
- foreach p1 [ list "" "${fs}deken-plugin" ] {
- doreadconfig "${p0}${p1}${fs}${filename}"
- }
- }
-}
-
-
-::deken::readconfig $::sys_staticpath deken-plugin.conf
-
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 ]
@@ -224,14 +413,16 @@ if { "Windows" eq "$::deken::platform(os)" } {
# 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::post "deken-plugin.tcl (Pd externals search) in $::current_plugin_loadpath loaded.\n"
- ::pdwindow::post "Platform detected: $::deken::platform(os)-$::deken::platform(machine)-$::deken::platform(bits)bit\n"
+ ::pdwindow::debug [format [_ "\[deken\] deken-plugin.tcl (Pd externals search) loaded from %s." ] $::current_plugin_loadpath ]
+ ::pdwindow::debug "\n"
}
+::pdwindow::verbose 0 [format [_ "\[deken\] Platform detected: %s" ] [::deken::platform2string] ]
+::pdwindow::verbose 0 "\n"
# architectures that can be substituted for eachother
array set ::deken::architecture_substitutes {}
-set ::deken::architecture_substitutes(x86_64) [list "amd64" "i386" "i586" "i686"]
-set ::deken::architecture_substitutes(amd64) [list "x86_64" "i386" "i586" "i686"]
+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(armv6l) [list "armv6" "arm"]
@@ -239,7 +430,38 @@ set ::deken::architecture_substitutes(armv7l) [list "armv7" "armv6l" "armv6" "ar
set ::deken::architecture_substitutes(PowerPC) [list "ppc"]
set ::deken::architecture_substitutes(ppc) [list "PowerPC"]
-proc ::deken::status {msg} {
+# try to set install path when plugin is loaded
+set ::deken::installpath [::deken::find_installpath]
+
+# allow overriding deken platform from Pd-core
+proc ::deken::set_platform {os machine bits floatwidth} {
+ if { $os != $::deken::platform(os) ||
+ $machine != $::deken::platform(machine) ||
+ $bits != $::deken::platform(bits)} {
+ set ::deken::platform(os) ${os}
+ set ::deken::platform(machine) ${machine}
+ set ::deken::platform(bits) ${bits}
+
+ ::pdwindow::verbose 1 [format [_ "\[deken\] Platform re-detected: %s" ] ${os}-${machine}-${bits}bit ]
+ ::pdwindow::verbose 1 "\n"
+ }
+}
+
+proc ::deken::versioncompare {a b} {
+ # compares to versions, the Debian way
+ # each version string is split into numeric and non-numeric elements
+ # the elements are compared pairwise
+ # "~" sorts before everything else
+ 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 " " }
+ set c [dict get {1 0 {0 1} -1 {1 0} 1} [lsort -indices -dictionary -unique [list $x $y]]]
+ if { $c != "0" } {return $c}
+ }
+ return 0
+}
+
+proc ::deken::status {{msg ""}} {
#variable mytoplevelref
#$mytoplevelref.results insert end "$msg\n"
#$mytoplevelref.status.label -text "$msg"
@@ -277,10 +499,15 @@ proc ::deken::highlightable_posttag {tag} {
# make sure that the 'highlight' tag is topmost
$mytoplevelref.results tag raise highlight
}
+proc ::deken::do_prompt_installdir {path} {
+ return [tk_chooseDirectory -title [_ "Install externals to directory:"] \
+ -initialdir ${path} -parent .externals_searchui]
+}
+
proc ::deken::prompt_installdir {} {
- set installdir [tk_chooseDirectory -title "Install libraries to directory:"]
+ set installdir [::deken::do_prompt_installdir $::fileopendir]
if { "$installdir" != "" } {
- set ::deken::installpath $installdir
+ ::deken::set_installpath $installdir
return 1
}
return 0
@@ -295,6 +522,10 @@ proc ::deken::update_searchbutton {mytoplevel} {
}
}
+proc ::deken::progress {x} {
+ ::pdwindow::debug "\[deken\]: = ${x}%"
+}
+
# this function gets called when the menu is clicked
proc ::deken::open_searchui {mytoplevel} {
if {[winfo exists $mytoplevel]} {
@@ -309,7 +540,7 @@ proc ::deken::open_searchui {mytoplevel} {
$mytoplevel.results tag configure archmatch
$mytoplevel.results tag configure noarchmatch -foreground grey
}
- ::deken::post "To get a list of all available externals, try an empty search." info
+ ::deken::post [_ "To get a list of all available externals, try an empty search."] info
}
# build the externals search dialog window
@@ -334,35 +565,293 @@ proc ::deken::create_dialog {mytoplevel} {
bind $mytoplevel.searchbit.entry <Key-Return> "::deken::initiate_search $mytoplevel"
bind $mytoplevel.searchbit.entry <KeyRelease> "::deken::update_searchbutton $mytoplevel"
focus $mytoplevel.searchbit.entry
- button $mytoplevel.searchbit.button -text [_ "Show all"] -default active -width 9 -command "::deken::initiate_search $mytoplevel"
- pack $mytoplevel.searchbit.button -side right -padx 6 -pady 3
+ button $mytoplevel.searchbit.button -text [_ "Show all"] -default active -command "::deken::initiate_search $mytoplevel"
+ pack $mytoplevel.searchbit.button -side right -padx 6 -pady 3 -ipadx 10
frame $mytoplevel.warning
pack $mytoplevel.warning -side top -fill x
- label $mytoplevel.warning.label -text "Only install externals uploaded by people you trust."
+ label $mytoplevel.warning.label -text [_ "Only install externals uploaded by people you trust."]
pack $mytoplevel.warning.label -side left -padx 6
frame $mytoplevel.status
pack $mytoplevel.status -side bottom -fill x
label $mytoplevel.status.label -textvariable ::deken::statustext
pack $mytoplevel.status.label -side left -padx 6
+ button $mytoplevel.status.preferences -text [_ "Preferences" ] -command "::deken::preferences::show"
+ pack $mytoplevel.status.preferences -side right -padx 6 -pady 3 -ipadx 10
text $mytoplevel.results -takefocus 0 -cursor hand2 -height 100 -yscrollcommand "$mytoplevel.results.ys set"
scrollbar $mytoplevel.results.ys -orient vertical -command "$mytoplevel.results yview"
pack $mytoplevel.results.ys -side right -fill y
- pack $mytoplevel.results -side left -padx 6 -pady 3 -fill both -expand true
+ pack $mytoplevel.results -side top -padx 6 -pady 3 -fill both -expand true
+
+ if { [ catch {
+ ttk::progressbar $mytoplevel.progress -orient horizontal -length 640 -maximum 100 -mode determinate -variable ::deken::progressvar } stdout ] } {
+ } {
+ pack $mytoplevel.progress -side bottom
+ proc ::deken::progress {x} {
+ set ::deken::progressvar $x
+ }
+ }
+}
+
+proc ::deken::preferences::create_pad {toplevel {padx 2} {pady 2} } {
+ set mypad [::deken::utilities::newwidget ${toplevel}.pad]
+
+ frame $mypad
+ pack $mypad -padx ${padx} -pady ${pady} -expand 1 -fill y
+
+ return mypad
+}
+
+proc ::deken::preferences::userpath_doit { } {
+ set installdir [::deken::do_prompt_installdir ${::deken::preferences::userinstallpath}]
+ if { "${installdir}" != "" } {
+ set ::deken::preferences::userinstallpath "${installdir}"
+ }
+}
+proc ::deken::preferences::path_doit {origin path {mkdir true}} {
+ ${origin}.doit configure -state normal
+ ${origin}.path configure -state disabled
+
+ if { [file exists ${path}] } { } {
+ ${origin}.doit configure -text "Create"
+ if { $mkdir } {
+ catch { file mkdir $path }
+ }
+ }
+
+ if { [file exists ${path}] } {
+ ${origin}.doit configure -text "Check"
+ }
+
+ if { [::deken::utilities::is_writable_dir ${path} ] } {
+ ${origin}.doit configure -state disabled
+ ${origin}.path configure -state normal
+ }
+}
+
+proc ::deken::preferences::create_pathentries {toplevel var paths} {
+ set i 0
+
+ foreach path $paths {
+ # only add absolute paths to the pathentries
+ if { [file pathtype $path] != "absolute" } { continue }
+
+ set w [::deken::utilities::newwidget ${toplevel}.frame]
+
+ frame $w
+ pack $w -anchor w -fill x
+
+ radiobutton ${w}.path -value ${path} -text "${path}" -variable $var
+ pack ${w}.path -side left
+ frame ${w}.fill
+ pack ${w}.fill -side left -padx 12 -fill x -expand 1
+ button ${w}.doit -text "..." -command "::deken::preferences::path_doit ${w} ${path}"
+ ::deken::preferences::path_doit ${w} ${path} false
+ pack ${w}.doit -side right -fill y -anchor e -padx 5 -pady 0
+ if { [::deken::utilities::is_writable_dir ${path} ] } {
+ ${w}.doit configure -state disabled
+ ${w}.path configure -state normal
+ } else {
+ ${w}.doit configure -state normal
+ ${w}.path configure -state disabled
+ }
+ }
+}
+
+proc ::deken::preferences::create {mytoplevel} {
+ set ::deken::preferences::installpath $::deken::installpath
+ set ::deken::preferences::hideforeignarch $::deken::hideforeignarch
+ if { $::deken::userplatform == "" } {
+ set ::deken::preferences::platform DEFAULT
+ set ::deken::preferences::userplatform [ ::deken::platform2string ]
+ } {
+ 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::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 $mytoplevel.installdir -text [_ "Install externals to directory:" ] -padx 5 -pady 5 -borderwidth 1
+ pack $mytoplevel.installdir -side top -fill x
+
+ ### dekenpath: directory-chooser
+ # FIXME: should we ask user to add chosen directory to PATH?
+ set f ${mytoplevel}.installdir.user
+ labelframe ${f} -borderwidth 1
+ pack ${f} -anchor w -fill x
+
+ radiobutton ${f}.path \
+ -value "USER" \
+ -textvariable ::deken::preferences::userinstallpath \
+ -variable ::deken::preferences::installpath
+ pack ${f}.path -side left
+ frame ${f}.fill
+ pack ${f}.fill -side left -padx 12 -fill x -expand 1
+ button ${f}.doit -text "..." -command "::deken::preferences::userpath_doit"
+ pack ${f}.doit -side right -fill y -anchor e -padx 5 -pady 0
+ ::deken::preferences::create_pad $mytoplevel.installdir
+
+ ### dekenpath: default directories
+ if {[namespace exists ::pd_docsdir] && [::pd_docsdir::externals_path_is_valid]} {
+ ::deken::preferences::create_pathentries $mytoplevel.installdir ::deken::preferences::installpath {[::pd_docsdir::get_externals_path]}
+ ::deken::preferences::create_pad $mytoplevel.installdir
+ }
+ ::deken::preferences::create_pathentries $mytoplevel.installdir ::deken::preferences::installpath $::sys_staticpath
+
+ ::deken::preferences::create_pad $mytoplevel.installdir
+ ::deken::preferences::create_pathentries $mytoplevel.installdir ::deken::preferences::installpath $::sys_searchpath
+
+ ## installation options
+ labelframe $mytoplevel.install -text [_ "Installation options:" ] -padx 5 -pady 5 -borderwidth 1
+ pack $mytoplevel.install -side top -fill x -anchor w
+
+ checkbutton $mytoplevel.install.remove -text [_ "Try to remove libraries before (re)installing them?"] \
+ -variable ::deken::preferences::remove_on_install
+ pack $mytoplevel.install.remove -anchor w
+
+ checkbutton $mytoplevel.install.readme -text [_ "Show README of newly installed libraries (if present)?"] \
+ -variable ::deken::preferences::show_readme
+ pack $mytoplevel.install.readme -anchor w
+
+ checkbutton $mytoplevel.install.add_to_path -text [_ "Should newly installed libraries be added to Pd's search path?"] \
+ -variable ::deken::preferences::add_to_path
+ catch { $mytoplevel.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]]}
+ } stdout
+
+ pack $mytoplevel.install.add_to_path -anchor w
+
+
+ ## platform filter settings
+ labelframe $mytoplevel.platform -text [_ "Platform settings:" ] -padx 5 -pady 5 -borderwidth 1
+ pack $mytoplevel.platform -side top -fill x -anchor w
+
+ # default architecture vs user-defined arch
+ radiobutton $mytoplevel.platform.default -value "DEFAULT" \
+ -text [format [_ "Default platform: %s" ] [::deken::platform2string ] ] \
+ -variable ::deken::preferences::platform \
+ -command "$mytoplevel.platform.userarch.entry configure -state disabled"
+ pack $mytoplevel.platform.default -anchor w
+
+ frame $mytoplevel.platform.userarch
+ radiobutton $mytoplevel.platform.userarch.radio -value "USER" \
+ -text [_ "User-defined platform:" ] \
+ -variable ::deken::preferences::platform \
+ -command "$mytoplevel.platform.userarch.entry configure -state normal"
+ entry $mytoplevel.platform.userarch.entry -textvariable ::deken::preferences::userplatform
+ if { "$::deken::preferences::platform" == "DEFAULT" } {
+ $mytoplevel.platform.userarch.entry configure -state disabled
+ }
+
+ pack $mytoplevel.platform.userarch -anchor w
+ pack $mytoplevel.platform.userarch.radio -side left
+ pack $mytoplevel.platform.userarch.entry -side right -fill x
+
+ # hide non-matching architecture?
+ ::deken::preferences::create_pad $mytoplevel.platform 2 10
+
+ checkbutton $mytoplevel.platform.hide_foreign -text [_ "Hide foreign architectures?"] \
+ -variable ::deken::preferences::hideforeignarch
+ pack $mytoplevel.platform.hide_foreign -anchor w
+
+
+ # Use two frames for the buttons, since we want them both bottom and right
+ frame $mytoplevel.nb
+ pack $mytoplevel.nb -side bottom -fill x -pady 2m
+
+ # buttons
+ frame $mytoplevel.nb.buttonframe
+ pack $mytoplevel.nb.buttonframe -side right -fill x -padx 2m
+
+ button $mytoplevel.nb.buttonframe.cancel -text [_ "Cancel"] \
+ -command "::deken::preferences::cancel $mytoplevel"
+ pack $mytoplevel.nb.buttonframe.cancel -side left -expand 1 -fill x -padx 15 -ipadx 10
+ if {$::windowingsystem ne "aqua"} {
+ button $mytoplevel.nb.buttonframe.apply -text [_ "Apply"] \
+ -command "::deken::preferences::apply $mytoplevel"
+ pack $mytoplevel.nb.buttonframe.apply -side left -expand 1 -fill x -padx 15 -ipadx 10
+ }
+ button $mytoplevel.nb.buttonframe.ok -text [_ "OK"] \
+ -command "::deken::preferences::ok $mytoplevel"
+ pack $mytoplevel.nb.buttonframe.ok -side left -expand 1 -fill x -padx 15 -ipadx 10
+}
+
+proc ::deken::preferences::show {{mytoplevel .deken_preferences}} {
+ if {[winfo exists $mytoplevel]} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ } else {
+ toplevel $mytoplevel -class DialogWindow
+ wm title $mytoplevel [format [_ "Deken %s Preferences"] $::deken::version]
+
+ frame $mytoplevel.frame
+ pack $mytoplevel.frame -side top -padx 6 -pady 3 -fill both -expand true
+
+ ::deken::preferences::create $mytoplevel.frame
+ }
}
+proc ::deken::preferences::apply {mytoplevel} {
+ 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::set_install_options \
+ "${::deken::preferences::remove_on_install}" \
+ "${::deken::preferences::show_readme}" \
+ "${::deken::preferences::add_to_path}"
+}
+proc ::deken::preferences::cancel {mytoplevel} {
+ ## FIXXME properly close the window/frame (for re-use in a tabbed pane)
+ if {[winfo exists .deken_preferences]} {destroy .deken_preferences}
+ #destroy $mytoplevel
+}
+proc ::deken::preferences::ok {mytoplevel} {
+ ::deken::preferences::apply $mytoplevel
+ ::deken::preferences::cancel $mytoplevel
+}
+
+
+
proc ::deken::initiate_search {mytoplevel} {
+ set searchterm [$mytoplevel.searchbit.entry get]
# let the user know what we're doing
::deken::clearpost
- ::deken::post "Searching for externals..."
- # make the ajax call
+ ::pdwindow::debug [_ "\[deken\]: Start searching for externals..."]
+ ::pdwindow::debug "${searchterm}\n"
+ set ::deken::progressvar 0
if { [ catch {
- set results [::deken::search_for [$mytoplevel.searchbit.entry get]]
+ set results [::deken::search_for ${searchterm}]
} stdout ] } {
- ::pdwindow::debug "\[deken\]: online? $stdout\n"
- ::deken::status "Unable to perform search. Are you online?"
+ ::pdwindow::debug [format [_ "\[deken\]: online? %s" ] $stdout ]
+ ::pdwindow::debug "\n"
+ ::deken::status [format "%s %s" [_ "Unable to perform search." ] [_ "Are you online?" ] ]
} else {
# delete all text in the results
::deken::clearpost
@@ -373,30 +862,38 @@ proc ::deken::initiate_search {mytoplevel} {
::deken::show_result $mytoplevel $counter $r 1
incr counter
}
- foreach r $results {
- ::deken::show_result $mytoplevel $counter $r 0
- incr counter
+ if { "$::deken::hideforeignarch" } {
+ # skip display of non-matching archs
+ } {
+ foreach r $results {
+ ::deken::show_result $mytoplevel $counter $r 0
+ incr counter
+ }
}
::deken::scrollup
} else {
- ::deken::post "No matching externals found. Try using the full name e.g. 'freeverb'."
+ ::pdwindow::post [_ "\[deken\]: No matching externals found." ]
+ ::pdwindow::debug " "
+ ::pdwindow::debug [_ "Try using the full name e.g. 'freeverb'." ]
+ ::pdwindow::post "\n"
+ ::deken::status [_ "No matching externals found." ]
}
}}
# display a single found entry
proc ::deken::show_result {mytoplevel counter result showmatches} {
- foreach {title cmd match comment status} $result {break}
+ foreach {title cmd match comment status} $result {break}
- set tag ch$counter
+ set tag ch$counter
#if { [ ($match) ] } { set matchtag archmatch } { set matchtag noarchmatch }
- set matchtag [expr $match?"archmatch":"noarchmatch" ]
- if {($match == $showmatches)} {
- set comment [string map {"\n" "\n\t"} $comment]
- ::deken::post "$title\n\t$comment\n" [list $tag $matchtag]
- ::deken::highlightable_posttag $tag
- ::deken::bind_posttag $tag <Enter> "+::deken::status $status"
- ::deken::bind_posttag $tag <1> "$cmd"
- }
+ set matchtag [expr $match?"archmatch":"noarchmatch" ]
+ if {($match == $showmatches)} {
+ set comment [string map {"\n" "\n\t"} $comment]
+ ::deken::post "$title\n\t$comment\n" [list $tag $matchtag]
+ ::deken::highlightable_posttag $tag
+ ::deken::bind_posttag $tag <Enter> "+::deken::status {$status}"
+ ::deken::bind_posttag $tag <1> "$cmd"
+ }
}
# handle a clicked link
@@ -405,97 +902,190 @@ proc ::deken::clicked_link {URL filename} {
### 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
- set installdir ""
- if { [ info exists ::deken::installpath ] } {
- ## any previous choice?
- set installdir [ ::deken::get_writable_dir [list $::deken::installpath ] ]
- }
+ set installdir [::deken::find_installpath]
+ set parsedname [::deken::parse_filename $filename]
+ set extname [lindex $parsedname 0]
+
if { "$installdir" == "" } {
- ## search the default paths
- set installdir [ ::deken::get_writable_dir $::sys_staticpath ]
+ 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" == "" } {
- ## ask the user (and remember the decision)
+ # ask the user (and remember the decision)
::deken::prompt_installdir
set installdir [ ::deken::get_writable_dir [list $::deken::installpath ] ]
}
- if { "$installdir" == "" } {
- #::deken::clearpost
- ::deken::post "No writeable directory found in:" warn
- foreach p $::sys_staticpath { ::deken::post "\t- $p" warn }
- ::deken::post "Cannot download/install libraries!" warn
- return
+ while {1} {
+ if { "$installdir" == "" } {
+ set msg [_ "Please select a (writable) installation directory!"]
+ set _args "-message $msg -type retrycancel -default retry -icon warning -parent .externals_searchui"
+ switch -- [eval tk_messageBox ${_args}] {
+ cancel {return}
+ retry {
+ if {[::deken::prompt_installdir]} {
+ set installdir $::deken::installpath
+ } else {
+ continue
+ }
+ }
+ }
+ } else {
+ set msg [_ "Install %s to %s?" ]
+ set _args "-message \"[format $msg $extname $installdir]\" -type yesnocancel -default yes -icon question -parent .externals_searchui"
+ switch -- [eval tk_messageBox ${_args}] {
+ 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
+ if { [ catch { file mkdir $installdir } ] } {}
+ }
+ # check whether this is a writable directory
+ set installdir [ ::deken::get_writable_dir [list $installdir ] ]
+ if { "$installdir" != "" } {
+ # stop looping if we've found our dir
+ break
+ }
}
- switch -- [tk_messageBox -message \
- "Install to directory $installdir?" \
- -type yesnocancel -default "yes" \
- -icon question] {
- no {set installdir ""
- if {[::deken::prompt_installdir]} {
- set installdir [ ::deken::get_writable_dir [list $::deken::installpath ] ] }
- if { "$installdir" eq "" } return}
- cancel return}
-
- set fullpkgfile "$installdir/$filename"
+
+ set extpath [file join $installdir $extname]
+ set fullpkgfile [file join $installdir $filename]
::deken::clearpost
- ::deken::post "Commencing downloading of:\n$URL\nInto $installdir..."
- ::deken::download_file $URL $fullpkgfile
- set PWD [ pwd ]
- cd $installdir
- set success 1
- if { [ string match *.zip $fullpkgfile ] } then {
- if { [ ::deken::vbs_unzipper $fullpkgfile $installdir ] } { } {
- if { [ catch { exec unzip -uo $fullpkgfile } stdout ] } {
- ::pdwindow::debug "$stdout\n"
- set success 0
+ ::pdwindow::debug [format [_ "Commencing downloading of:\n%1\$s\nInto %2\$s..." ] $URL $installdir]
+ set fullpkgfile [::deken::download_file $URL $fullpkgfile]
+ if { "$fullpkgfile" eq "" } {
+ ::pdwindow::debug [_ "aborting.\n"]
+ return
+ }
+ ::pdwindow::debug "\n"
+ if { "$::deken::remove_on_install" } {
+ ::deken::utilities::uninstall $installdir $extname
+ }
+
+ ::deken::utilities::extract $installdir $filename $fullpkgfile
+
+ if { "$::deken::show_readme" } {
+ foreach ext {pd html 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]"
+ } {
+ pd_menucommands::menu_openfile $r
+ }
+ break
}
}
- } elseif { [ string match *.tar.gz $fullpkgfile ]
- || [ string match *.tgz $fullpkgfile ]
- } then {
- if { [ catch { exec tar xzf $fullpkgfile } stdout ] } {
- ::pdwindow::debug "$stdout\n"
- set success 0
- }
}
- cd $PWD
- if { $success > 0 } {
- ::deken::post "Successfully unzipped $filename into $installdir.\n"
- catch { exec rm $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
- ::deken::post "Unable to extract package automatically." warn
- ::deken::post "Please perform the following steps manually:"
- ::deken::post "1. Unzip $fullpkgfile."
- pd_menucommands::menu_openfile $fullpkgfile
- ::deken::post "2. Copy the contents into $installdir.\n"
- pd_menucommands::menu_openfile $installdir
+
+ 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]} {
+ ::pdwindow::debug "\[deken\]: "
+ ::pdwindow::debug [_ "Unable to add %s to search paths"] $extname
+ ::pdwindow::debug "\n"
+ return
+ }
+ set doit yes
+ if { $::deken::add_to_path > 1 } {
+ set doit yes
+ } {
+ set msg [_ "Add %s to the Pd search paths?" ]
+ set _args "-message \"[format $msg $extname]\" -type yesno -default yes -icon question -parent .externals_searchui"
+ set doit [eval tk_messageBox ${_args}]
+ }
+ switch -- "${doit}" {
+ yes {
+ add_to_searchpaths [file join $installdir $extname]
+ ::pdwindow::debug "\[deken\]: "
+ ::pdwindow::debug [format [_ "Added %s to search paths"] $extname]
+ ::pdwindow::debug "\n"
+ # if this version of pd supports it, try refreshing the helpbrowser
+ if {[uplevel 1 info procs ::helpbrowser::refresh] ne ""} {
+ ::helpbrowser::refresh
+ }
+ }
+ no {
+ return
+ }
+ }
}
}
# download a file to a location
# http://wiki.tcl.tk/15303
proc ::deken::download_file {URL outputfilename} {
- set f [open $outputfilename w]
- set status ""
- set errorstatus ""
+ set downloadfilename [::deken::get_tmpfilename [file dirname $outputfilename] ]
+ set f [open $downloadfilename w]
fconfigure $f -translation binary
- set httpresult [http::geturl $URL -binary true -progress "::deken::download_progress" -channel $f]
- set status [::http::status $httpresult]
- set errorstatus [::http::error $httpresult]
+
+ set httpresult [::http::geturl $URL -binary true -progress "::deken::download_progress" -channel $f]
+ set ncode [::http::ncode $httpresult]
+ if {[expr $ncode != 200 ]} {
+ ## FIXXME: we probably should handle redirects correctly (following them...)
+ # tcl-format
+ set err [::http::code $token]
+ ::pdwindow::error [format [_ "Unable to download from %1\$s \[%2\$s\]" ] $URL $err ] error
+ set outputfilename ""
+ }
flush $f
close $f
- http::cleanup $httpresult
- return [list $status $errorstatus ]
+ ::http::cleanup $httpresult
+
+ if { "$outputfilename" != "" } {
+ catch { file delete $outputfilename }
+ if {[file exists $outputfilename]} {
+ ::pdwindow::debug "\[deken\]: "
+ ::pdwindow::debug [format [_ "Unable to remove stray file %s" ] $outputfilename ]
+ ::pdwindow::debug "\n"
+ set outputfilename ""
+ }
+ }
+ if { $outputfilename != "" && "$outputfilename" != "$downloadfilename" } {
+ if {[catch { file rename $downloadfilename $outputfilename}]} {
+ ::pdwindow::debug "\[deken\]: "
+ ::pdwindow::debug [format [_ "Unable to rename downloaded file to %s" ] $outputfilename ] error
+ ::pdwindow::debug "\n"
+ set outputfilename ""
+ }
+ }
+ if { "$outputfilename" eq "" } {
+ file delete $downloadfilename
+ }
+
+ return $outputfilename
}
# print the download progress to the results window
proc ::deken::download_progress {token total current} {
if { $total > 0 } {
- variable mytoplevelref
- set computed [expr {round(100 * (1.0 * $current / $total))}]
- ::deken::post "= $computed%"
+ ::deken::progress [expr {round(100 * (1.0 * $current / $total))}]
}
}
@@ -510,15 +1100,21 @@ proc ::deken::parse_filename {filename} {
# basename <pkgname>[-v<version>-]?{(<arch>)}
## strip off the archs
set baselist [split $basename () ]
-
# get pkgname + version
set pkgver [lindex $baselist 0]
- if { ! [ regexp "(.*)-(.*)-" $pkgver _ pkgname version ] } {
+ if { ! [ regexp "(.*)-(v.*)-" $pkgver _ pkgname version ] } {
set pkgname $pkgver
set $version ""
}
# get archs
foreach {a _} [lreplace $baselist 0 0] { lappend archs $a }
+ if { "x$archs$version" == "x" } {
+ # try again as <pkgname>-v<version>
+ if { ! [ regexp "(.*)-(v.*)" $pkgver _ pkgname version ] } {
+ set pkgname $pkgver
+ set $version ""
+ }
+ }
}
return [list $pkgname $version $archs]
}
@@ -527,19 +1123,24 @@ proc ::deken::parse_filename {filename} {
proc ::deken::architecture_match {archs} {
# 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)"
+ if { "$::deken::userplatform" != "" } {
+ ## FIXXME what if the user-supplied input isn't valid?
+ regexp -- {(.*)-(.*)-(.*)} $::deken::userplatform _ OS MACHINE BITS
+ }
# check each architecture in our list against the current one
foreach arch $archs {
if { [ regexp -- {(.*)-(.*)-(.*)} $arch _ os machine bits ] } {
- if { "${os}" eq "$::deken::platform(os)" &&
- "${bits}" eq "$::deken::platform(bits)"
- } {
- ## so OS and word size match
+ if { "${os}" eq "$::deken::platform(os)" } {
+ ## so OS matches...
## check whether the CPU matches as well
- if { "${machine}" eq "$::deken::platform(machine)" } {return 1}
+ 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 $::deken::platform(machine)]]} {
- foreach cpu $::deken::architecture_substitutes($::deken::platform(machine)) {
+ if {[llength [array names ::deken::architecture_substitutes -exact "${MACHINE}"]]} {
+ foreach cpu $::deken::architecture_substitutes(${MACHINE}) {
if { "${machine}" eq "${cpu}" } {return 1}
}
}
@@ -550,7 +1151,7 @@ proc ::deken::architecture_match {archs} {
}
proc ::deken::search_for {term} {
- ::deken::status "searching for '$term'"
+ ::deken::status [format [_ "searching for '%s'" ] $term ]
set result [list]
foreach searcher $::deken::backends {
@@ -564,6 +1165,7 @@ set mymenu .menubar.help
if { [catch {
$mymenu entryconfigure [_ "Find externals"] -command {::deken::open_searchui .externals_searchui}
} _ ] } {
+ $mymenu add separator
$mymenu add command -label [_ "Find externals"] -command {::deken::open_searchui .externals_searchui}
}
# bind all <$::modifier-Key-s> {::deken::open_helpbrowser .helpbrowser2}
@@ -620,10 +1222,33 @@ proc urldecode {str} {
## searching puredata.info
proc ::deken::search::puredata.info {term} {
set searchresults [list]
+ set dekenserver "${::deken::protocol}://deken.puredata.info/search"
+ catch {set dekenserver $::env(DEKENSERVER)} stdout
+ set queryterm {}
+ foreach x $term {lappend queryterm name $x}
+ if { [ catch {set queryterm [::http::formatQuery {*}$queryterm ] } stderr ] } {
+ set queryterm [ join $term "&name=" ]
+ set queryterm "name=${queryterm}"
+ }
- set term [ join $term "&name=" ]
- set token [http::geturl "http://deken.puredata.info/search?name=$term"]
- set contents [http::data $token]
+ # deken-specific socket config
+ set httpaccept [::http::config -accept]
+ ::http::config -accept text/tab-separated-values
+
+ # fetch search result
+ set token [::http::geturl "${dekenserver}?${queryterm}"]
+
+ # restore http settings
+ ::http::config -accept $httpaccept
+
+ set ncode [::http::ncode $token]
+ if {[expr $ncode != 200 ]} {
+ set err [::http::code $token]
+ ::pdwindow::debug [format "\[deken\]: %s %s" [_ "Unable to perform search." ] ${err} ]
+ ::pdwindow::debug "\n"
+ return {}
+ }
+ set contents [::http::data $token]
set splitCont [split $contents "\n"]
# loop through the resulting tab-delimited table
foreach ele $splitCont {
@@ -643,15 +1268,15 @@ proc ::deken::search::puredata.info {term} {
set match [::deken::architecture_match "$archs" ]
- set comment "Uploaded by $creator @ $date"
+ set comment [format [_ "Uploaded by %1\$s @ %2\$s" ] $creator $date ]
set status $URL
set sortname [lindex $pkgverarch 0]--[lindex $pkgverarch 1]--$date
set res [list $name $cmd $match $comment $status $filename]
lappend searchresults $res
}
}
- http::cleanup $token
- return [lsort -dictionary -decreasing -index 5 $searchresults ]
+ ::http::cleanup $token
+ return [lsort -command ::deken::versioncompare -decreasing -index 5 $searchresults ]
}
::deken::register ::deken::search::puredata.info
diff --git a/developer/README.md b/developer/README.md
index 8a33247..0b07ca0 100644
--- a/developer/README.md
+++ b/developer/README.md
@@ -43,13 +43,13 @@ with the zip file.
### Creating/Uploading packages on a different machine
`deken` inspects the files in the directory to determine the target platform
-(rather than just checking on which system you are currently runing).
+(rather than just checking on which system you are currently running).
Therefore, if it is not feasible to install `deken` on the machine used for
building your Pd library, you can run `deken` on another machine,
Example: You build the "my_external" library on OSX-10.5, but (due to OSX-10.5
not being supported by Apple anymore) you haven't installed `deken` there.
-So you simply transfer the "my_external" directory to your linux machine, where
+So you simply transfer the "my_external" directory to your Linux machine, where
you run `deken package my_external` and it will magically create the
`my_external-v3.14-(Darwin-i386-32)(Darwin-x86_64-32)-externals.tgz` file for
you, ready to be uploaded.
@@ -69,9 +69,9 @@ be optimally searchable on [puredata.info](http://puredata.info/);
this archive).
It is either "Sources" (see [below](#sourceful-uploads) or `OS-MARCH-BIT`,
with:
- - OS being the Operating System (`Linux`, `Darwin`, W32`,...)
+ - OS being the Operating System (`Linux`, `Darwin`, `W32`,...)
- MARCH is the machine architecture (e.g. `x86_64`)
- - BIT is some number of bits (e.g. `64`)
+ - BIT is some number of bits (e.g. `32`)
* EXT is the archive extension (either `zip` or `tar.gz`)
Note that the archive should contain a single directory at the top level with
@@ -85,10 +85,10 @@ optional, don't include them. The same goes for the curly braces around the
However, the round parentheses "()" around architectures must be included to
separate the architectures visibly from each other.
-In plain english this means:
+In plain English this means:
> the library-name, followed by an optional version string (starting with `-v`
> and ending with `-`), followed by zero or more architecture specifications
-> (each surrounded by `(`parantheses`)`), and terminated by `-externals`
+> (each surrounded by `(`parentheses`)`), and terminated by `-externals`
> (followed by a filename extension).
diff --git a/developer/builder.md b/developer/builder.md
deleted file mode 100644
index 38c2694..0000000
--- a/developer/builder.md
+++ /dev/null
@@ -1,35 +0,0 @@
-Deken can also be used to build some externals directly from a repository.
-
-## Build an external from a repository ##
-
- $ deken build svn://svn.code.sf.net/p/pure-data/svn/trunk/externals/freeverb~/
- Deken 0.1
- Checking out svn://svn.code.sf.net/p/pure-data/svn/trunk/externals/freeverb~/ into ./workspace/externals/freeverb~
- Building ./workspace/externals/freeverb~
-
-## Build and install an external from a repository ##
-
- $ deken install svn://svn.code.sf.net/p/pure-data/svn/trunk/externals/freeverb~/
- Deken 0.1
- Updating ./workspace/externals/freeverb~
- Building ./workspace/externals/freeverb~
- Installing ./workspace/externals/freeverb~ into ./pd-externals/freeverb~
-
-## Manage Pd version ##
-
-Show Pd version:
-
- $ deken pd
- Deken 0.1
- Pd version 0.43 checked out
-
-Change Pd version:
-
- $ deken pd master
- Deken 0.1
- Pd version master checked out
-
-### How to make your externals compatible ###
-
-<http://puredata.info/docs/developer/MakefileTemplate>
-
diff --git a/developer/deken b/developer/deken
index 02aa554..edc234f 100755
--- a/developer/deken
+++ b/developer/deken
@@ -6,12 +6,23 @@
# Much of this code is pilfered from Clojure's Leiningen tool
-export DEKEN_VERSION="0.1"
+export DEKEN_VERSION="0.2.6"
+export DEKEN_HOME="${DEKEN_HOME:-"$HOME/.deken"}"
+DEKEN_GIT_BRANCH="${DEKEN_GIT_BRANCH:-master}"
+DEKEN_BASE_URL="https://raw.githubusercontent.com/pure-data/deken/${DEKEN_GIT_BRANCH}/developer"
+
+VIRTUALENV_VERSION="15.1.0"
+VIRTUALENV_URL="https://pypi.io/packages/source/v/virtualenv/virtualenv-${VIRTUALENV_VERSION}.tar.gz"
+
+
+error() {
+ echo "$@" 1>&2
+}
if [ $(id -u) -eq 0 ] && [ "$DEKEN_ROOT" = "" ]; then
- echo "WARNING: You're currently running as root; probably by accident."
- echo "Press control-C to abort or Enter to continue as root."
- echo "Set DEKEN_ROOT to disable this warning."
+ error "WARNING: You're currently running as root; probably by accident."
+ error "Press control-C to abort or Enter to continue as root."
+ error "Set DEKEN_ROOT to disable this warning."
read _
fi
@@ -27,6 +38,11 @@ else
cygwin=false
fi
+# allow the user to override the default python
+if [ "x${PYTHON_BIN}" = x ]; then
+ PYTHON_BIN=python
+fi
+
# This needs to be defined before we call HTTP_CLIENT below
if [ "$HTTP_CLIENT" = "" ]; then
if which curl >/dev/null; then
@@ -39,17 +55,11 @@ if [ "$HTTP_CLIENT" = "" ]; then
fi
fi
-export DEKEN_HOME="${DEKEN_HOME:-"$HOME/.deken"}"
-DEKEN_BASE_URL="https://raw.githubusercontent.com/pure-data/deken/master/developer"
if $cygwin; then
export DEKEN_HOME=$(cygpath -w "$DEKEN_HOME")
fi
-error() {
- echo "$@" 1>&2
-}
-
bail_install() {
error "Self-installation of Deken failed."
error "Please paste any errors in the bug tracker at https://github.com/pure-data/deken/issues"
@@ -63,26 +73,40 @@ bail_install_msg() {
bail_install
}
+bail_requirements() {
+ rm -f "${DEKEN_HOME}/requirements.txt"
+ error "Installation of requirements failed."
+ error "You probably should install the following packages first:"
+ error " - 'python-dev'"
+ error " - 'libffi-dev'"
+ error " - 'libssl-dev'"
+ error "You can run 'deken install' or 'deken upgrade' anytime to"
+ error " re-install (or upgrade) your Deken installation"
+
+ exit 1
+}
+
install_virtualenv() {
echo "Downloading & installing Virtualenv."
rm -rf $DEKEN_HOME/virtualenv-source
mkdir -p $DEKEN_HOME/virtualenv-source && \
- $HTTP_CLIENT $DEKEN_HOME/virtualenv.tar.gz https://pypi.python.org/packages/source/v/virtualenv/virtualenv-12.1.1.tar.gz && \
+ $HTTP_CLIENT $DEKEN_HOME/virtualenv.tar.gz "${VIRTUALENV_URL}" && \
tar -zxvf $DEKEN_HOME/virtualenv.tar.gz -C $DEKEN_HOME/virtualenv-source/ && \
mv $DEKEN_HOME/virtualenv-source/virtualenv-*/* $DEKEN_HOME/virtualenv-source
[ -d "$DEKEN_HOME/virtualenv-source" ] && (\
cd $DEKEN_HOME/virtualenv-source && \
- /usr/bin/env python setup.py build ) \
+ /usr/bin/env "${PYTHON_BIN}" setup.py build ) \
|| bail_install;
}
install_deken() {
- which python >/dev/null || \
- bail_install_msg "Oops, no Python found! You need Python to run Deken."
+ which "${PYTHON_BIN}" >/dev/null || \
+ bail_install_msg "Oops, no Python found! You need Python to run Deken: ${PYTHON_BIN}
+You can specify an alternative Python interpreter via the PYTHON_BIN envvar"
which make >/dev/null || \
bail_install_msg "Oops, no Make found! You need Make to run Deken."
error "This is your first time running deken on this machine."
- error "I'm going to install myself and my dependencies into ~/.deken now."
+ error "I'm going to install myself and my dependencies into ${DEKEN_HOME} now."
error "Feel free to ctrl-C now if you don't want to do this."
sleep 3;
[ -d "$DEKEN_HOME" ] || mkdir -p $DEKEN_HOME;
@@ -100,7 +124,7 @@ install_deken() {
$DEKEN_HOME/virtualenv-source/virtualenv.py "$DEKEN_HOME/virtualenv" || exit 1)
[ -x "$DEKEN_HOME/virtualenv/bin/hy" ] || (\
echo "Installing deken library dependencies." && \
- $DEKEN_HOME/virtualenv/bin/pip install -r $DEKEN_HOME/requirements.txt || exit 1)
+ $DEKEN_HOME/virtualenv/bin/pip install -r $DEKEN_HOME/requirements.txt || bail_requirements)
}
upgrade_deken() {
@@ -115,10 +139,25 @@ upgrade_deken() {
mv $DEKEN_HOME/.upgrade-$f $DEKEN_HOME/$f;
done
# finally update the python dependencies
- $DEKEN_HOME/virtualenv/bin/pip install -r $DEKEN_HOME/requirements.txt
+ $DEKEN_HOME/virtualenv/bin/pip install -r $DEKEN_HOME/requirements.txt || bail_requirements
echo "Successfully upgraded."
}
+tryrun_deken() {
+ if [ ! -x "$DEKEN_HOME/virtualenv/bin/hy" ]; then
+ error "Unable to find '${DEKEN_HOME}/virtualenv/bin/hy'"
+ error "Try running '$0 install' or '$0 upgrade'"
+ exit 1
+ fi
+ if [ -e $DEKEN_HOME/deken.hy ]; then
+ $DEKEN_HOME/virtualenv/bin/hy $DEKEN_HOME/deken.hy "$@"
+ else
+ error "Unable to find '${DEKEN_HOME}/deken.hy'"
+ error "Try running '$0 install' or '$0 upgrade'"
+ exit 1
+ fi
+}
+
# make sure we are deployed
[ -d "$DEKEN_HOME" ] || install_deken
@@ -126,8 +165,16 @@ upgrade_deken() {
[ -d "$DEKEN_HOME" ] || bail_install;
# catch the special "upgrade" command
-[ "$1" = "upgrade" ] && \
- # run he upgrade command instead
- upgrade_deken || \
+case "$1" in
+ upgrade|update)
+ # run the upgrade command instead
+ upgrade_deken
+ ;;
+ install)
+ install_deken
+ ;;
+ *)
# run the real deken command with args passed through
- $DEKEN_HOME/virtualenv/bin/hy $DEKEN_HOME/deken.hy $@
+ tryrun_deken "$@"
+ ;;
+esac
diff --git a/developer/deken.hy b/developer/deken.hy
index b611a8d..be4d8b0 100644
--- a/developer/deken.hy
+++ b/developer/deken.hy
@@ -1,5 +1,39 @@
#!/usr/bin/env hy
-; deken upload --version 0.1 ./freeverb~/
+;; deken upload --version 0.1 ./freeverb~/
+
+;; This software is copyrighted by Chris McCormick, IOhannes m zmölnig and
+;; others.
+;; The following terms (the "Standard Improved BSD License") apply to all
+;; files associated with the software unless explicitly disclaimed in
+;; individual files:
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following
+;; disclaimer in the documentation and/or other materials provided
+;; with the distribution.
+;; 3. The name of the author may not be used to endorse or promote
+;; products derived from this software without specific prior
+;; written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY
+;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR
+;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+;; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+;; THE POSSIBILITY OF SUCH DAMAGE.
+
(import sys)
(import os)
@@ -14,25 +48,23 @@
(import struct)
(import copy)
(try (import [ConfigParser [SafeConfigParser]])
- (catch [e ImportError] (import [configparser [SafeConfigParser]])))
+ (except [e ImportError] (import [configparser [SafeConfigParser]])))
(try (import [StringIO [StringIO]])
- (catch [e ImportError] (import [io [StringIO]])))
+ (except [e ImportError] (import [io [StringIO]])))
(import hashlib)
(import [getpass [getpass]])
(try (import [urlparse [urlparse]])
- (catch [e ImportError] (import [urllib.parse [urlparse]])))
-(import requests)
-(import easywebdav)
+ (except [e ImportError] (import [urllib.parse [urlparse]])))
(require hy.contrib.loop)
(def deken-home (os.path.expanduser (os.path.join "~" ".deken")))
(def config-file-path (os.path.abspath (os.path.join deken-home "config")))
-(def version (try (.rstrip (.read (open (os.path.join deken-home "VERSION"))) "\r\n") (catch [e Exception] (.get os.environ "DEKEN_VERSION" "0.1"))))
+(def version (.get os.environ "DEKEN_VERSION" "<unknown.version>"))
(def externals-host "puredata.info")
(def elf-arch-types {
- "EM_NONE" nil
+ "EM_NONE" None
"EM_386" "i386"
"EM_68K" "m68k"
"EM_IA_64" "x86_64"
@@ -50,135 +82,166 @@
"EM_BLAFKIN" "Analog Devices Blackfin"
"RESERVED" "RESERVED"})
-(def arm-cpu-arch ["Pre-v4" "v4" "v4T" "v5T" "v5TE" "v5TEJ" "v6" "v6KZ" "v6T2" "v6K" "v7"])
+;; values updated via https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;a=blob;f=include/elf/arm.h;hb=HEAD#l93
+(def arm-cpu-arch
+ [
+ "Pre-v4"
+ "v4"
+ "v4T"
+ "v5T"
+ "v5TE"
+ "v5TEJ"
+ "v6"
+ "v6KZ"
+ "v6T2"
+ "v6K"
+ "v7"
+ "v6_M"
+ "v6S_M"
+ "v7E_M"
+ "v8"
+ "v8R"
+ "v8M_BASE"
+ "v8M_MAIN"
+ ])
(def win-types {
"0x014c" ["i386" 32]
"0x0200" ["x86_64" 64]
"0x8664" ["amd64" 64]})
-; algorithm to use to hash files
+;; algorithm to use to hash files
(def hasher hashlib.sha256)
(def hash-extension (.pop (hasher.__name__.split "_")))
-; get the externals' homedir install location for this platform - from s_path.c
-(def externals-folder
- (let [[system-name (platform.system)]]
- (cond
- [(in system-name ["Linux" "FreeBSD"]) (os.path.expandvars (os.path.join "$HOME" "pd-externals"))]
- [(= system-name "Darwin") (os.path.expandvars (os.path.join "$HOME" "Library" "Pd"))]
- [(= system-name "Windows") (os.path.expandvars (os.path.join "%AppData%" "Pd"))])))
+;; nil? has been removed from hy-0.12
+(try (nil? None) (except [e NameError] (defn nil? [x] (= x None))))
+
+;; in hy-0.12 'slice' has been replaced with 'cut'
+;; but we cannot replace 'cut' in hy>=0.12, because it is a built-in...
+(defn cut-slice [x y z] (cut x y z))
+(try (cut []) (except [e NameError] (defn cut-slice [x y z] (slice x y z))))
-; convert a string into bool, based on the string value
+;; convert a string into bytes
+(defn str-to-bytes [s] (try (bytes s) (except [e TypeError] (bytes s "utf-8"))))
+
+;; convert a string into bool, based on the string value
(defn str-to-bool [s] (and (not (nil? s)) (not (in (.lower s) ["false" "f" "no" "n" "0" "nil" "none"]))))
;; join non-empty elements
(defn join-nonempty [joiner elements] (.join joiner (list-comp (str x) [x elements] x)))
-; concatenate two dictionaries - hylang's assoc is broken
+;; concatenate two dictionaries - hylang's assoc is broken
(defn dict-merge [d1 d2] (apply dict [d1] (or d2 {})))
-; apply attributes to objects in a functional way
-(defn set-attr [obj attr value] (do (setattr obj attr value) obj))
+;; apply attributes to objects in a functional way
+(defn set-attr [obj attr value] (setattr obj attr value) obj)
+;; get multiple attributes as list
+(defn get-attrs [obj attributes &optional default] (list-comp (getattr obj _default) [_ attributes]))
-; replace multiple words (given as pairs in <repls>) in a string <s>
+;; replace multiple words (given as pairs in <repls>) in a string <s>
(defn replace-words [s repls] (reduce (fn [a kv] (apply a.replace kv)) repls s))
-;; get a value at an index or a default
-(defn try-get [elements index &optional default] (try (get elements index) (catch [e IndexError] default)))
+;; get multiple values from a dict (give keys as list, get values as list)
+(defn get-values [coll keys] (list-comp (get coll _) [_ keys]))
+
+;; get a value at an index/key or a default
+(defn try-get [elements index &optional default]
+ (try (get elements index)
+ (except [e TypeError] default)
+ (except [e KeyError] default)
+ (except [e IndexError] default)))
-; read in the config file if present
-(def config
- (let [
- [config-file (SafeConfigParser)]
- [file-buffer (StringIO (+ "[default]\n" (try (.read (open config-file-path "r")) (catch [e Exception] ""))))]]
- (config-file.readfp file-buffer)
- (dict (config-file.items "default"))))
+;; read in the config file if present
+(defn read-config [configstring &optional [config-file (SafeConfigParser)]]
+ (config-file.readfp (StringIO configstring))
+ (dict (config-file.items "default")))
-; takes the externals architectures and turns them into a string
+(def config (read-config (+ "[default]\n" (try (.read (open config-file-path "r"))(except [e Exception] "")))))
+
+;; takes the externals architectures and turns them into a string
(defn get-architecture-strings [folder]
- (let [[archs (get-externals-architectures folder)]
- [sep-1 ")("]
- [sep-2 "-"]]
- (if archs
- (+ "(" (sep-1.join (set (list-comp (sep-2.join (list-comp (str a) [a arch])) [arch archs]))) ")")
- "")))
-
-; check if a particular file has an extension in a set
+ (defn _get_archs [archs sep-1 sep-2]
+ (if archs (+ "(" (sep-1.join (set (list-comp (sep-2.join (list-comp (str a) [a arch])) [arch archs]))) ")") ""))
+ (_get_archs (get-externals-architectures folder) ")(" "-"))
+
+;; check if a particular file has an extension in a set
(defn test-extensions [filename extensions]
(len (list-comp e [e extensions] (filename.endswith e))))
-; examine a folder for externals and return the architectures of those found
+;; examine a folder for externals and return the architectures of those found
(defn get-externals-architectures [folder]
- (sum (list-comp (cond
+ (sum (sorted (list-comp (cond
[(test-extensions f [".pd_linux" ".l_ia64" ".l_i386" ".l_arm" ".so"]) (get-elf-arch (os.path.join folder f) "Linux")]
[(test-extensions f [".pd_freebsd" ".b_i386"]) (get-elf-arch (os.path.join folder f) "FreeBSD")]
[(test-extensions f [".pd_darwin" ".d_fat" ".d_ppc"]) (get-mach-arch (os.path.join folder f))]
[(test-extensions f [".m_i386" ".dll"]) (get-windows-arch (os.path.join folder f))]
[(test-extensions f [".c" ".cpp" ".C" ".cxx" ".cc"]) [["Sources"]]]
- [true []])
- [f (os.listdir folder)]) []))
-
-; get architecture strings from a windows DLL
-; http://stackoverflow.com/questions/495244/how-can-i-test-a-windows-dll-to-determine-if-it-is-32bit-or-64bit
-(defn get-windows-arch [filename] (try (do-get-windows-arch filename) (catch [e Exception] [])))
-(defn do-get-windows-arch [filename]
- (let [[f (open filename "rb")]
- [[magic blah offset] (struct.unpack (str "<2s58sL") (f.read 64))]]
- ;(print magic offset)
- (if (= magic "MZ")
- ; has correct magic bytes
- (do
- (f.seek offset)
- (let [[[sig skip machine] (struct.unpack (str "<2s2sH") (f.read 6))]]
- ;(print sig (% "0x%04x" machine))
- (if (= sig "PE")
- ; has correct signature
- [(+ ["Windows"] (win-types.get (% "0x%04x" machine) ["unknown" "unknown"]))]
- (raise (Exception "Not a PE Executable.")))))
- (raise (Exception "Not a valid Windows dll.")))))
-
-; get architecture from an ELF (e.g. Linux)
+ [True []])
+ [f (os.listdir folder)]
+ (os.path.exists (os.path.join folder f)))) []))
+
+;; get architecture strings from a windows DLL
+;; http://stackoverflow.com/questions/495244/how-can-i-test-a-windows-dll-to-determine-if-it-is-32bit-or-64bit
+(defn get-windows-arch [filename] (try (do-get-windows-arch (open filename "rb")) (except [e Exception] [])))
+(defn do-get-windows-arch [f]
+ (setv [magic _ offset] (struct.unpack (str "<2s58sL") (f.read 64)))
+ (if (= magic (str-to-bytes "MZ")) ; has correct magic bytes
+ (do
+ (f.seek offset)
+ (setv [sig _ machine] (struct.unpack (str "<2s2sH") (f.read 6)))
+ (if (= sig (str-to-bytes "PE")) ; has correct signature
+ [(+ ["Windows"] (win-types.get (% "0x%04x" machine) ["unknown" "unknown"]))]
+ (raise (Exception "Not a PE Executable."))))
+ (raise (Exception "Not a valid Windows dll."))))
+
+;; get architecture from an ELF (e.g. Linux)
(defn get-elf-arch [filename oshint]
(import [elftools.elf.elffile [ELFFile]])
(import [elftools.common [exceptions]])
(try
- (let [[elf (ELFFile (open filename :mode "rb"))]]
- ;; TODO: check section .ARM.attributes for v number
- ;; python ./virtualenv/bin/readelf.py -p .ARM.attributes ...
- [[oshint (+ (elf-arch-types.get (elf.header.get "e_machine") nil) (or (parse-arm-elf-arch elf) "")) (int (slice (.get (elf.header.get "e_ident") "EI_CLASS") -2))]])
- (catch [e exceptions.ELFError] [])))
-
-; get architecture from a Darwin Mach-O file (OSX)
+ (do
+ (setv elf (ELFFile (open filename :mode "rb")))
+ ;; TODO: check section .ARM.attributes for v number
+ ;; python ./virtualenv/bin/readelf.py -p .ARM.attributes ...
+ [[oshint
+ (+ (elf-arch-types.get (elf.header.get "e_machine") None)
+ (or (parse-arm-elf-arch elf) ""))
+ (int (cut-slice (.get (elf.header.get "e_ident") "EI_CLASS") -2 None))]])
+ (except [e exceptions.ELFError] [])))
+
+;; get architecture from a Darwin Mach-O file (OSX)
(defn get-mach-arch [filename]
(import [macholib.MachO [MachO]])
(import [macholib.mach_o [MH_MAGIC_64 CPU_TYPE_NAMES]])
(try
- (let [[macho (MachO filename)]]
- (list-comp ["Darwin" (CPU_TYPE_NAMES.get h.header.cputype h.header.cputype) (if (= h.MH_MAGIC MH_MAGIC_64) 64 32)] [h macho.headers]))
- (catch [e ValueError] [])))
+ (list-comp ["Darwin" (CPU_TYPE_NAMES.get h.header.cputype h.header.cputype) (if (= h.MH_MAGIC MH_MAGIC_64) 64 32)] [h (. (MachO filename) headers)])
+ (except [e ValueError] [])))
+
-; gets the specific flavour of arm by hacking the .ARM.attributes ELF section
+
+;; gets the specific flavour of arm by hacking the .ARM.attributes ELF section
(defn parse-arm-elf-arch [arm-elf]
- (let [[arm-section (if arm-elf (try (arm-elf.get_section_by_name ".ARM.attributes")))]
- [data (and arm-section (.startswith (arm-section.data) "A") (.index (arm-section.data) "aeabi") (.pop (.split (arm-section.data) "aeabi")))]]
- (if data (do
- ; (print (struct.unpack (str "<s") (slice data 7)))
- (let [[[name bins] (.split (slice data 7) "\x00")]
- [arch (get arm-cpu-arch (ord (slice bins 1 2)))]]
- arch)))))
-
-; try to obtain a value from environment, then config file, then prompt user
+ (setv arm-section (if arm-elf (try (arm-elf.get_section_by_name ".ARM.attributes"))))
+ ;; we only support format 'A'
+ (setv A (str-to-bytes "A"))
+ ;; the arm cpu can be found in the 'aeabi' section
+ (setv data (and arm-section (.startswith (arm-section.data) A) (.index (arm-section.data) "aeabi") (.pop (.split (arm-section.data) "aeabi"))))
+ (if data
+ (get arm-cpu-arch (ord (get (get (.split (cut-slice data 7 None) "\x00" 1) 1) 1)))))
+
+;; try to obtain a value from environment, then config file, then prompt user
(defn get-config-value [name &rest default]
- (first (filter (fn [x] (not (nil? x))) [
- ; try to get the value from an environment variable
- (os.environ.get (+ "DEKEN_" (name.upper)))
- ; try to get the value from the config file
- (config.get name)
- ; finally, try the default
- (first default)])))
-
-; prompt for a particular config value for externals host upload
+ (first (filter (fn [x] (not (nil? x)))
+ [
+ ;; try to get the value from an environment variable
+ (os.environ.get (+ "DEKEN_" (name.upper)))
+ ;; try to get the value from the config file
+ (config.get name)
+ ;; finally, try the default
+ (first default)])))
+
+;; prompt for a particular config value for externals host upload
(defn prompt-for-value [name]
(raw_input (% (+
"Environment variable DEKEN_%s is not set and the config file %s does not contain a '%s = ...' entry.\n"
@@ -186,178 +249,202 @@
"Please enter %s for http://%s/: ")
(tuple [(name.upper) config-file-path name name externals-host]))))
-; calculate the sha256 hash of a file
-(defn hash-sum-file [filename]
- (let [[hashfn (hasher)]
- [blocksize 65536]
- [f (open filename :mode "rb")]
- [read-chunk (fn [] (f.read blocksize))]]
- (loop [[buf (read-chunk)]]
- (if (len buf) (do
- (hashfn.update buf)
- (recur (read-chunk)))))
- (let [[digest (hashfn.hexdigest)]
- [hashfilename (% "%s.%s" (tuple [filename hash-extension]))]]
- (.write (open hashfilename "w") digest)
- hashfilename)))
+;; calculate the sha256 hash of a file
+(defn hash-file [filename &optional [blocksize 65535] [hashfn (hasher)]]
+ (setv f (open filename :mode "rb"))
+ (setv read-chunk (fn [] (.read f blocksize)))
+ (while True
+ (setv buf (read-chunk))
+ (if-not buf (break))
+ (hashfn.update buf))
+ (hashfn.hexdigest))
+
+(defn hash-sum-file [filename &optional [blocksize 65535]]
+ (setv hashfilename (% "%s.%s" (tuple [filename hash-extension])))
+ (.write (open hashfilename :mode "w") (hash-file filename blocksize))
+ hashfilename)
;; handling GPG signatures
(try (import gnupg)
- ;; read a value from the gpg config
+ ;; read a value from the gpg config
(except [e ImportError] (defn gpg-sign-file [filename] (print (% "Unable to GPG sign '%s'\n" filename) "'gnupg' module not loaded")))
(else
+ (defn gpg-unavail-error [state &optional ex]
+ (print (% "WARNING: GPG %s failed:" state))
+ (if ex (print ex))
+ (print "Do you have 'gpg' installed?")
+ (print "- If you've received numerous errors during the initial installation,")
+ (print " you probably should install 'python-dev', 'libffi-dev' and 'libssl-dev'")
+ (print " and re-run `deken install`")
+ (print "- On OSX you might want to install the 'GPG Suite'"))
(defn gpg-get-config [gpg id]
- (let [[configdir (cond [gpg.gnupghome gpg.gnupghome] [True (os.path.join "~" ".gnupg")])]
- [configfile (os.path.expanduser (os.path.join configdir "gpg.conf"))]]
(try
- (get (list-comp (get (.split (.strip x)) 1) [x (.readlines ( open configfile))] (.startswith (.lstrip x) (.strip id) )) -1)
- (catch [e [IOError IndexError]] None))))
+ (get
+ (list-comp
+ (get (.split (.strip x)) 1)
+ [x
+ (.readlines
+ ( open
+ (os.path.expanduser
+ (os.path.join
+ (or gpg.gnupghome (os.path.join "~" ".gnupg"))
+ "gpg.conf"))
+ ))]
+ (.startswith (.lstrip x) (.strip id) )) -1)
+ (except [e [IOError IndexError]] None)))
;; get the GPG key for signing
(defn gpg-get-key [gpg]
- (let [[keyid (get-config-value "key_id" (gpg-get-config gpg "default-key"))]]
- (try
- (car (list-comp k [k (gpg.list_keys true)] (cond [keyid (.endswith (.upper (get k "keyid" )) (.upper keyid) )] [True True])))
- (catch [e IndexError] None))))
+ (setv keyid (get-config-value "key_id" (gpg-get-config gpg "default-key")))
+ (try
+ (car (list-comp k
+ [k (gpg.list_keys True)]
+ (cond [keyid (.endswith (.upper (get k "keyid" )) (.upper keyid) )]
+ [True True])))
+ (except [e IndexError] None)))
;; generate a GPG signature for a particular file
- (defn do-gpg-sign-file [filename signfile]
+ (defn do-gpg-sign-file [filename signfile gnupghome use-agent]
(print (% "Attempting to GPG sign '%s'" filename))
- (let [[gnupghome (get-config-value "gpg_home")]
- [use-agent (str-to-bool (get-config-value "gpg_agent"))]
- [gpg (set-attr (apply gnupg.GPG []
- (dict-merge (dict-merge {} (if gnupghome {"gnupghome" gnupghome}))
- (if use-agent {"use_agent" true})))
- "decode_errors" "replace")]
- [sec-key (gpg-get-key gpg)]
- [keyid (try (get sec-key "keyid") (catch [e KeyError] None) (catch [e TypeError] None))]
- [uid (try (get (get sec-key "uids") 0) (catch [e KeyError] None) (catch [e TypeError] None))]
- [passphrase (if (and (not use-agent) keyid)
- (do
- (print (% "You need a passphrase to unlock the secret key for\nuser: %s ID: %s\nin order to sign %s" (tuple [uid keyid filename])))
- (getpass "Enter GPG passphrase: " )))]
- [signconfig (dict-merge (dict-merge {"detach" true}
- (if keyid {"keyid" keyid}))
- (if passphrase {"passphrase" passphrase}))]]
- (if (and (not use-agent) passphrase)
- (print "No passphrase and not using gpg-agent...trying to sign anyhow"))
- (try
- (let [[sig (if gpg (apply gpg.sign_file [(open filename "rb")] signconfig))]
- [signfile (+ filename ".asc")]]
- (if (hasattr sig "stderr")
- (print (try (str sig.stderr) (catch [e UnicodeEncodeError] (.encode sig.stderr "utf-8")))))
- (if (not sig)
- (do
- (print "WARNING: Could not GPG sign the package.")
- None)
- (do
- (.write (open signfile "w") (str sig))
- signfile)))
- (catch [e OSError] (print (.join "\n"
- ["WARNING: GPG signing failed:"
- str(e)
- "Do you have 'gpg' (on OSX: 'GPG Suite') installed?"]))))))
+ (setv gpg
+ (try
+ (set-attr
+ (apply gnupg.GPG []
+ (dict-merge
+ (dict-merge {} (if gnupghome {"gnupghome" gnupghome}))
+ (if use-agent {"use_agent" True})))
+ "decode_errors" "replace")
+ (except [e OSError] (gpg-unavail-error "init" e))))
+ (if gpg (do
+ (setv [keyid uid] (list-comp (try-get (gpg-get-key gpg) _ None) [_ ["keyid" "uids"]]))
+ (setv uid (try-get uid 0 None))
+ (setv passphrase
+ (if (and (not use-agent) keyid)
+ (do
+ (print (% "You need a passphrase to unlock the secret key for\nuser: %s ID: %s\nin order to sign %s"
+ (tuple [uid keyid filename])))
+ (getpass "Enter GPG passphrase: " ))))
+ (setv signconfig (dict-merge (dict-merge {"detach" True}
+ (if keyid {"keyid" keyid}))
+ (if passphrase {"passphrase" passphrase})))
+
+ (if (and (not use-agent) (not passphrase))
+ (print "No passphrase and not using gpg-agent...trying to sign anyhow"))
+ (try
+ (do
+ (setv sig (if gpg (apply gpg.sign_file [(open filename "rb")] signconfig)))
+; (if (hasattr sig "stderr")
+; (print (try (str sig.stderr) (except [e UnicodeEncodeError] (.encode sig.stderr "utf-8")))))
+ (if (not sig)
+ (print "WARNING: Could not GPG sign the package.")
+ (do
+ (with [f (open signfile "w")] (f.write (str sig)))
+ signfile)))
+ (except [e OSError] (gpg-unavail-error "signing" e))))))
;; sign a file if it is not already signed
(defn gpg-sign-file [filename]
- (let [[signfile (+ filename ".asc")]]
- (if (os.path.exists signfile)
- (do
- (print (% "NOTICE: not GPG-signing already signed file '%s'\nNOTICE: delete '%s' to re-sign" (, filename signfile)))
- signfile)
- (do-gpg-sign-file filename signfile))))))
-
-; execute a command inside a directory
+ (setv signfile (+ filename ".asc"))
+ (setv gpghome (get-config-value "gpg_home"))
+ (setv gpgagent (str-to-bool (get-config-value "gpg_agent")))
+ (if (os.path.exists signfile)
+ (do
+ (print (% "NOTICE: not GPG-signing already signed file '%s'\nNOTICE: delete '%s' to re-sign" (, filename signfile)))
+ signfile)
+ (do-gpg-sign-file filename signfile gpghome gpgagent)))))
+
+;; execute a command inside a directory
(defn in-dir [destination f &rest args]
- (let [
- [last-dir (os.getcwd)]
- [new-dir (os.chdir destination)]
- [result (apply f args)]]
- (os.chdir last-dir)
- result))
-
-; zip up a single directory
-; http://stackoverflow.com/questions/1855095/how-to-create-a-zip-archive-of-a-directory
+ (setv last-dir (os.getcwd))
+ (os.chdir destination)
+ (setv result (apply f args))
+ (os.chdir last-dir)
+ result)
+
+;; zip up a single directory
+;; http://stackoverflow.com/questions/1855095/how-to-create-a-zip-archive-of-a-directory
+(defn zip-file [filename]
+ (try (zipfile.ZipFile filename "w" :compression zipfile.ZIP_DEFLATED)
+ (except [e RuntimeError] (zipfile.ZipFile filename "w"))))
(defn zip-dir [directory-to-zip archive-file]
- (let [[zip-file (+ archive-file ".zip")]
- [zipf (try (zipfile.ZipFile zip-file "w" :compression zipfile.ZIP_DEFLATED)
- (catch [e RuntimeError] (zipfile.ZipFile zip-file "w")))]
- [root-basename (os.path.basename directory-to-zip)]
- [root-path (os.path.join directory-to-zip "..")]]
- (for [[root dirs files] (os.walk directory-to-zip)]
- (for [file files]
- (let [[file-path (os.path.join root file)]]
- (zipf.write file-path (os.path.relpath file-path root-path)))))
- (zipf.close)
- zip-file))
-
-; tar up the directory
+ (setv zip-filename (+ archive-file ".zip"))
+ (with [f (zip-file zip-filename)]
+ (for [[root dirs files] (os.walk directory-to-zip)]
+ (for [file-path (list-comp (os.path.join root file) [file files])]
+ (if (os.path.exists file-path)
+ (f.write file-path (os.path.relpath file-path (os.path.join directory-to-zip "..")))))))
+ zip-filename)
+
+;; tar up the directory
(defn tar-dir [directory-to-tar archive-file]
- (let [[tar-file (+ archive-file ".tar.gz")]
- [tarf (tarfile.open tar-file "w:gz")]]
- (do
- (.add tarf directory-to-tar)
- (.close tarf)
- tar-file)))
-
-; do we use zip or tar on this archive?
+ (setv tar-file (+ archive-file ".tar.gz"))
+ (defn tarfilter [tarinfo]
+ (setv tarinfo.name (os.path.relpath tarinfo.name (os.path.join directory-to-tar "..")))
+ tarinfo)
+ (with [f (tarfile.open tar-file "w:gz")]
+ (f.add directory-to-tar :filter tarfilter))
+ tar-file)
+
+;; do we use zip or tar on this archive?
(defn archive-extension [rootname]
(if (or (in "(Windows" rootname) (not (in "(" rootname))) ".zip" ".tar.gz"))
-; automatically pick the correct archiver - windows or "no arch" = zip
+;; automatically pick the correct archiver - windows or "no arch" = zip
(defn archive-dir [directory-to-archive rootname]
- (let [[ext (archive-extension rootname)]]
- ((if (= ext ".zip") zip-dir tar-dir) directory-to-archive rootname)))
+ ((if (= (archive-extension rootname) ".zip") zip-dir tar-dir) directory-to-archive rootname))
-; naive check, whether we have an archive: compare against known suffixes
+;; naive check, whether we have an archive: compare against known suffixes
(defn is-archive? [filename]
(len (list-comp f [f [".zip" ".tar.gz" ".tgz"]] (.endswith (filename.lower) f))))
-; upload a zipped up package to puredata.info
+;; upload a zipped up package to puredata.info
(defn upload-file [filepath destination username password]
+ ;; get username and password from the environment, config, or user input
+ (import easywebdav)
(if filepath
- (let [
- ;; get username and password from the environment, config, or user input
- [filename (os.path.basename filepath)]
- [[pkg ver arch ext] (parse-filename filename)]
- [url (urlparse destination)]
- [proto (or url.scheme "https")]
- [host (or url.netloc externals-host)]
- [path (str (replace-words (or (.rstrip url.path "/") "/Members/%u/software/%p/%v") (,
- (, "%u" username) (, "%p" pkg) (, "%v" (or ver "")))))]
- [remotepath (+ path "/" filename)]
- [url (+ proto "://" host path)]
- [dav (apply easywebdav.connect [host] {"username" username "password" password "protocol" proto})]]
- (print (+ "Uploading " filename " to " url))
- (try
- (do
- ; make sure all directories exist
- (dav.mkdirs path)
- ; upload the package file
- (dav.upload filepath remotepath))
- (catch [e easywebdav.client.OperationFailed]
- (sys.exit (+
- (% "Couldn't upload to %s!\n" url)
- (% "Are you sure you have the correct username and password set for '%s'?\n" host)
- (% "Please ensure the folder '%s' exists on the server and is writeable." path))))))))
+ (do
+ (setv filename (os.path.basename filepath))
+ (setv [pkg ver _ _] (parse-filename filename))
+ (setv url (urlparse destination))
+ (setv proto (or url.scheme "https"))
+ (setv host (or url.netloc externals-host))
+ (setv path
+ (str
+ (replace-words
+ (or (.rstrip url.path "/") "/Members/%u/software/%p/%v")
+ (, (, "%u" username) (, "%p" pkg) (, "%v" (or ver ""))))))
+ (setv url (+ proto "://" host path))
+ (setv dav (apply easywebdav.connect [host] {"username" username "password" password "protocol" proto}))
+ (print (+ "Uploading " filename " to " url))
+ (try
+ (do
+ ;; make sure all directories exist
+ (dav.mkdirs path)
+ ;; upload the package file
+ (dav.upload filepath (+ path "/" filename)))
+ (except [e easywebdav.client.OperationFailed]
+ (sys.exit (+
+ (% "Couldn't upload to %s!\n" url)
+ (% "Are you sure you have the correct username and password set for '%s'?\n" host)
+ (% "Please ensure the folder '%s' exists on the server and is writeable." path))))))))
+
;; upload a list of archives (given the archive-filename it will also upload some extra-files (sha256, gpg,...))
(defn upload-package [pkg destination username password]
- (do
- (print "Uploading package" pkg)
- (upload-file (hash-sum-file pkg) destination username password)
- (upload-file pkg destination username password)
- (upload-file (gpg-sign-file pkg) destination username password)))
+ (print "Uploading package" pkg)
+ (upload-file (hash-sum-file pkg) destination username password)
+ (upload-file pkg destination username password)
+ (upload-file (gpg-sign-file pkg) destination username password))
(defn upload-packages [pkgs destination username password skip-source]
- (do (if (not skip-source) (check-sources (set (list-comp (filename-to-namever pkg) [pkg pkgs]))
- (set (list-comp (has-sources? pkg) [pkg pkgs]))
- (if (= "puredata.info"
- (.lower (or (getattr (urlparse destination) "netloc") externals-host)))
- username)))
- (for [pkg pkgs] (upload-package pkg destination username password))))
-
-; compute the zipfile name for a particular external on this platform
+ (if (not skip-source) (check-sources (set (list-comp (filename-to-namever pkg) [pkg pkgs]))
+ (set (list-comp (has-sources? pkg) [pkg pkgs]))
+ (if (= "puredata.info"
+ (.lower (or (getattr (urlparse destination) "netloc") externals-host)))
+ username)))
+ (for [pkg pkgs] (upload-package pkg destination username password)))
+
+;; compute the zipfile name for a particular external on this platform
(defn make-archive-basename [folder version]
- (+ (.rstrip folder "/\\")
+ (+ (os.path.basename folder)
(cond [(nil? version) (sys.exit
(+ (% "No version for '%s'!\n" folder)
" Please provide the version-number via the '--version' flag.\n"
@@ -368,43 +455,43 @@
[True ""])
(get-architecture-strings folder) "-externals"))
-; create additional files besides archive: hash-file and gpg-signature
+;; create additional files besides archive: hash-file and gpg-signature
(defn archive-extra [zipfile]
- (do
(print "Packaging" zipfile)
(hash-sum-file zipfile)
(gpg-sign-file zipfile)
- zipfile))
+ zipfile)
-; parses a filename into a (pkgname version archs extension) tuple
-; missing values are nil
+;; parses a filename into a (pkgname version archs extension) tuple
+;; missing values are None
(defn parse-filename [filename]
(list-comp (get
- ; parse filename with a regex
+ ;; parse filename with a regex
(re.split r"(.*/)?(.+?)(-v(.+)-)?((\([^\)]+\))+|-)*-externals\.([a-z.]*)" filename) x)
- ; extract only the fields of interested
+ ;; extract only the fields of interested
[x [2 4 5 7]]))
(defn filename-to-namever [filename]
- (let [[[pkg ver arch ext] (parse-filename filename)]] (join-nonempty "/" [pkg ver])))
+ (join-nonempty "/" (get-values (parse-filename filename) [0 1])))
;; check if the list of archs contains sources (or is arch-independent)
(defn is-source-arch? [arch] (or (not arch) (in "(Sources)" arch)))
;; check if a package contains sources (and returns name-version to be used in a SET of packages with sources)
-(defn has-sources? [filename] (let [[[pkg ver arch ext] (parse-filename filename)]]
- (if (is-source-arch? arch) (filename-to-namever filename))))
+(defn has-sources? [filename]
+ (if (is-source-arch? (try-get (parse-filename filename) 2)) (filename-to-namever filename)))
;; check if the given package has a sources-arch on puredata.info
(defn check-sources at puredata-info [pkg username]
- (do (print (% "Checking puredata.info for Source package for '%s'" pkg))
- (in pkg
- ;; list of package/version matching 'pkg' that have 'Source' archictecture
- (list-comp
- (has-sources? p)
- [p
- (list-comp
- (try-get (.split (try-get (.split x "\t") 1) "/") -1) ;; filename part of the download URL
- [x (.splitlines (getattr (requests.get (% "http://deken.puredata.info/search?name=%s" (get (.split pkg "/") 0))) "text"))]
- (= username (try-get (.split x "\t") 2)))]))))
+ (import requests)
+ (print (% "Checking puredata.info for Source package for '%s'" pkg))
+ (in pkg
+ ;; list of package/version matching 'pkg' that have 'Source' archictecture
+ (list-comp
+ (has-sources? p)
+ [p
+ (list-comp
+ (try-get (.split (try-get (.split x "\t") 1) "/") -1) ; filename part of the download URL
+ [x (.splitlines (getattr (requests.get (% "http://deken.puredata.info/search?name=%s" (get (.split pkg "/") 0))) "text"))]
+ (= username (try-get (.split x "\t") 2)))])))
;; check if sources archs are present by comparing a SET of packagaes and a SET of packages-with-sources
(defn check-sources [pkgs sources &optional puredata-info-user]
@@ -429,69 +516,74 @@
(get-config-value "password")))
(getpass (% "Please enter password for uploading as '%s': " username))))
-; the executable portion of the different sub-commands that make up the deken tool
-(def commands {
- ; zip up a set of built externals
- :package (fn [args]
- ;; are they asking to package a directory?
- (list-comp
- (if (os.path.isdir name)
- ; if asking for a directory just package it up
- (archive-extra (archive-dir name (make-archive-basename (.rstrip name "/\\") args.version)))
- (sys.exit (% "Not a directory '%s'!" name)))
- (name args.source)))
- ; upload packaged external to pure-data.info
- :upload (fn [args]
- (let [[username (or (get-config-value "username") (prompt-for-value "username"))]
- [password (get-upload-password username args.ask-password)]]
- (do
- (upload-packages (list-comp (cond [(os.path.isfile x)
- (if (is-archive? x) x (sys.exit (% "'%s' is not an externals archive!" x)))]
- [(os.path.isdir x) (get ((:package commands) (set-attr (copy.deepcopy args) "source" [x])) 0)]
- [True (sys.exit (% "Unable to process '%s'!" x))])
- (x args.source))
- (or (getattr args "destination") (get-config-value "destination" ""))
- username password args.no-source-error))
- ;; if we reach this line, upload has succeeded; so let's try storing the (non-empty) password in the keyring
- (if password
- (try (do
- (import keyring)
- (keyring.set_password "deken" username password))))))
- ; self-update deken
- :upgrade (fn [args]
- (sys.exit "The upgrade script isn't here, it's in the Bash wrapper!"))})
-
-; kick things off by using argparse to check out the arguments supplied by the user
+;; the executable portion of the different sub-commands that make up the deken tool
+(def commands
+ {
+ ;; zip up a set of built externals
+ :package (fn [args]
+ ;; are they asking to package a directory?
+ (list-comp
+ (if (os.path.isdir name)
+ ;; if asking for a directory just package it up
+ (archive-extra (archive-dir name (make-archive-basename (os.path.normpath name) args.version)))
+ (sys.exit (% "Not a directory '%s'!" name)))
+ (name args.source)))
+ ;; upload packaged external to pure-data.info
+ :upload (fn [args]
+ (setv username (or (get-config-value "username") (prompt-for-value "username")))
+ (setv password (get-upload-password username args.ask-password))
+ (upload-packages (list-comp (cond [(os.path.isfile x)
+ (if (is-archive? x) x (sys.exit (% "'%s' is not an externals archive!" x)))]
+ [(os.path.isdir x) (get ((:package commands) (set-attr (copy.deepcopy args) "source" [x])) 0)]
+ [True (sys.exit (% "Unable to process '%s'!" x))])
+ (x args.source))
+ (or (getattr args "destination") (get-config-value "destination" ""))
+ username password args.no-source-error)
+ ;; if we reach this line, upload has succeeded; so let's try storing the (non-empty) password in the keyring
+ (if password
+ (try (do
+ (import keyring)
+ (keyring.set_password "deken" username password)))))
+ ;; the rest should have been caught by the wrapper script
+ :upgrade (fn [args] (sys.exit "'upgrade' not implemented for this platform!"))
+ :update (fn [args] (sys.exit "'upgrade' not implemented for this platform!"))
+ :install (fn [args] (sys.exit "'install' not implemented for this platform!"))})
+
+;; kick things off by using argparse to check out the arguments supplied by the user
(defn main []
- (let [
- [arg-parser (apply argparse.ArgumentParser [] {"prog" "deken" "description" "Deken is a build tool for Pure Data externals."})]
- [arg-subparsers (apply arg-parser.add_subparsers [] {"help" "-h for help." "dest" "command"})]
- [arg-package (apply arg-subparsers.add_parser ["package"])]
- [arg-upload (apply arg-subparsers.add_parser ["upload"])]
- [arg-upgrade (apply arg-subparsers.add_parser ["upgrade"])]]
- (apply arg-parser.add_argument ["--version"] {"action" "version" "version" version "help" "Outputs the version number of Deken."})
- (apply arg-package.add_argument ["source"] {"nargs" "+"
- "metavar" "SOURCE"
- "help" "The path to a directory of externals, abstractions, or GUI plugins to be packaged."})
- (apply arg-package.add_argument ["--version" "-v"] {"help" "An external version number to insert into the package name."
- "default" nil
- "required" false})
- (apply arg-upload.add_argument ["source"] {"nargs" "+"
- "metavar" "PACKAGE"
- "help" "The path to an externals/abstractions/plugins zipfile to be uploaded, or a directory which will be packaged first automatically."})
- (apply arg-upload.add_argument ["--version" "-v"] {"help" "An external version number to insert into the package name. (in case a package is created)"
- "default" nil
- "required" false})
- (apply arg-upload.add_argument ["--destination" "-d"] {"help" "The destination folder to upload the file into (defaults to /Members/USER/software/PKGNAME/VERSION/)." "default" "" "required" false})
- (apply arg-upload.add_argument ["--ask-password" "-P"] {"action" "store_true" "help" "Ask for upload password (rather than using password-manager." "default" "" "required" false})
- (apply arg-upload.add_argument ["--no-source-error"] {"action" "store_true" "help" "Force-allow uploading of packages without sources." "required" false})
- (let [
- [arguments (.parse_args arg-parser)]
- [command (.get commands (keyword arguments.command))]]
- (print "Deken" version)
- (if command (command arguments) (.print_help arg-parser)))))
+ (print "Deken" version)
+
+ (setv arg-parser
+ (apply argparse.ArgumentParser [] {"prog" "deken" "description" "Deken is a build tool for Pure Data externals."}))
+ (setv arg-subparsers (apply arg-parser.add_subparsers [] {"help" "-h for help." "dest" "command" "metavar" "{package,upload}"}))
+ (setv arg-package (apply arg-subparsers.add_parser ["package"]))
+ (setv arg-upload (apply arg-subparsers.add_parser ["upload"]))
+ (apply arg-subparsers.add_parser ["install"])
+ (apply arg-subparsers.add_parser ["upgrade"])
+ (apply arg-subparsers.add_parser ["update"])
+ (apply arg-parser.add_argument ["--version"] {"action" "version" "version" version "help" "Outputs the version number of Deken."})
+ (apply arg-package.add_argument ["source"]
+ {"nargs" "+"
+ "metavar" "SOURCE"
+ "help" "The path to a directory of externals, abstractions, or GUI plugins to be packaged."})
+ (apply arg-package.add_argument ["--version" "-v"] {"help" "An external version number to insert into the package name."
+ "default" None
+ "required" False})
+ (apply arg-upload.add_argument ["source"] {"nargs" "+"
+ "metavar" "PACKAGE"
+ "help" "The path to an externals/abstractions/plugins zipfile to be uploaded, or a directory which will be packaged first automatically."})
+ (apply arg-upload.add_argument ["--version" "-v"] {"help" "An external version number to insert into the package name. (in case a package is created)"
+ "default" None
+ "required" False})
+ (apply arg-upload.add_argument ["--destination" "-d"] {"help" "The destination folder to upload the file into (defaults to /Members/USER/software/PKGNAME/VERSION/)." "default" "" "required" False})
+ (apply arg-upload.add_argument ["--ask-password" "-P"] {"action" "store_true" "help" "Ask for upload password (rather than using password-manager." "default" "" "required" False})
+ (apply arg-upload.add_argument ["--no-source-error"] {"action" "store_true" "help" "Force-allow uploading of packages without sources." "required" False})
+
+ (setv arguments (.parse_args arg-parser))
+ (setv command (.get commands (keyword arguments.command)))
+ (if command (command arguments) (.print_help arg-parser)))
(if (= __name__ "__main__")
(try
(main)
- (catch [e KeyboardInterrupt] (print "\n[interrupted by user]"))))
+ (except [e KeyboardInterrupt] (print "\n[interrupted by user]"))))
diff --git a/developer/deken.py b/developer/deken.py
new file mode 100644
index 0000000..80f5f7d
--- /dev/null
+++ b/developer/deken.py
@@ -0,0 +1,42 @@
+#!/usr/bin/env python
+# -*- coding: utf-8 -*-
+
+# This software is copyrighted by Chris McCormick and others. The following
+# terms (the "Standard Improved BSD License") apply to all files associated
+# with the software unless explicitly disclaimed in individual files:
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above
+# copyright notice, this list of conditions and the following
+# disclaimer in the documentation and/or other materials provided
+# with the distribution.
+# 3. The name of the author may not be used to endorse or promote
+# products derived from this software without specific prior
+# written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY
+# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR
+# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+# THE POSSIBILITY OF SUCH DAMAGE.
+
+# this is a thin wrapper around deken.hy, to launch it without a
+# HY executable (or file associations)
+
+import os
+import hy
+hy.importer.import_file_to_module(
+ "__main__",
+ os.path.join(os.path.dirname(os.path.realpath(__file__)), "deken.hy"))
diff --git a/developer/requirements.txt b/developer/requirements.txt
index b85b6d0..f30691b 100644
--- a/developer/requirements.txt
+++ b/developer/requirements.txt
@@ -1,9 +1,9 @@
-hy==0.11.0
+hy==0.12.1
easywebdav==1.2.0
-pyelftools==0.23
-macholib==1.7
-python-gnupg==0.3.7
-keyring==4.0
-ndg_httpsclient==0.4.0
+pyelftools==0.24
+macholib==1.8
+python-gnupg==0.4.1
+keyring==10.4.0
+ndg_httpsclient==0.4.3
pyasn1==0.1.9
-pyOpenSSL==0.15.1
+pyOpenSSL==16.2.0
diff --git a/developer/server/README.md b/developer/server/README.md
deleted file mode 100644
index 7f5bb7f..0000000
--- a/developer/server/README.md
+++ /dev/null
@@ -1,10 +0,0 @@
-server-side search-scripts
-===
-
-stubs for server-side scripts used search for packages and present them in a
-form, that is easily understood by the deken-plugin.
-
-### puredata.info
-searches for files (IAEMfile) and software-center releases (PSCFile) that match
-a given pattern.
-
diff --git a/developer/server/puredata_info.py b/developer/server/puredata_info.py
deleted file mode 100644
index 8cd026a..0000000
--- a/developer/server/puredata_info.py
+++ /dev/null
@@ -1,80 +0,0 @@
-# Import a standard function, and get the HTML request and response objects.
-from Products.PythonScripts.standard import html_quote
-from Products.PythonScripts.standard import url_unquote
-request = container.REQUEST
-RESPONSE = request.RESPONSE
-
-qs = request['QUERY_STRING']
-
-args = {}
-if qs:
- for arg in qs.split('&'):
- try:
- key, val = arg.split('=', 1)
- except ValueError:
- key = arg
- val = ''
- if key in args:
- args[key].append(val)
- else:
- args[key] = [val]
-
-
-def getNameVersion(filename):
- filename = filename.split('-externals', 1)[0] .split('(')[0]
- pkgver = filename.split('-v')
- if len(pkgver) > 1:
- pkg = '-v'.join(pkgver[:-1])
- ver = pkgver[-1].strip('-').strip()
- else:
- pkg = pkgver[0]
- ver = ""
- return (pkg.strip('-').strip(), ver)
-
-
-def showPackage(obj, url, filename):
- (name, version) = getNameVersion(filename)
- title = obj.Title().replace('\t', ' ')
- if (name not in title) or (version not in title):
- if version:
- title = "%s/%s (%s)" % (name, version, title)
- else:
- title = "%s (%s)" % (name, title)
- date = obj.Date().replace('\t', ' ')
- owner = obj.owner_info()['id'].replace('\t', ' ')
- print("%s\t%s\t%s\t%s" % (title, url, owner, date))
- return printed
-
-mytypes = ('IAEMFile', 'PSCFile')
-suffixes = ['zip', 'tgz', 'tar.gz']
-
-for t in mytypes:
- results = context.portal_catalog(portal_type=t)
- for i in results:
- url = url_unquote(i.getURL())
- FileName = url.split('/')[-1]
- filename=FileName.lower()
- match = False
- for suffix in suffixes:
- if filename.endswith("-externals.%s" % (suffix,)):
- match = True
- break
- if not match:
- continue
- if 'name' in args:
- (fname, version) = getNameVersion(filename)
- match = False
- for name in args['name']:
- name=name.lower()
- if name in fname:
- match = True
- break
- if not match:
- continue
- print("%s" % showPackage(i.getObject(), url, FileName))
-
-# make sure there is *some* content in the page
-if not printed:
- print("")
-
-return printed
diff --git a/developer/windows/deken-windows.py b/developer/windows/deken-windows.py
deleted file mode 100644
index 0f71df1..0000000
--- a/developer/windows/deken-windows.py
+++ /dev/null
@@ -1,5 +0,0 @@
-import os
-import hy
-hy.importer.import_file_to_module("__main__", os.path.join(os.path.dirname(os.path.realpath(__file__)), "deken.hy"))
-#import deken
-# deken.main()
diff --git a/developer/windows/deken.bat b/developer/windows/deken.bat
index 7ae7c7d..41ebfb0 100644
--- a/developer/windows/deken.bat
+++ b/developer/windows/deken.bat
@@ -1,3 +1,3 @@
@set REF=%~dp0\windows\portable-python\App
@set PYTHONPATH=%REF%\Lib;%REF%\DLLs;%REF%\libs;%REF%\site-packages-alt
-@%REF%\python.exe %~dp0\deken-windows.py %*
+@%REF%\python.exe %~dp0\deken.py %*
diff --git a/plugin-config.md b/plugin-config.md
index e6f9032..ecb8489 100644
--- a/plugin-config.md
+++ b/plugin-config.md
@@ -1,4 +1,4 @@
-the deken-plugin for Pd can be configured via a simple text-file.
+The deken-plugin for Pd can be configured via a simple text-file.
# deken-plugin.conf
@@ -28,7 +28,7 @@ or into a system-specific place (`$PdPath` resp `%PdPath%` are the installation
Here are the possible values:
* `installpath` = Path where you would want to install the externals
- (default: the first writeable path in the standard search paths)
+ (default: the first writable path in the standard search paths)
(note: you should *always* use `/` as path-separator, even on W32!)
--
deken packaging
More information about the pkg-multimedia-commits
mailing list