-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathoc_object-1.0.tm
137 lines (101 loc) · 3.36 KB
/
oc_object-1.0.tm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
#===============================================================================
# oc_object-1.0.tm
#
# "object" as first argument of calls.
#
# Copyright Sam O'Connor 2014
# Licenced for use under the same terms as Tcl 8.6. See:
# http://core.tcl.tk/tcl/artifact/537ba3f664b958496ab51849e23d7f564342014b
# http://github.com/tcltk/tcl/raw/core_8_6_1/license.terms
#===============================================================================
package provide oc_object 1.0
package require oclib::oc_string
package require oclib::oc_proc
# Where is the "object" in the argument list of common procs?
namespace eval ::oc::object {
set position {
{string compare} end-1
{string equal} end-1
{string first} 2
{string is} end
{string last} 2
{string map} end
{string match} end
{string subst} end
compare end-1
equal end-1
first 1
is end
last 1
map end
match end
subst end
{dict for} end-1
{dict map} end-1
{dict update} end-1
{dict with} end-1
{binary decode} end
{binary encode} end
decode end
encode end
}
}
proc object_position {command {subcommand {}}} {
For "command" and optional "subcommand",
Determine the argument-list index of the "object" of the command.
} example {
[object_position string first] eq 2
[object_position string map] eq "end"
[object_position string compare] eq "end-1"
[object_position lindex] eq 0
[object_position llength] eq 0
} do {
set key $command
set i 0
if {[namespace ensemble exists $command]} {
set key [list $command $subcommand]
set i 1
}
if {[dict exists $::oc::object::position $key]} {
set i [dict get $::oc::object::position $key]
}
return $i
}
proc object_call {object command args} {
Call "command" on "object" (with optional "args").
} example {
[object_call "Hello!" string trim !] eq [string trim "Hello!" !]
[object_call "Foo" equal -nocase "foo"] eq [equal -nocase "Foo" "foo"]
} do {
set i [object_position $command [lindex $args 0]]
uplevel [list $command {*}[linsert $args $i $object]]
} alias {
.
}
# Force loading of the "clock" ensemble used in the example below...
clock seconds
proc object_pipeline {object args} {
Object Pipeline.
"args" is a "|" delimited pipeline of commands.
"object" is passed as the 1st argument of the 1st command.
The result of the 1st command is passed to the 2nd command, etc...
} example {
[join [lrange [split [tolower "A-B-C"] -] 1 end] -] eq "b-c"
[: "A-B-C" | tolower | split - | lrange 1 end | join -] eq "b-c"
[: 0 | clock format -gmt yes | clock scan] == 0
[: "Hello" tolower] eq "hello"
} do {
if {[llength $args] == 1} {
lassign $args args
}
foreach cmd [lrm_empty [lsplit $args |]] {
set object [uplevel [list object_call $object {*}$cmd]]
}
return $object
} alias {
:
with
}
#===============================================================================
# End of file.
#===============================================================================