Taylor Venable avatar Taylor Venable committed ee1c492

Massive changes to eproc, moving further away from what procra used to be. This
API will constitute tcv::eproc 1.0 when it's ready.

Comments (0)

Files changed (2)

 ##                                                                            ##
 ################################################################################
 
-package require Tcl 8.4
+package require Tcl 8.5
 
 package provide tcv::eproc 1.0
 
 namespace eval ::tcv::eproc {
-    namespace export eproc
-
-    proc eproc {args} {
-        set name [lindex $args 0]
-        set script [lindex $args end]
-        set args [lrange $args 1 end-1]
-
+    proc eproc {name config script} {
         uplevel [list proc $name {args} [subst {
-            [namespace current]::xyzzy $name {*}[list $args]
+            [namespace current]::xyzzy $name [list $config]
             $script
         }]]
     }
 
-    proc xyzzy {name args} {
-        set nullary {}
-        set unary {}
-        set required {}
-        set optional {}
-        set rest {}
+    proc RenameFlagOpt {name} {
+        set name [regsub -- {^-+} $name ""]
+        set name [regsub -all -- {-([[:alpha:]])} $name [string toupper "\\1"]]
 
-        for {set i 0} {$i < [llength $args]} {incr i} {
-            switch -- [lindex $args $i] {
-                {-flags} -
-                {-opts} -
-                {-nullary} {
-                    set nullary [lindex $args [incr i]]
+        return $name
+    }
+
+    proc ParseFlags {args} {
+        set result {}
+
+        foreach arg $args {
+            set data [lassign $arg name]
+            set config [dict create varname [RenameFlagOpt $name] default false]
+
+            for {set i 0} {$i < [llength $data]} {incr i} {
+                switch -- [lindex $data $i] {
+                    "-varname" {
+                        dict set config varname [lindex $data [incr i]]
+                    }
+                    "-default" {
+                        dict set config default [lindex $data [incr i]]
+                    }
+                }
+            }
+            lappend result $name $config
+        }
+
+        return $result
+    }
+
+    proc ParseOpts {args} {
+        set result {}
+
+        foreach arg $args {
+            set data [lassign $arg name]
+            set config [dict create varname [RenameFlagOpt $name]]
+
+            for {set i 0} {$i < [llength $data]} {incr i} {
+                switch -- [lindex $data $i] {
+                    "-varname" {
+                        dict set config varname [lindex $data [incr i]]
+                    }
+                    "-default" {
+                        dict set config default [lindex $data [incr i]]
+                    }
+                }
+            }
+            lappend result $name $config
+        }
+
+        return $result
+    }
+
+    proc ParseArgs {args} {
+        set result {}
+
+        foreach arg $args {
+            set data [lassign $arg name]
+            lappend result $name
+        }
+
+        return $result
+    }
+
+    proc ParseOptargs {args} {
+        set result {}
+
+        foreach arg $args {
+            set data [lassign $arg name]
+            set config [dict create varname $name]
+
+            for {set i 0} {$i < [llength $data]} {incr i} {
+                switch -- [lindex $data $i] {
+                    "-default" {
+                        dict set config default [lindex $data [incr i]]
+                    }
+                }
+            }
+            lappend result $config
+        }
+
+        return $result
+    }
+
+    proc xyzzy {procName procConfig} {
+        # This is a somewhat complex data structure to store information about
+        # what kinds of arguments we're going to accept from the user. It uses
+        # a dictionary to bundle all the information together, to make it
+        # easier to manage. The whole thing has the following structure:
+        #
+        # -- dictionary --
+        #
+        # data {
+        #
+        #   -- dictionary --
+        #
+        #   flags {
+        #     [flagName] {
+        #       varname [flagName]
+        #       default false
+        #     }
+        #   }
+        #
+        #   -- dictionary --
+        #
+        #   opts {
+        #     [optName] {
+        #       varname [optName]
+        #       ? default ?
+        #     }
+        #   }
+        #
+        #   -- list of variable names --
+        #
+        #   args { [argName] ... }
+        #
+        #   -- list of dictionaries --
+        #
+        #   optargs { {
+        #     varname [optargName]
+        #     ? default ?
+        #   } ... }
+        #
+        #   rest [restName]
+        # }
+        #
+        # An appropriate internal structure is used depending on whether things
+        # will be looked up by name (flags and options) or by position (args
+        # and optargs).
+
+        set data [dict create flags {} opts {} args {} optargs {} rest ""]
+
+        for {set i 0} {$i < [llength $procConfig]} {incr i} {
+            set cmd [lindex $procConfig $i]
+
+            switch -- $cmd {
+                flag - flags {
+                    set flagConfigs [lindex $procConfig [incr i]]
+                    if {$cmd eq "flag"} { set flagConfigs [list $flagConfigs] }
+                    foreach {flagName flagConfig} [ParseFlags {*}$flagConfigs] {
+                        dict set data flags $flagName $flagConfig
+                    }
                 }
 
-                {-arg-flags} -
-                {-arg-opts} -
-                {-unary} {
-                    set unary [lindex $args [incr i]]
+                opt - opts {
+                    set optConfigs [lindex $procConfig [incr i]]
+                    if {$cmd eq "opt"} { set optConfigs [list $optConfigs] }
+                    foreach {optName optConfig} [ParseOpts {*}$optConfigs] {
+                        dict set data opts $optName $optConfig
+                    }
                 }
 
-                {-required} {
-                    set required [lindex $args [incr i]]
+                arg - args {
+                    set argConfigs [lindex $procConfig [incr i]]
+                    if {$cmd eq "arg"} { set argConfigs [list $argConfigs] }
+                    foreach argConfig [ParseArgs {*}$argConfigs] {
+                        dict lappend data args $argConfig
+                    }
                 }
 
-                {-optional} {
-                    set optional [lindex $args [incr i]]
+                optarg - optargs {
+                    set optargConfigs [lindex $procConfig [incr i]]
+                    if {$cmd eq "optarg"} { set optargConfigs [list $optargConfigs] }
+                    foreach optargConfig [ParseOptargs {*}$optargConfigs] {
+                        dict lappend data optargs $optargConfig
+                    }
                 }
 
-                {-rest} {
-                    set rest [lindex $args [incr i]]
+                rest {
+                    dict set data rest [lindex $procConfig [incr i]]
                 }
-                {default} {
-                    error "Unknown option: [lindex $args $i]"
+
+                default {
+                    error "Unknown option: $cmd"
                 }
             }
         }
 
-        unset args
-        upvar args args
-        uplevel [list set args/original $args]
+        # Go through all the flags and set their default values.
 
-        # Take all the non-argument flags, and if a default value was provided
-        # for them, initialize the flag variable to that. Otherwise, initialize
-        # the flag variable to false.
+        dict for {flag config} [dict get $data flags] {
+            uplevel set [dict get $config varname] [dict get $config default]
+        }
 
-        foreach flag $nullary {
-            if {[llength $flag] == 2} {
-                uplevel set [lindex $flag 0] [lindex $flag 1]
-            } else {
-                uplevel set $flag false
+        # Go through all the options and set their default values.
+
+        dict for {opt config} [dict get $data opts] {
+            if {[dict exists $config default]} {
+                uplevel set [dict get $config varname] [dict get $config default]
             }
         }
 
-        # Go through all the flags that take arguments, and set any default
-        # value that was provided.
+        # Go through all the optional arguments and set their default values.
 
-        foreach flag $unary {
-            if {[llength $flag] == 2} {
-                uplevel set [lindex $flag 0] [lindex $flag 1]
+        foreach {config} [dict get $data optargs] {
+            if {[dict exists $config default]} {
+                uplevel set [dict get $config varname] [dict get $config default]
             }
         }
 
+        upvar args args
+
         for {set i 0} {$i < [llength $args]} {incr i} {
-            set flag [lindex $args $i]
+            set thing [lindex $args $i]
 
-            if {$flag eq "--" || ![regexp {^-} $flag]} {
+            if {$thing eq "--" || ![regexp {^-} $thing]} {
                 break ;# stop processing arguments
             }
 
-            # Remove leading dash from option.
-            set flag [string range $flag 1 end]
-
-            set index [lsearch -index 0 $nullary $flag]
-            if {$index < 0} {
-                set index [lsearch -index 0 $unary $flag]
-                if {$index < 0} {
-                    error "$name: unrecognized argument: -$flag"
-                } elseif {$i + 1 == [llength $args]} {
-                    error "$name: flag requires an argument: -$flag"
-                } else {
-                    uplevel [list set $flag [lindex $args [incr i]]]
-                    continue
+            if {[dict exists $data flags $thing]} {
+                # The item is a flag.
+                set config [dict get $data flags $thing]
+                uplevel set [dict get $config varname] true
+            } elseif {[dict exists $data opts $thing]} {
+                # The item is an option.
+                set config [dict get $data opts $thing]
+                if {$i + 1 == [llength $args]} {
+                    error "$procName: option \"$thing\" requires an argument"
                 }
+                uplevel set [dict get $config varname] [lindex $args [incr i]]
             } else {
-                uplevel [list set $flag true]
+                error "$procName: unrecognized argument: $thing"
             }
         }
-        for {set i $i; set j 0} {$i < [llength $args] && $j < [llength $required]} {incr i; incr j} {
-            uplevel [list set [lindex $required $j] [lindex $args $i]]
+
+        for {set j 0} {$i < [llength $args] && $j < [llength [dict get $data args]]} {incr i; incr j} {
+            uplevel set [lindex [dict get $data args] $j] [lindex $args $i]
         }
 
-        if {$j < [llength $required]} {
-            error "$name: missing required arguments: [lrange $required $j end]"
-        }
-        for {set i $i; set j 0} {$i < [llength $args] && $j < [llength $optional]} {incr i; incr j} {
-            uplevel [list set [lindex $optional $j] [lindex $args $i]]
+        # Make sure all required arguments were provided.
+
+        if {$j < [llength [dict get $data args]]} {
+            error "$procName: missing required arguments: [lrange [dict get $data args] $j end]"
         }
 
-        if {$i < [llength $args] && [info exists rest]} {
-            uplevel [list set $rest [lrange $args $i end]]
+        for {set j 0} {$i < [llength $args] && $j < [llength [dict get $data optargs]]} {incr i; incr j} {
+            set config [lindex [dict get $data optargs] $j]
+            uplevel set [dict get $config varname] [lindex $args $i]
         }
 
-        set args [lrange $args $i end]
+        # Assign the leftover arguments.
+
+        if {$i < [llength $args] && [dict get $data rest] ne ""} {
+            uplevel set [dict get $data rest] [lrange $args $i end]
+        }
     }
 }
-
-interp alias {} eproc {} ::tcv::eproc::eproc
 #!/usr/bin/env tclsh
 
-lappend auto_path [file normalize [pwd]]
-package require procra
+lappend auto_path [file normalize [file join [pwd] .. src]]
+package require tcv::eproc
 
-procra::procra foo -nullary {a b c} -unary {d e f} -required {g h i} -optional {j k l} -rest m {
+::tcv::eproc::eproc foo {
+    flags   {-a -b}
+    flag    {-c -default true}
+
+    opts    {-d -e}
+    opt     {-f -default 42}
+
+    args    {g h i}
+    optargs {j k l}
+} {
     puts "a = $a"
     puts "b = $b"
     puts "c = $c"
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.