00001 # TKE - Advanced Programmer's Editor 00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com) 00003 # 00004 # This program is free software; you can redistribute it and/or modify 00005 # it under the terms of the GNU General Public License as published by 00006 # the Free Software Foundation; either version 2 of the License, or 00007 # (at your option) any later version. 00008 # 00009 # This program is distributed in the hope that it will be useful, 00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of 00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00012 # GNU General Public License for more details. 00013 # 00014 # You should have received a copy of the GNU General Public License along 00015 # with this program; if not, write to the Free Software Foundation, Inc., 00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 00017 00018 ###################################################################### 00019 # Name: markers.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 08/05/2013 00022 # Brief: Namespace to support markers. 00023 ###################################################################### 00024 00025 namespace eval markers { 00026 00027 variable curr_marker 0 00028 00029 array set markers {} 00030 00031 ###################################################################### 00032 # Adds a new marker for the given index. Returns 1 if the marker was 00033 # added; otherwise, returns 0. 00034 proc add {tab type value {name ""}} { 00035 00036 variable markers 00037 variable curr_marker 00038 00039 # If the name wasn't specified, ask the user 00040 if {($name eq "") && ![gui::get_user_response [msgcat::mc "Marker name:"] name]} { 00041 return 0 00042 } 00043 00044 # Add the marker 00045 if {$name eq ""} { 00046 set name "Marker-[incr curr_marker]" 00047 } elseif {[regexp {^Marker-(\d+)$} $name -> id] && ($curr_marker <= $id)} { 00048 set curr_marker $id 00049 } 00050 00051 # Set the marker 00052 set markers($tab,$name) [list $type $value] 00053 00054 return 1 00055 00056 } 00057 00058 ###################################################################### 00059 # Iterate through all markers that do not have a tag associated with 00060 # them and set them (or delete them if a tag cannot be created). 00061 proc tagify {tab} { 00062 00063 variable markers 00064 00065 foreach key [array names markers $tab,*] { 00066 lassign $markers($key) type value 00067 gui::get_info $tab tab txt 00068 if {$type eq "line"} { 00069 if {[set tag [ctext::linemapSetMark $txt $value]] ne ""} { 00070 set markers($key) [list tag $tag] 00071 } 00072 } 00073 } 00074 00075 } 00076 00077 ###################################################################### 00078 # Deletes the marker of the given name, if it exists. 00079 proc delete_by_name {tab name} { 00080 00081 variable markers 00082 00083 set key "$tab,$name" 00084 00085 if {[info exists markers($key)]} { 00086 unset markers($key) 00087 } 00088 00089 } 00090 00091 ###################################################################### 00092 # Deletes the marker of the given tag, if it exists. 00093 proc delete_by_tag {tab tag} { 00094 00095 variable markers 00096 00097 foreach {key data} [array get markers $tab,*] { 00098 if {$data eq [list tag $tag]} { 00099 unset markers($key) 00100 } 00101 } 00102 00103 } 00104 00105 ###################################################################### 00106 # Deletes all markers at the given line. 00107 proc delete_by_line {tab line} { 00108 00109 variable markers 00110 00111 foreach key [array names markers $tab,*] { 00112 if {$line eq [get_index_by_key $key]} { 00113 unset markers($key) 00114 } 00115 } 00116 00117 } 00118 00119 ###################################################################### 00120 # Returns all of the marker names. 00121 proc get_markers {{tab "*"}} { 00122 00123 variable markers 00124 00125 set data [list] 00126 00127 # Get the list of all names 00128 foreach key [array names markers $tab,*] { 00129 if {[set index [get_index_by_key $key]] ne ""} { 00130 set name [join [lassign [split $key ,] tab] ,] 00131 lappend data $name $tab $index 00132 } 00133 } 00134 00135 return $data 00136 00137 } 00138 00139 ###################################################################### 00140 # Returns the index of the given marker key. 00141 proc get_index_by_key {key {tab ""}} { 00142 00143 variable markers 00144 00145 lassign $markers($key) type value 00146 00147 gui::get_info [lindex [split $key ,] 0] tab txt 00148 00149 if {$type eq "line"} { 00150 return $value 00151 } elseif {[set index [lindex [$txt tag ranges $value] 0]] ne ""} { 00152 return [lindex [split $index .] 0] 00153 } else { 00154 return "" 00155 } 00156 00157 } 00158 00159 ###################################################################### 00160 # Returns the index for the given marker name. 00161 proc get_index {tab name} { 00162 00163 variable markers 00164 00165 set key "$tab,$name" 00166 00167 if {[info exists markers($key)]} { 00168 return [get_index_by_key $key].0 00169 } else { 00170 return "" 00171 } 00172 00173 } 00174 00175 ###################################################################### 00176 # Returns the marked lines. 00177 proc get_positions {tab} { 00178 00179 variable markers 00180 00181 gui::get_info $tab tab txt 00182 00183 set pos [list] 00184 set lines [$txt count -lines 1.0 end] 00185 set color [theme::get_value syntax marker] 00186 00187 foreach key [array names markers $tab,*] { 00188 if {[set start_line [get_index_by_key $key]] ne ""} { 00189 lappend pos [expr $start_line.0 / $lines] [expr $start_line.0 / $lines] $color 00190 } 00191 } 00192 00193 return $pos 00194 00195 } 00196 00197 ###################################################################### 00198 # Returns true if a marker exists at the current line. 00199 proc exists_at_line {tab line} { 00200 00201 variable markers 00202 00203 foreach key [array names markers $tab,*] { 00204 if {$line eq [get_index_by_key $key]} { 00205 return 1 00206 } 00207 } 00208 00209 return 0 00210 00211 } 00212 00213 ###################################################################### 00214 # Returns true if one or more markers exist in the specified text widget. 00215 proc exists {tab} { 00216 00217 variable markers 00218 00219 return [expr [llength [array names markers $tab,*]] > 0] 00220 00221 } 00222 00223 }