Как создать процедуру Tcl с опциями?

Разбор сложных аргументов можно выполнить с помощью cmdline package, который является частью Tcllib. Ключевой командой является ::cmdline::getoptions, которая извлекает параметры из переменной и возвращает словарь, описывающий их. Он также изменяет переменную, чтобы она содержала только оставшиеся аргументы.

package require cmdline
proc arith args {
    set options {
        {op.arg "add" "operation to apply (defaults to 'add')"}
    }
    array set parsed [::cmdline::getoptions args $options]
    if {[llength $args] != 2} {
        return -code error "wrong # args: must be \"arith ?-op operation? x y\""
    }
    switch $parsed(op) {
        add {return [::tcl::mathop::+ {*}$args]}
        sub {return [::tcl::mathop::- {*}$args]}
        default {
            return -code error "Unknown -op \"$parsed(op)\": must be add or sub"
        }
    }
}

Демонстрация использования (включая некоторые случаи ошибок):

% arith 
wrong # args: must be "arith ?-op operation? x y"
% arith 2 3
5
% arith -op sub 2 3
-1
% arith -op mult 2 3
Unknown -op "mult": must be add or sub

Главное, что нужно знать, это то, что дескриптор параметров принимает имена параметров без начального - и с .arg в конце, если вы хотите, чтобы аргумент передавался как хорошо.

Когда дело доходит до опций, рекомендуется использовать четное количество аргументов.

 -op add -values {10 5}
 -op sub -values {10 5}

При этом вы можете поместить аргументы в массив как,

array set aArgs $args

где args - это не что иное, как аргументы, переданные процедуре.

proc arith {args} {
        if {[catch {array set aArgs $args} err]} {
            puts "Error : $err"
             return 0
        }
    if {![info exists aArgs(-op)] || ![info exists aArgs(-values)] || [llength $aArgs(-values)]!=2} {
        puts "Please pass valid args"
        return 0
    }
    set x [lindex $aArgs(-values) 0]
    set y [lindex $aArgs(-values) 1]
    switch $aArgs(-op) { 
        "add" { 
            puts [expr {$x+$y}]
        }
        "sub" { 
            puts [expr {$x-$y}]     
        }
    }
}
arith -op add -values {10 5}

В этом примере ... я предполагаю, что оператор является первым или последним вариантом. Значение будет -add или add. Просто внесите изменения.

В вычислениях есть оптимизация ... для использования lrange и :: mathop ::.

proc arith args {
    if {[llength $args] != 3} {
        return -code error "wrong # args: must be \"arith ?-op operation? x y\""
    }
    set isadd [lsearch $args add]
    set issub [lsearch $args sub]
    if {$isadd != -1 && $issub == -1} {
        return [expr [lindex $args 1] + [lindex $args [expr $isadd == 0 ? 2: 0]]]
    }
    if {$issub != -1 && $isadd == -1} {
        return [expr [lindex $args [expr $issub == 0 ? 1: 0]] - [lindex $args [expr $issub == 0 ? 2: 1]]]
    }
    return -code error "Unknown -op must be add or sub"
}

пример:

#arith add 1 2 3
#arith add sub 2
puts [arith add 1 2]
puts [arith 1 2 add]

puts [arith sub 1 2]
puts [arith 1 2 sub]

Два примера ошибок были закомментированы, потому что вместо этого мне нужна уловка ... но это действительно зависит от общей картины и того, насколько многоразовой она должна быть.

proc arith args {
    if {[llength $args] != 3} {
        return -code error "wrong # args: must be \"arith ?-op operation? x y\""
    }
    set isadd [lsearch $args -add]
    set issub [lsearch $args -sub]
    if {$isadd != -1 && $issub == -1} {
        return [::tcl::mathop::+ {*}[lrange $args [expr $isadd == 0] [expr ($isadd == 0) + 1]]]
    }
    if {$issub != -1 && $isadd == -1} {
        return [::tcl::mathop::- {*}[lrange $args [expr $issub == 0] [expr ($issub == 0) + 1]]]
    }
    return -code error "Unknown -op must be add or sub"
}