[PD-cvs] pd/src desire.tk,1.1.2.600.2.403,1.1.2.600.2.404

[Mathieu Bouchard]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27532

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
new pd format parser (rewrote proc pd_mess_split)


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.403
retrieving revision 1.1.2.600.2.404
diff -C2 -d -r1.1.2.600.2.403 -r1.1.2.600.2.404
*** desire.tk	20 Aug 2007 05:25:32 -0000	1.1.2.600.2.403
--- desire.tk	20 Aug 2007 07:56:46 -0000	1.1.2.600.2.404
***************
*** 1030,1040 ****
  after 1000 pd_connect
  
! if {$cmdline(port)} {
  	set server_port $cmdline(port)
  	# and then do nothing...
! } elseif {$cmdline(valgrind)} {
  	#exec valgrind --tool=memcheck $cmdline(server) -guiport $server_port &
  	exec valgrind --tool=memcheck --gen-suppressions=all --suppressions=valgrind3.supp $cmdline(server) -guiport $server_port &
! } else {
      if {$cmdline(gdb)} {
  	if {$cmdline(console) && $cmdline(gdbconsole)} {
--- 1030,1041 ----
  after 1000 pd_connect
  
! after 0 {
!   if {$cmdline(port)} {
  	set server_port $cmdline(port)
  	# and then do nothing...
!   } elseif {$cmdline(valgrind)} {
  	#exec valgrind --tool=memcheck $cmdline(server) -guiport $server_port &
  	exec valgrind --tool=memcheck --gen-suppressions=all --suppressions=valgrind3.supp $cmdline(server) -guiport $server_port &
!   } else {
      if {$cmdline(gdb)} {
  	if {$cmdline(console) && $cmdline(gdbconsole)} {
***************
*** 1054,1057 ****
--- 1055,1059 ----
  	exec $cmdline(server) -guiport $server_port &
      }
+   }
  }
  
***************
*** 5443,5451 ****
  
  proc change_2 {self mess} {
- 	set mess [split $mess]
  	set isnew [expr ![info exists ::_($self:_class)]]
  	switch -- [lindex $mess 0] {
  		"#N" {if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}}
! 		"#X" { # YOU CAN'T USE LINDEX YOU DUMMY
  			set i 1
  			# would it be possible to merge floatatom,symbolatom as gatom ?
--- 5445,5452 ----
  
  proc change_2 {self mess} {
  	set isnew [expr ![info exists ::_($self:_class)]]
  	switch -- [lindex $mess 0] {
  		"#N" {if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}}
! 		"#X" {
  			set i 1
  			# would it be possible to merge floatatom,symbolatom as gatom ?
***************
*** 5478,5482 ****
  			#post "#V: $mess"
  		}
! 		default {if {$mess != ""} {error "what you say? ($mess)"}}
  	}
  }
--- 5479,5483 ----
  			#post "#V: $mess"
  		}
! 		default {if {$mess != ""} {error "what you say? «[lindex $mess 0]» in «$mess»"}}
  	}
  }
***************
*** 5487,5509 ****
  #}
  
! # split at message boundaries.
! # \n is wiped, then that character is reused temporarily to mean a quoted semicolon.
! # BUG: this is wrong because then \\; gets parsed wrong.
! proc pd_mess_split {e} {
  	set r {}
! 	set m {}
! 	regsub -all "\n" $e " " y
! 	regsub -all {\\;} $y "\n" z
! 	foreach mess [split $z ";"] {
! 		regsub -all "\n" $mess "\\;" mess
! 		set mess [string trimleft $mess]
! 		if {$mess != ""} {lappend r $mess}
  	}
  	return $r
  }
  
! # split at atom boundaries.
! proc pd_atom_split {e} {
! 	# huh...
  }
  
--- 5488,5536 ----
  #}
  
! # split at message boundaries and atom boundaries, returning a list of lists of atoms.
! # spaces    get  temporary value \x01
! # A_SEMI    gets temporary value \x02
! # backslash gets temporary value \x03
! # A_COMMA is not handled yet
! proc pd_mess_split {s} {
! 	set s [regsub -all {\\\\} $s "\x03"]
! 	set s [regsub -all {(^|[^\\]);}          $s "\\1\x02"]
! 	set s [regsub -all {(^|[^\\])[\s\n]+}    $s "\\1\x01"]
! 	set s [regsub -all {^\n}                 $s "\x01"] ;# oops
! 	set s [regsub -all {(^|[^\\])\\([\\; ])} $s "\\1\\2"]
! 	set s [regsub -all \x03 $s \\]
  	set r {}
! 	foreach m [split $s \x02] {
! 		set m [regsub -all "\x01+" $m "\x01"]
! 		set m [regsub -all "^\x01" $m ""]
! 		set t [split $m \x01]
! 		lappend r $t
  	}
  	return $r
  }
  
! proc canonical_list {list} {
! 	set r {}
! 	foreach e $list {lappend r $e}
! 	return $r
! }
! 
! proc pd_mess_split_want== {a b} {
! 	set b [canonical_list $b]
! 	set c [pd_mess_split $a]
! 	if {[string compare $c $b]} {
! 		puts "[VTred]string     «$a»\nparses to  «$c»\ninstead of «$b»[VTgrey]"
! 	} else {
! 		puts "[VTgreen]string     «$a» OK[VTgrey]"
! 	}
! }
! 
! if 0 {
! 	pd_mess_split_want== {foo;bar;baz;a\;;b\\;c\\\;;d\\\\;e} {foo bar baz {{a;}} {b\\} {{c\;}} {{d\\}} e}
! 	pd_mess_split_want== {foo\ bar} {{{foo bar}}}
! 	pd_mess_split_want== {foo \  bar\ foo\ bar foo} {{foo { } {bar foo bar} foo}}
! 	pd_mess_split_want== {\\ \\\\ \\\\\\ \ \\\ \\\\\ one} [list [list "\\" "\\\\" "\\\\\\" "\ \\\ \\\\\ one"]]
! 	pd_mess_split_want== "\n  \n   \n  foo" foo
! 	exit
  }