TclDebugger/src/location.tcl

   1 # The Tcl debugger for Speare code editor.
   2 # Copyright (c) 1998-2000 Ajuba Solutions
   3 # Copyright (c) 2019 sevenuc.com. All rights reserved.
   4 #
   5 # THIS FILE IS PART OF SPEARE CODE EDITOR. WITHOUT THE
   6 # WRITTEN PERMISSION OF THE AUTHOR THIS FILE MAY NOT
   7 # BE USED FOR ANY COMMERCIAL PRODUCT.
   8 #
   9 # More info:
  10 #    http://sevenuc.com/en/Speare.html
  11 # Contact:
  12 #    Sevenuc support <info@sevenuc.com>
  13 # Issue report and requests pull:
  14 #    https://github.com/chengdu/Speare
  15
  16
  17 package provide loc 1.0
  18 namespace eval loc {
  19     # location data type --
  20     #
  21     #   A location encapsulates the state associated with a range of
  22     #   bytes within a block of code.  Each location is represented by
  23     #   a Tcl list of the form {block line range}.  The block is
  24     #   the block identifier for the code that contains the range.
  25     #   The line is the line number of the first byte in the range.
  26     #   The range indicates the extent of the location within the
  27     #   block in a form suitable for use with the parser.
  28
  29 }
  30 # end namespace loc
  31
  32
  33 # loc::getBlock --
  34 #
  35 #       Returns the block that contains the given location.
  36 #       If no such location exists, an error is generated.
  37 #
  38 # Arguments:
  39 #       location        The code location whose block is returned.
  40 #
  41 # Results:
  42 #       Returns the block that contains the given location.
  43
  44 proc loc::getBlock {location} {
  45     return [lindex $location 0]
  46 }
  47
  48
  49 # loc::getLine --
  50 #
  51 #       Returns the line number for the start of the location as an
  52 #       offset from the beginning of the block.  If no such location
  53 #       exists, an error is generated.
  54 #
  55 # Arguments:
  56 #       location        The code location whose line number is returned.
  57 #
  58 # Results:
  59 #       Returns the line number for the start of the location as an
  60 #       offset from the beginning of the block.
  61
  62 proc loc::getLine {location} {
  63     return [lindex $location 1]
  64 }
  65
  66 # loc::getRange --
  67 #
  68 #       Returns the range for the given location in a form suitable
  69 #       for use with the parser interface.  If no such location
  70 #       exists, an error is generated.
  71 #
  72 # Arguments:
  73 #       location        The code location whose range is returned.
  74 #
  75 # Results:
  76 #       Returns the range for the given location in a form suitable
  77 #       for use with the parser interface.
  78
  79 proc loc::getRange {location} {
  80     variable locArray
  81
  82     return [lindex $location 2]
  83 }
  84
  85 # loc::makeLocation --
  86 #
  87 #       Creates a new location based on the block, range, and line values.
  88 #       If the block is invalid, an error is generated.  Either the range
  89 #       or line must be non-empty, otherwise an error is generated.
  90 #
  91 # Arguments:
  92 #       block   The block containing the location to be created.
  93 #       line    The line number of the beginning of the location.
  94 #       range   Optional. A pair of the location's start and length
  95 #               byte values.
  96 #
  97 # Results:
  98 #       Returns a unique location identifier.
  99
 100 proc loc::makeLocation {block line {range {}}} {
 101     return [list $block $line $range]
 102 }
 103
 104 # loc::match --
 105 #
 106 #       Compare two locations to see if the second location is a match
 107 #       for the first location.  If the first location has no range, then
 108 #       it will match all locations with the same line number.  If the
 109 #       first location has no line number, then it will match all locations
 110 #       with the same block.  Otherwise it will only match locations that
 111 #       have exactly the same block, line and range.
 112 #
 113 # Arguments:
 114 #       pattern         The location pattern.
 115 #       location        The location to test.
 116 #
 117 # Results:
 118 #       Returns 1 if the location matches the pattern.
 119
 120 proc loc::match {pattern location} {
 121     # Check for null line.
 122     if {[lindex $pattern 1] == ""} {
 123         return [expr {[string compare [lindex $pattern 0] \
 124                 [lindex $location 0]] == 0}]
 125     }
 126     # Check for null range.
 127     if {[lindex $pattern 2] == ""} {
 128         return [expr {[string compare [lrange $pattern 0 1] \
 129                 [lrange $location 0 1]] == 0}]
 130     }
 131     # Compare the full location.
 132     return [expr {[string compare $pattern $location] == 0}]
 133 }
 134