From 615e4289ec90871791cea6edc70ce6a9d4be4f3c Mon Sep 17 00:00:00 2001 From: Hans-Christoph Steiner Date: Tue, 29 Nov 2011 04:51:36 +0000 Subject: add expand_vars proc to expand vars like /Users/hans, , etc within the file names svn path=/trunk/externals/tclfile/; revision=15802 --- delete-help.pd | 18 +++++++++++++----- delete.tcl | 8 ++++---- executable.tcl | 8 ++++---- exists-help.pd | 38 +++++++++++++++++++++----------------- exists.tcl | 9 +++++---- isdirectory.tcl | 8 ++++---- isfile.tcl | 8 ++++---- mkdir.tcl | 8 ++++---- owned.tcl | 8 ++++---- readable.tcl | 8 ++++---- tclfile.tcl | 20 ++++++++++++++++++++ writable.tcl | 8 ++++---- 12 files changed, 91 insertions(+), 58 deletions(-) diff --git a/delete-help.pd b/delete-help.pd index 5a25fb8..3104d2a 100644 --- a/delete-help.pd +++ b/delete-help.pd @@ -1,4 +1,4 @@ -#N canvas 657 79 501 349 10; +#N canvas 378 55 501 349 10; #X obj 297 261 mkdir; #X obj 202 160 exists; #X obj 202 181 tgl 15 0 empty empty empty 17 7 0 10 -262144 -1 -1 1 @@ -9,15 +9,23 @@ #X text 28 294 this is a clone of this command:; #X obj 48 115 delete; #X text 25 20 delete a file or empty folder; -#X text 253 209 make a new one:; +#X text 248 189 make a new one:; #X obj 120 306 pddp/pddplink http://tcl.tk/man/tcl8.5/TclCmd/file.htm#M12 ; -#X msg 48 63 this is a test; -#X msg 298 233 this is a test; -#X msg 202 114 this is a test; +#X msg 48 63 ~/this is a test; +#X msg 298 233 ~/this is a test; +#X msg 202 114 ~/this is a test; +#X msg 62 87 $HOME/this is a test; +#X msg 193 91 $HOME/this is a test; +#X msg 282 210 $HOME/this is a test; +#X obj 191 50 loadbang; #X connect 1 0 2 0; #X connect 2 0 3 0; #X connect 4 0 1 0; #X connect 10 0 6 0; #X connect 11 0 0 0; #X connect 12 0 1 0; +#X connect 13 0 6 0; +#X connect 14 0 1 0; +#X connect 15 0 0 0; +#X connect 16 0 14 0; diff --git a/delete.tcl b/delete.tcl index 0037e0d..2d1cfb1 100644 --- a/delete.tcl +++ b/delete.tcl @@ -13,12 +13,12 @@ proc delete::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc delete::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] delete::0_bang $self } proc delete::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] delete::0_bang $self } @@ -35,11 +35,11 @@ proc delete::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc delete::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc delete::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class delete diff --git a/executable.tcl b/executable.tcl index 1445ca7..36429dc 100644 --- a/executable.tcl +++ b/executable.tcl @@ -16,12 +16,12 @@ proc executable::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc executable::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] executable::0_bang $self } proc executable::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] executable::0_bang $self } @@ -38,11 +38,11 @@ proc executable::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc executable::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc executable::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class executable diff --git a/exists-help.pd b/exists-help.pd index 9ec95b2..94edc24 100644 --- a/exists-help.pd +++ b/exists-help.pd @@ -1,5 +1,4 @@ -#N canvas 351 42 448 333 10; -#X obj 33 166 exists; +#N canvas 519 22 448 333 10; #X floatatom 36 202 5 0 0 0 - - -; #X obj 37 226 bng 15 250 50 0 empty empty empty 17 7 0 10 -262144 -1 -1; @@ -9,32 +8,37 @@ #X floatatom 242 219 5 0 0 0 - - -; #X obj 243 243 bng 15 250 50 0 empty empty empty 17 7 0 10 -262144 -1 -1; -#X msg 247 77 bang; #X msg 272 116 symbol /tmp/; #X msg 288 138 /tmp; #X obj 110 306 pddp/pddplink http://tcl.tk/man/tcl8.5/TclCmd/file.htm#M15 ; #X text 18 294 this is a clone of this command:; -#X msg 48 63 exists.tcl; #X msg 86 111 this is a test; #X msg 83 137 list one 2 three 4; #X msg 106 171 1 2 3 4; #X msg 86 208 float 1; #X msg 144 201 1 two; #X msg 291 163 list this is a test; +#X obj 34 166 isdirectory; +#X msg 48 63 symbol $s123.23; +#X msg 246 61 $HOME; +#X msg 232 32 symbol $HOME; +#X msg 271 82 list one 2 three 4; #X connect 0 0 1 0; -#X connect 1 0 2 0; -#X connect 3 0 0 0; -#X connect 4 0 0 0; +#X connect 2 0 17 0; +#X connect 3 0 17 0; +#X connect 4 0 5 0; #X connect 5 0 6 0; -#X connect 6 0 7 0; -#X connect 8 0 5 0; -#X connect 9 0 5 1; -#X connect 10 0 5 1; -#X connect 13 0 0 0; -#X connect 14 0 0 0; -#X connect 15 0 0 0; -#X connect 16 0 0 0; +#X connect 7 0 4 1; +#X connect 8 0 4 1; +#X connect 11 0 17 0; +#X connect 12 0 17 0; +#X connect 13 0 17 0; +#X connect 14 0 17 0; +#X connect 15 0 17 0; +#X connect 16 0 4 1; #X connect 17 0 0 0; -#X connect 18 0 0 0; -#X connect 19 0 5 1; +#X connect 18 0 17 0; +#X connect 19 0 4 0; +#X connect 20 0 4 0; +#X connect 21 0 4 0; diff --git a/exists.tcl b/exists.tcl index 6533e49..bc10a06 100644 --- a/exists.tcl +++ b/exists.tcl @@ -16,18 +16,19 @@ proc exists::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc exists::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] exists::0_bang $self } proc exists::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] exists::0_bang $self } proc exists::0_bang {self} { variable ${self}::current_canvas variable ${self}::filename + pd::post "filename: $filename" if {[file pathtype $filename] eq "absolute"} { pd::outlet $self 0 float [file exists $filename] } else { @@ -38,11 +39,11 @@ proc exists::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc exists::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc exists::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class exists diff --git a/isdirectory.tcl b/isdirectory.tcl index 196597d..56396da 100644 --- a/isdirectory.tcl +++ b/isdirectory.tcl @@ -16,12 +16,12 @@ proc isdirectory::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc isdirectory::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] isdirectory::0_bang $self } proc isdirectory::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] isdirectory::0_bang $self } @@ -38,11 +38,11 @@ proc isdirectory::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc isdirectory::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc isdirectory::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class isdirectory diff --git a/isfile.tcl b/isfile.tcl index 07c290a..8e5638b 100644 --- a/isfile.tcl +++ b/isfile.tcl @@ -16,12 +16,12 @@ proc isfile::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc isfile::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] isfile::0_bang $self } proc isfile::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] isfile::0_bang $self } @@ -38,11 +38,11 @@ proc isfile::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc isfile::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc isfile::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class isfile diff --git a/mkdir.tcl b/mkdir.tcl index a0e8350..8a65a99 100644 --- a/mkdir.tcl +++ b/mkdir.tcl @@ -13,12 +13,12 @@ proc mkdir::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc mkdir::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] mkdir::0_bang $self } proc mkdir::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] mkdir::0_bang $self } @@ -35,11 +35,11 @@ proc mkdir::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc mkdir::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc mkdir::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class mkdir diff --git a/owned.tcl b/owned.tcl index 0a5f9b0..32c76ce 100644 --- a/owned.tcl +++ b/owned.tcl @@ -16,12 +16,12 @@ proc owned::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc owned::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] owned::0_bang $self } proc owned::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] owned::0_bang $self } @@ -38,11 +38,11 @@ proc owned::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc owned::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc owned::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class owned diff --git a/readable.tcl b/readable.tcl index 6b98449..f433111 100644 --- a/readable.tcl +++ b/readable.tcl @@ -16,12 +16,12 @@ proc readable::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc readable::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] readable::0_bang $self } proc readable::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] readable::0_bang $self } @@ -38,11 +38,11 @@ proc readable::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc readable::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc readable::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class readable diff --git a/tclfile.tcl b/tclfile.tcl index 7700a5d..61db3f2 100644 --- a/tclfile.tcl +++ b/tclfile.tcl @@ -1,3 +1,4 @@ + package require Tclpd 0.2.3 package provide tclfile 0.1 @@ -12,3 +13,22 @@ proc tclfile::make_symbol {argslist} { } return $output } + +# expand things like ~ $HOME $ProgramFiles +proc tclfile::expand_vars {filename} { + set sub $filename + foreach var [regexp -all -inline -- {\$\w+} $filename] { + regexp -- {\$(\w+)} $var -> varname + if {[catch {set got $::env($varname)} fid]} { + #puts stderr "caught $fid" + } else { + set sub [string map [list "\$$varname" $got \{ "" \} ""] $filename] + # TODO this should really be a regex that properly + # recognizes {} around the symbol as separate from just {} + # used in a filename. But first, Pd will need a full + # escaping mechanism so it can allow {} + #set sub [regsub "\(.+\)HOME\(.+\)" $sub "==\1==$got==\2=="] + } + } + return $sub +} diff --git a/writable.tcl b/writable.tcl index 647ea26..983098d 100644 --- a/writable.tcl +++ b/writable.tcl @@ -16,12 +16,12 @@ proc writable::constructor {self args} { # HOT inlet -------------------------------------------------------------------- proc writable::0_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] writable::0_bang $self } proc writable::0_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] writable::0_bang $self } @@ -38,11 +38,11 @@ proc writable::0_bang {self} { # COLD inlet ------------------------------------------------------------------- proc writable::1_symbol {self args} { - variable ${self}::filename [pd::arg 0 symbol] + variable ${self}::filename [tclfile::expand_vars [pd::arg 0 symbol]] } proc writable::1_anything {self args} { - variable ${self}::filename [tclfile::make_symbol $args] + variable ${self}::filename [tclfile::expand_vars [tclfile::make_symbol $args]] } pd::class writable -- cgit v1.2.1