File: token.tcl

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (94 lines) | stat: -rw-r--r-- 2,359 bytes parent folder | download | duplicates (5)
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
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2013 Andreas Kupries, BSD licensed

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require fileutil ;# cat

# # ## ### ##### ######## ############# #####################
## API setup
#

namespace eval ::string::token {
    namespace export chomp file text
    namespace ensemble create
}

## NOTE: We are placing the 'token' ensemble command into the Tcl
##       core's builtin 'string' ensemble.

apply {{} {
    set map [namespace ensemble configure ::string -map]
    dict set map token ::string::token
    namespace ensemble configure ::string -map $map
    return
}}

# # ## ### ##### ######## ############# #####################
## API

proc ::string::token::file {map path args} {
    return [text $map [fileutil::cat {*}$args $path]]
}

proc ::string::token::text {map text} {
    # map = dict (regex -> label)
    #   note! order is important, most specific to most general.

    # result = list (token)
    # where
    #   token = list(label start-index end-index)

    set start  0
    set result {}

    # status values:
    #  0: no token found, abort
    #  1: token found, continue
    #  2: no token found, end of string reached, stop, ok.
    set status 1
    while {$status == 1} {
	set status [chomp $map start $text result]
    }
    if {$status == 0} {
	return -code error \
	    -errorcode {STRING TOKEN BAD CHARACTER} \
	    "Unexpected character '[string index $text $start]' at offset $start"
    }
    return $result
}

# # ## ### ##### ######## ############# #####################
## Internal, helpers.

proc ::string::token::chomp {map sv text rv} {
    upvar 1 $sv start $rv result

    # Stop when trying to match after the end of the string.
    if {$text eq {}} {return 2}
    if {$start >= [string length $text]} {return 2}

    #puts |$start||[string range $text $start end]||$result|

    foreach {pattern label} $map {
	if {![regexp -start $start -indices -- \\A($pattern) $text -> range]} continue

	lappend result [list $label {*}$range]
	lassign $range a e

	#puts MATCH|$pattern|[string range $text $a $e]|

	set start $e
	incr start
	return 1
    }
    return 0
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide string::token 1
return