mirror of
				https://github.com/KevinMidboe/linguist.git
				synced 2025-10-29 17:50:22 +00:00 
			
		
		
		
	Move the extension-less sample scripts in a filenames/ subdir
This commit is contained in:
		
							
								
								
									
										63
									
								
								samples/Tcl/filenames/owh
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										63
									
								
								samples/Tcl/filenames/owh
									
									
									
									
									
										Executable file
									
								
							@@ -0,0 +1,63 @@
 | 
			
		||||
#!/usr/bin/env tclsh
 | 
			
		||||
# http://wiki.tcl.tk/906
 | 
			
		||||
 | 
			
		||||
if {[llength $argv] < 1} {
 | 
			
		||||
   puts "usage: owh ?init? body ?exit?
 | 
			
		||||
   performs body (in Tcl) for each line (\$0) from stdin
 | 
			
		||||
   owh: Ousterhout - Welch - Hobbs, to name a few"
 | 
			
		||||
   exit -1
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
proc awksplit {text {split default}} {
 | 
			
		||||
    set no 0
 | 
			
		||||
    if {$split eq "default"} {
 | 
			
		||||
        set t {}
 | 
			
		||||
        foreach string [split $text] {
 | 
			
		||||
            if {$string ne {}} {
 | 
			
		||||
                lappend t $string
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    } else {
 | 
			
		||||
        set t [list $text $split]
 | 
			
		||||
    }
 | 
			
		||||
    uplevel 1 [list set NF [llength $t]]
 | 
			
		||||
    foreach i $t {uplevel 1 [list set [incr no] $i]}
 | 
			
		||||
    uplevel 1 {set 0 {};trace variable 0 ru 0}
 | 
			
		||||
}
 | 
			
		||||
proc 0 {_name index op} {
 | 
			
		||||
    switch $op {
 | 
			
		||||
        r {
 | 
			
		||||
            uplevel {
 | 
			
		||||
                set 0 {}
 | 
			
		||||
                for {set i 1} {$i <= $NF} {incr i} {lappend 0 [set $i]}
 | 
			
		||||
                set 0 [join $0 $OFS]
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        u {rename 0 {} ;# leave no traces of the trace..}
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
proc print s {if {[catch {puts $s}]} exit} ;# good for broken pipe
 | 
			
		||||
 | 
			
		||||
set FS default
 | 
			
		||||
set OFS { }
 | 
			
		||||
 | 
			
		||||
if {[llength $argv] > 1} {
 | 
			
		||||
   eval [lindex $argv 0]
 | 
			
		||||
   set _body [lindex $argv 1] ;# strip outer braces
 | 
			
		||||
   set _exit [lindex $argv 2]
 | 
			
		||||
} else {
 | 
			
		||||
   set _body [lindex $argv 0] ;# strip outer braces
 | 
			
		||||
   set _exit {}
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
set NR 1
 | 
			
		||||
while 1 {
 | 
			
		||||
   gets stdin line
 | 
			
		||||
   if {[eof stdin]} break
 | 
			
		||||
   awksplit $line $FS
 | 
			
		||||
   eval $_body
 | 
			
		||||
   incr NR
 | 
			
		||||
}
 | 
			
		||||
set res [eval $_exit]
 | 
			
		||||
if {[string length $res]} {puts $res}
 | 
			
		||||
		Reference in New Issue
	
	Block a user