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: emmet.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 02/24/2016 00022 # Brief: Namespace containing Emmet-related functionality. 00023 ###################################################################### 00024 00025 source [file join $::tke_dir lib emmet_parser.tcl] 00026 source [file join $::tke_dir lib emmet_css.tcl] 00027 00028 namespace eval emmet { 00029 00030 variable custom_file 00031 variable customizations 00032 00033 array set data { 00034 tag {(.*)(<\/?[\w:-]+(?:\s+[\w:-]+(?:\s*=\s*(?:(?:".*?")|(?:'.*?')|[^>\s]+))?)*\s*(\/?)>)} 00035 brackets {(.*?)(\[.*?\]|\{.*?\})} 00036 space {(.*?)(\s+)} 00037 tagname {[a-zA-Z0-9_:-]+} 00038 other_map {"100" "001" "001" "100"} 00039 dir_map {"100" "next" "001" "prev"} 00040 index_map {"100" 1 "001" 0} 00041 } 00042 00043 # Create the custom filename 00044 set custom_file [file join $::tke_home emmet.tkedat] 00045 00046 ###################################################################### 00047 # Initializes Emmet aliases. 00048 proc load {} { 00049 00050 variable custom_file 00051 00052 # Copy the Emmet customization file from the TKE installation directory to the 00053 # user's home directory. 00054 if {![file exists $custom_file]} { 00055 file copy [file join $::tke_dir data emmet.tkedat] $custom_file 00056 } 00057 00058 # Load the user's custom alias file 00059 load_custom_aliases 00060 00061 } 00062 00063 ###################################################################### 00064 # Returns a three element list containing the snippet text, starting and ending 00065 # position of that text. 00066 proc get_snippet_text_pos {} { 00067 00068 variable data 00069 00070 # Get the current text widget 00071 set txt [gui::current_txt] 00072 00073 # Get the current line and column numbers 00074 lassign [split [$txt index insert] .] line endcol 00075 00076 # Get the current line 00077 set str [$txt get "insert linestart" insert] 00078 00079 # Get the prespace of the current line 00080 regexp {^([ \t]*)} $str -> prespace 00081 00082 # If we have a tag, ignore all text prior to it 00083 set startcol [expr {[regexp $data(tag) $str match] ? [string length $match] : 0}] 00084 00085 # Gather the positions of any square or curly brackets in the left-over area 00086 foreach key [list brackets space] { 00087 set pos($key) [list] 00088 set col $startcol 00089 while {[regexp -start $col -- $data($key) $str match pre]} { 00090 lappend pos($key) [expr $col + [string length $pre]] [expr $col + [string length $match]] 00091 set col [lindex $pos($key) end] 00092 } 00093 } 00094 00095 # See if there is a space which does not exist within a square or curly brace 00096 foreach {endpos startpos} [lreverse $pos(space)] { 00097 if {[expr [lsearch [lsort -integer [concat $pos(brackets) $endpos]] $endpos] % 2] == 0} { 00098 return [list [string range $str $endpos end] $line.$endpos $line.$endcol $prespace] 00099 } 00100 } 00101 00102 return [list [string range $str $startcol end] $line.$startcol $line.$endcol $prespace] 00103 00104 } 00105 00106 ###################################################################### 00107 # Parses the current Emmet snippet found in the current editing buffer. 00108 # Returns a three element list containing the generated code, the 00109 # starting index of the snippet and the ending index of the snippet. 00110 proc expand_abbreviation {} { 00111 00112 set txt [gui::current_txt] 00113 00114 # Get the language of the current insertion cursor 00115 if {[set lang [ctext::getLang $txt insert]] eq ""} { 00116 set lang [syntax::get_language $txt] 00117 } 00118 00119 # If the current language is CSS, translate the abbreviation as such 00120 if {$lang eq "CSS"} { 00121 00122 # Get the abbreviation text, translate it and insert it back into the text 00123 if {[regexp {(\S+)$} [$txt get "insert linestart" insert] -> abbr]} { 00124 if {![catch { emmet_css::parse $abbr } str]} { 00125 snippets::insert_snippet_into_current $str -delrange [list "insert-[string length $abbr]c" insert] -separator 0 00126 } 00127 } 00128 00129 } else { 00130 00131 # Find the snippet text 00132 lassign [get_snippet_text_pos] str startpos endpos prespace 00133 00134 # Parse the snippet and if no error, insert the resulting string 00135 if {![catch { ::parse_emmet $str $prespace } str]} { 00136 snippets::insert_snippet_into_current $str -delrange [list $startpos $endpos] -separator 0 00137 } 00138 00139 } 00140 00141 } 00142 00143 ###################################################################### 00144 # Display the custom abbreviation file in an editing buffer. 00145 proc edit_abbreviations {} { 00146 00147 pref_ui::create "" "" emmet "Node Aliases" 00148 00149 } 00150 00151 ###################################################################### 00152 # Handles any save operations to the Emmet customization file. 00153 proc load_custom_aliases {args} { 00154 00155 variable custom_file 00156 variable customizations 00157 00158 # Read in the emmet customizations 00159 if {![catch { tkedat::read $custom_file 1 } rc]} { 00160 00161 array unset customizations 00162 00163 # Save the customization information 00164 array set customizations $rc 00165 00166 } 00167 00168 } 00169 00170 ###################################################################### 00171 # Updates the given alias value. 00172 proc update_alias {type curr_alias new_alias value} { 00173 00174 variable customizations 00175 variable custom_file 00176 00177 # Get the affected aliases and store it in an array 00178 array set aliases $customizations($type) 00179 00180 # Remove the old alias information if the curr_alias value does not match the new_alias value 00181 if {$curr_alias ne $new_alias} { 00182 catch { unset aliases($curr_alias) } 00183 } 00184 00185 if {$new_alias ne ""} { 00186 set aliases($new_alias) $value 00187 } 00188 00189 # Store the aliases list back into the customization array 00190 set customizations($type) [array get aliases] 00191 00192 # Write the customization value to file 00193 catch { tkedat::write $custom_file [array get customizations] 1 [list node_aliases array abbreviation_aliases array] } 00194 00195 } 00196 00197 ###################################################################### 00198 # Returns the alias value associated with the given alias name. If 00199 # no alias was found, returns the empty string. 00200 proc lookup_alias_helper {type alias} { 00201 00202 variable customizations 00203 00204 if {[info exists customizations($type)]} { 00205 array set aliases $customizations($type) 00206 if {[info exists aliases($alias)]} { 00207 return $aliases($alias) 00208 } 00209 } 00210 00211 return "" 00212 00213 } 00214 00215 ###################################################################### 00216 # Perform a lookup of a customized node alias and returns its value, 00217 # if found. If not found, returns the empty string. 00218 proc lookup_node_alias {alias} { 00219 00220 return [lookup_alias_helper node_aliases $alias] 00221 00222 } 00223 00224 ###################################################################### 00225 # Perform a lookup of a customized abbreviation alias and returns its value, 00226 # if found. If not found, returns the empty string. 00227 proc lookup_abbr_alias {alias} { 00228 00229 return [lookup_alias_helper abbreviation_aliases $alias] 00230 00231 } 00232 00233 ###################################################################### 00234 # Get the alias information. 00235 proc get_aliases {} { 00236 00237 variable customizations 00238 00239 return [array get customizations] 00240 00241 } 00242 00243 ###################################################################### 00244 # Gets the tag that begins before the current insertion cursor. The 00245 # value of -dir must be "next or "prev". The value of -type must be 00246 # "100" (start), "001" (end), "010" (both) or "*" (any). The value of 00247 # name is the tag name to search for (if specified). 00248 # 00249 # Returns a list of 6 elements if a tag was found that matches: 00250 # - starting tag position 00251 # - ending tag position 00252 # - tag name 00253 # - type of tag found (10=start, 01=end or 11=both) 00254 # - number of starting tags encountered that did not match 00255 # - number of ending tags encountered that did not match 00256 proc get_tag {txt args} { 00257 00258 array set opts { 00259 -dir "next" 00260 -type "*" 00261 -name "*" 00262 -start "insert" 00263 } 00264 array set opts $args 00265 00266 # Initialize counts 00267 set missed [list] 00268 00269 # Get the tag 00270 if {$opts(-dir) eq "prev"} { 00271 if {[set start [lindex [$txt syntax prevrange angledL $opts(-start)] 0]] eq ""} { 00272 return "" 00273 } elseif {[set end [lindex [$txt syntax nextrange angledR $start] 1]] eq ""} { 00274 return "" 00275 } 00276 } else { 00277 if {[set end [lindex [$txt syntax nextrange angledR $opts(-start)] 1]] eq ""} { 00278 return "" 00279 } elseif {[set start [lindex [$txt syntax prevrange angledL $end] 0]] eq ""} { 00280 return "" 00281 } 00282 } 00283 00284 while {1} { 00285 00286 # Get the tag elements 00287 if {[$txt get "$start+1c"] eq "/"} { 00288 set found_type "001" 00289 set found_name [regexp -inline -- {[a-zA-Z0-9_:-]+} [$txt get "$start+2c" "$end-1c"]] 00290 } else { 00291 if {[$txt get "$end-2c"] eq "/"} { 00292 set found_type "010" 00293 set found_name [regexp -inline -- {[a-zA-Z0-9_:-]+} [$txt get "$start+1c" "$end-2c"]] 00294 } else { 00295 set found_type "100" 00296 set found_name [regexp -inline -- {[a-zA-Z0-9_:-]+} [$txt get "$start+1c" "$end-1c"]] 00297 } 00298 } 00299 00300 # If we have found what we are looking for, return now 00301 if {[string match $opts(-type) $found_type] && [string match $opts(-name) $found_name]} { 00302 return [list $start $end $found_name $found_type $missed] 00303 } 00304 00305 # Update counts 00306 lappend missed "$found_name,$found_type" 00307 00308 # Otherwise, get the next tag 00309 if {$opts(-dir) eq "prev"} { 00310 if {[set end [lindex [$txt syntax prevrange angledR $start] 1]] eq ""} { 00311 return "" 00312 } elseif {[set start [lindex [$txt syntax prevrange angledL $end] 0]] eq ""} { 00313 return "" 00314 } 00315 } else { 00316 if {[set start [lindex [$txt syntax nextrange angledL $end] 0]] eq ""} { 00317 return "" 00318 } elseif {[set end [lindex [$txt syntax nextrange angledR $start] 1]] eq ""} { 00319 return "" 00320 } 00321 } 00322 00323 } 00324 00325 } 00326 00327 ###################################################################### 00328 # If the insertion cursor is currently inside of a tag element, returns 00329 # the tag information; otherwise, returns the empty string 00330 proc inside_tag {txt args} { 00331 00332 array set opts { 00333 -startpos insert 00334 -allow010 0 00335 } 00336 array set opts $args 00337 00338 set retval [get_tag $txt -dir prev -start "$opts(-startpos)+1c"] 00339 00340 if {($retval ne "") && [$txt compare $opts(-startpos) < [lindex $retval 1]] && (([lindex $retval 3] ne "010") || $opts(-allow010))} { 00341 return $retval 00342 } 00343 00344 return "" 00345 00346 } 00347 00348 ###################################################################### 00349 # Assumes that the insertion cursor is somewhere between a start and end 00350 # tag. 00351 proc get_node_range_within {txt args} { 00352 00353 array set opts { 00354 -startpos insert 00355 } 00356 array set opts $args 00357 00358 # Find the beginning tag that we are currently inside of 00359 set retval [list $opts(-startpos)] 00360 set count 0 00361 00362 while {1} { 00363 if {[set retval [get_tag $txt -dir prev -type 100 -start [lindex $retval 0]]] eq ""} { 00364 return "" 00365 } 00366 if {[incr count [expr [llength [lsearch -all [lindex $retval 4] *,100]] - [llength [lsearch -all [lindex $retval 4] *,001]]]] == 0} { 00367 set start_range [lrange $retval 0 1] 00368 set range_name [lindex $retval 2] 00369 break 00370 } 00371 incr count 00372 } 00373 00374 # Find the ending tag based on the beginning tag 00375 set retval [list {} $opts(-startpos)] 00376 set count 0 00377 00378 while {1} { 00379 if {[set retval [get_tag $txt -dir next -type 001 -name $range_name -start [lindex $retval 1]]] eq ""} { 00380 return "" 00381 } 00382 if {[incr count [llength [lsearch -all [lindex $retval 4] $range_name,100]]] == 0} { 00383 return [list {*}$start_range {*}[lrange $retval 0 1]] 00384 } 00385 incr count -1 00386 } 00387 00388 } 00389 00390 ###################################################################### 00391 # Returns the character range for the current node based on the given 00392 # outer type. 00393 proc get_node_range {txt args} { 00394 00395 variable data 00396 00397 array set opts { 00398 -startpos insert 00399 } 00400 array set opts $args 00401 00402 array set other $data(other_map) 00403 array set dir $data(dir_map) 00404 array set index $data(index_map) 00405 00406 # Check to see if the starting position is within a tag and if it is 00407 # not, find the tags surrounding the starting position. 00408 if {[set itag [inside_tag $txt -startpos $opts(-startpos) -allow010 1]] eq ""} { 00409 return [get_node_range_within $txt -startpos $opts(-startpos)] 00410 } elseif {[lindex $itag 3] eq "010"} { 00411 return "" 00412 } 00413 00414 lassign $itag start end name type 00415 00416 # If we are on a starting tag, look for the ending tag 00417 set retval [list $start $end] 00418 set others 0 00419 while {1} { 00420 if {[set retval [get_tag $txt -dir $dir($type) -name $name -type $other($type) -start [lindex $retval $index($type)]]] eq ""} { 00421 return "" 00422 } 00423 if {[incr others [llength [lsearch -all [lindex $retval 4] $name,$type]]] == 0} { 00424 switch $type { 00425 "100" { return [list $start $end {*}[lrange $retval 0 1]] } 00426 "001" { return [list {*}[lrange $retval 0 1] $start $end] } 00427 default { return -code error "Error finding node range" } 00428 } 00429 } 00430 incr others -1 00431 } 00432 00433 } 00434 00435 ###################################################################### 00436 # Returns the outer range of the given node range value as a list. 00437 proc get_outer {node_range} { 00438 00439 if {$node_range ne ""} { 00440 return [list [lindex $node_range 0] [lindex $node_range 3]] 00441 } 00442 00443 return "" 00444 00445 } 00446 00447 ###################################################################### 00448 # Returns the inner range of the given node range value as a list. 00449 proc get_inner {node_range} { 00450 00451 if {$node_range ne ""} { 00452 return [lrange $node_range 1 2] 00453 } 00454 00455 return "" 00456 00457 } 00458 00459 ###################################################################### 00460 # Wraps the current tag with a user-specified Emmet abbreviation. 00461 proc wrap_with_abbreviation {args} { 00462 00463 array set opts { 00464 -test "" 00465 } 00466 array set opts $args 00467 00468 set abbr $opts(-test) 00469 00470 # Get the abbreviation from the user 00471 if {($abbr ne "") || [gui::get_user_response [format "%s:" [msgcat::mc "Abbreviation"]] abbr]} { 00472 00473 # Get the current text widget 00474 set txt [gui::current_txt] 00475 00476 # Get the node to surround 00477 if {[llength [set range [$txt tag ranges sel]]] != 2} { 00478 set range [get_outer [get_node_range $txt]] 00479 } 00480 00481 # Parse the snippet and if no error, insert the resulting string 00482 if {![catch { ::parse_emmet $abbr "" [$txt get {*}$range] } str]} { 00483 snippets::insert_snippet_into_current $str -delrange $range -separator 0 00484 } 00485 00486 } 00487 00488 } 00489 00490 ###################################################################### 00491 # Starting at a given tag, set the insertion cursor at the start of 00492 # the matching tag. 00493 proc go_to_matching_pair {} { 00494 00495 variable data 00496 00497 array set other $data(other_map) 00498 array set dir $data(dir_map) 00499 array set index $data(index_map) 00500 00501 # Get the current text widget 00502 set txt [gui::current_txt] 00503 00504 # Get the tag that we are inside of 00505 if {[set itag [inside_tag $txt]] eq ""} { 00506 return 00507 } 00508 00509 lassign $itag start end name type 00510 00511 # If we are on a starting tag, look for the ending tag 00512 set retval [list $start $end] 00513 set others 0 00514 while {1} { 00515 if {[set retval [get_tag $txt -dir $dir($type) -name $name -type $other($type) -start [lindex $retval $index($type)]]] eq ""} { 00516 return 00517 } 00518 if {[incr others [llength [lsearch -all [lindex $retval 4] $name,$type]]] == 0} { 00519 ::tk::TextSetCursor $txt [lindex $retval 0] 00520 return 00521 } 00522 incr others -1 00523 } 00524 00525 } 00526 00527 ###################################################################### 00528 # Performs tag balancing. 00529 proc balance_outward {} { 00530 00531 variable data 00532 00533 array set other $data(other_map) 00534 array set dir $data(dir_map) 00535 array set index $data(index_map) 00536 00537 # Get the current text widget 00538 set txt [gui::current_txt] 00539 00540 # Adjust the insertion cursor if we are on a starting tag and there 00541 # is a selection. 00542 if {[$txt tag ranges sel] ne ""} { 00543 $txt mark set insert "insert-1c" 00544 } 00545 00546 # If the insertion cursor is on a tag, get the outer node range 00547 if {[set node_range [get_node_range $txt]] eq ""} { 00548 $txt mark set insert "insert+1c" 00549 return 00550 } 00551 00552 # Set the cursor at the beginning of the range 00553 if {[$txt compare [lindex $node_range 1] <= insert] && [$txt compare insert < [lindex $node_range 2]]} { 00554 set node_range [get_inner $node_range] 00555 } else { 00556 set node_range [get_outer $node_range] 00557 } 00558 00559 # Set the cursor position 00560 ::tk::TextSetCursor $txt [lindex $node_range 0] 00561 00562 # Select the current range 00563 $txt tag add sel {*}$node_range 00564 00565 } 00566 00567 ###################################################################### 00568 # Performs an Emmet balance inward operation based on the current 00569 # selection state. 00570 proc balance_inward {} { 00571 00572 # Get the current text widget 00573 set txt [gui::current_txt] 00574 00575 # If we already have a selection, perform the inward balance 00576 if {[llength [$txt tag ranges sel]] == 2} { 00577 if {([inside_tag $txt] eq "") || ([set tag_range [get_inner [get_node_range $txt]]] eq "")} { 00578 if {([set retval [get_tag $txt -dir next -type 100]] ne "") && ([lindex $retval 4] eq "")} { 00579 ::tk::TextSetCursor $txt [lindex $retval 0] 00580 if {[set tag_range [get_outer [get_node_range $txt]]] eq ""} { 00581 return 00582 } 00583 } else { 00584 return 00585 } 00586 } 00587 00588 # Set the cursor and the selection 00589 ::tk::TextSetCursor $txt [lindex $tag_range 0] 00590 $txt tag add sel {*}$tag_range 00591 00592 # Otherwise, perform an outward balance to make the selection 00593 } else { 00594 00595 balance_outward 00596 00597 } 00598 00599 } 00600 00601 ###################################################################### 00602 # Returns the list of attributes such that each attribute as the following 00603 # properties: 00604 # - attribute name 00605 # - attribute name start index 00606 # - attribute value 00607 # - attribute value start index 00608 proc get_tag_attributes {txt tag_info} { 00609 00610 lassign $tag_info start end name type 00611 00612 # Attributes cannot exist in ending attributes, so just return 00613 if {$type eq "001"} { 00614 return [list] 00615 } 00616 00617 # Get the attribute contents after the tag name 00618 set start [$txt index "$start+[expr [string length $name] + 1]c"] 00619 set contents [$txt get $start "$end-1c"] 00620 00621 set attrs [list] 00622 while {[regexp {^(\s*)(\w+)="(.*?)"(.*)$} $contents -> prespace attr_name attr_value contents]} { 00623 set attr_name_start [$txt index "$start+[string length $prespace]c"] 00624 set attr_val_start [$txt index "$attr_name_start+[expr [string length $attr_name] + 2]c"] 00625 lappend attrs $attr_name $attr_name_start $attr_value $attr_val_start 00626 set start [$txt index "$attr_val_start+[expr [string length $attr_value] + 1]c"] 00627 } 00628 00629 return $attrs 00630 00631 } 00632 00633 ###################################################################### 00634 # Returns an index that contains an empty, indented line; otherwise, 00635 # returns the empty string. 00636 proc get_blank_line {txt dir startpos endpos} { 00637 00638 if {$dir eq "next"} { 00639 if {[$txt compare $startpos >= "$startpos lineend-1 display chars"]} { 00640 set startpos [$txt index "$startpos+1 display lines linestart"] 00641 } 00642 while {[$txt compare $startpos < $endpos]} { 00643 if {([string trim [$txt get "$startpos linestart" "$startpos lineend"]] eq "") && \ 00644 ([$txt compare "$startpos linestart" != "$startpos lineend"])} { 00645 return $startpos 00646 } 00647 set startpos [$txt index "$startpos+1 display lines"] 00648 } 00649 } else { 00650 set startpos [$txt index "$startpos-1 display lines linestart"] 00651 while {[$txt compare $startpos > $endpos]} { 00652 if {([string trim [$txt get "$startpos linestart" "$startpos lineend"]] eq "") && \ 00653 ([$txt compare "$startpos linestart" != "$startpos lineend"])} { 00654 return $startpos 00655 } 00656 set startpos [$txt index "$startpos-1 display lines"] 00657 } 00658 } 00659 00660 return "" 00661 00662 } 00663 00664 ###################################################################### 00665 # Jumps the insertion cursor to an HTML edit point. 00666 proc go_to_edit_point {dir} { 00667 00668 # Get the current text widget 00669 set txt [gui::current_txt] 00670 00671 # If we are inside a tag, look for an empty attribute 00672 if {[set retval [inside_tag $txt]] eq ""} { 00673 if {[set retval [get_tag $txt -dir $dir]] eq ""} { 00674 return 00675 } else { 00676 set endpos [expr {($dir eq "next") ? [lindex $retval 0] : [lindex $retval 1]}] 00677 if {[set index [get_blank_line $txt $dir insert $endpos]] ne ""} { 00678 ::tk::TextSetCursor $txt "$index lineend" 00679 vim::adjust_insert $txt.t 00680 return 00681 } 00682 } 00683 } 00684 00685 # Look for an empty attribute 00686 if {$dir eq "next"} { 00687 00688 while {1} { 00689 foreach {attr_name attr_name_start attr_value attr_value_start} [get_tag_attributes $txt $retval] { 00690 if {($attr_value eq "") && [$txt compare $attr_value_start > insert]} { 00691 ::tk::TextSetCursor $txt $attr_value_start 00692 return 00693 } 00694 } 00695 if {[set next_tag [get_tag $txt -dir next -start [lindex $retval 1]]] ne ""} { 00696 if {[$txt compare [lindex $retval 1] == [lindex $next_tag 0]]} { 00697 ::tk::TextSetCursor $txt [lindex $next_tag 0] 00698 return 00699 } elseif {[set index [get_blank_line $txt next [lindex $retval 1] [lindex $next_tag 0]]] ne ""} { 00700 ::tk::TextSetCursor $txt "$index lineend" 00701 vim::adjust_insert $txt.t 00702 return 00703 } else { 00704 set retval $next_tag 00705 } 00706 } else { 00707 return 00708 } 00709 } 00710 00711 } else { 00712 00713 while {1} { 00714 foreach {attr_value_start attr_value attr_name_start attr_name} [lreverse [get_tag_attributes $txt $retval]] { 00715 if {($attr_value eq "") && [$txt compare $attr_value_start < insert]} { 00716 ::tk::TextSetCursor $txt $attr_value_start 00717 return 00718 } 00719 } 00720 if {[set prev_tag [get_tag $txt -dir prev -start [lindex $retval 0]]] ne ""} { 00721 if {[$txt compare [lindex $prev_tag 1] == [lindex $retval 0]] && \ 00722 [$txt compare insert != [lindex $retval 0]]} { 00723 ::tk::TextSetCursor $txt [lindex $retval 0] 00724 return 00725 } elseif {[set index [get_blank_line $txt prev [lindex $retval 0] [lindex $prev_tag 1]]] ne ""} { 00726 ::tk::TextSetCursor $txt "$index lineend" 00727 vim::adjust_insert $txt.t 00728 return 00729 } else { 00730 set retval $prev_tag 00731 } 00732 } else { 00733 return 00734 } 00735 } 00736 00737 } 00738 00739 } 00740 00741 ###################################################################### 00742 # Selects the next value in the HTML attribute list of values. 00743 proc select_html_attr_value {txt dir selected attr_value attr_value_start} { 00744 00745 if {$attr_value eq ""} { 00746 return 0 00747 } 00748 00749 set select 0 00750 set pattern [expr {($dir eq "next") ? {^\s*(\S+)} : {(\S+)\s*$}}] 00751 set attr_value_end [$txt index "$attr_value_start+[string length $attr_value]c"] 00752 00753 if {((($dir eq "next") && ($selected eq [list $attr_value_start $attr_value_end])) || \ 00754 (($dir eq "prev") && ($selected ne "") && [$txt compare [lindex $selected 0] > $attr_value_end])) && [regexp {\s} $attr_value]} { 00755 set select 1 00756 } 00757 00758 while {[regexp -indices $pattern $attr_value -> match]} { 00759 set value_start [$txt index "$attr_value_start+[lindex $match 0]c"] 00760 set value_end [$txt index "$attr_value_start+[expr [lindex $match 1] + 1]c"] 00761 if {$select} { 00762 ::tk::TextSetCursor $txt $value_end 00763 $txt tag add sel $value_start $value_end 00764 return 1 00765 } elseif {$selected eq [list $value_start $value_end]} { 00766 set select 1 00767 } 00768 if {$dir eq "next"} { 00769 set attr_value [string range $attr_value [expr [lindex $match 1] + 1] end] 00770 set attr_value_start [$txt index "$attr_value_start+[expr [lindex $match 1] + 1]c"] 00771 } else { 00772 set attr_value [string range $attr_value 0 [expr [lindex $match 0] - 1]] 00773 } 00774 } 00775 00776 if {$select} { 00777 return 0 00778 } else { 00779 ::tk::TextSetCursor $txt $attr_value_end 00780 $txt tag add sel $attr_value_start $attr_value_end 00781 return 1 00782 } 00783 00784 } 00785 00786 ###################################################################### 00787 # Selects the next or previous HTML item. 00788 proc select_html_item {txt dir} { 00789 00790 set startpos "insert" 00791 00792 # If the cursor is not within a start tag, go find the next start tag 00793 if {([set retval [inside_tag $txt -allow010 1]] eq "") || [string match "001" [lindex $retval 3]]} { 00794 set retval [get_tag $txt -dir $dir -type "??0"] 00795 } 00796 00797 # Get the currently selected text 00798 if {[llength [set selected [$txt tag ranges sel]]] != 2} { 00799 set selected "" 00800 } 00801 00802 if {$dir eq "next"} { 00803 00804 while {$retval ne ""} { 00805 00806 # Figure out the index of the end of the name 00807 set end_name "[lindex $retval 0]+[expr [string length [lindex $retval 2]] + 1]c" 00808 00809 # Select the tag name if it is the next item 00810 if {[$txt compare $startpos < $end_name]} { 00811 ::tk::TextSetCursor $txt $end_name 00812 $txt tag add sel "[lindex $retval 0]+1c" $end_name 00813 return 00814 00815 # Otherwise, check the attributes within the tag for selectable items 00816 } else { 00817 foreach {attr_name attr_name_start attr_value attr_value_start} [get_tag_attributes $txt $retval] { 00818 set attr_end [$txt index "$attr_value_start+[expr [string length $attr_value] + 1]c"] 00819 if {[$txt compare $startpos > $attr_end]} { 00820 continue 00821 } 00822 if {[$txt compare $startpos < $attr_value_start]} { 00823 ::tk::TextSetCursor $txt $attr_end 00824 $txt tag add sel $attr_name_start $attr_end 00825 return 00826 } elseif {(($selected eq [list $attr_name_start $attr_end]) && ($attr_value ne "")) || ($selected eq "")} { 00827 ::tk::TextSetCursor $txt "$attr_end-1c" 00828 $txt tag add sel $attr_value_start "$attr_end-1c" 00829 return 00830 } elseif {[select_html_attr_value $txt $dir $selected $attr_value $attr_value_start ]} { 00831 return 00832 } 00833 } 00834 } 00835 00836 # Get the next tag 00837 set retval [get_tag $txt -dir $dir -type "??0" -start [lindex $retval 1]] 00838 00839 } 00840 00841 } else { 00842 00843 while {$retval ne ""} { 00844 00845 set attr_name_start "" 00846 00847 foreach {attr_value_start attr_value attr_name_start attr_name} [lreverse [get_tag_attributes $txt $retval]] { 00848 set attr_end [$txt index "$attr_value_start+[expr [string length $attr_value] + 1]c"] 00849 if {($selected eq [list $attr_name_start $attr_end]) || [$txt compare $startpos < $attr_name_start]} { 00850 continue 00851 } 00852 if {($selected eq [list $attr_value_start [$txt index $attr_end-1c]]) || \ 00853 (($attr_value eq "") && [$txt compare $startpos > $attr_name_start])} { 00854 ::tk::TextSetCursor $txt $attr_end 00855 $txt tag add sel $attr_name_start $attr_end 00856 return 00857 } elseif {[select_html_attr_value $txt $dir $selected $attr_value $attr_value_start]} { 00858 return 00859 } elseif {[$txt compare $startpos > $attr_value_start] && ($attr_value ne "")} { 00860 ::tk::TextSetCursor $txt "$attr_end-1c" 00861 $txt tag add sel $attr_value_start "$attr_end-1c" 00862 return 00863 } 00864 } 00865 00866 set start_name [$txt index "[lindex $retval 0]+1c"] 00867 set end_name [$txt index "[lindex $retval 0]+[expr [string length [lindex $retval 2]] + 1]c"] 00868 00869 # Highlight the tag name if the first full attribute is highlighted or 00870 # if nothing was highlighted but the cursor is after the beginning of 00871 # the tag name 00872 if {(($selected ne [list $start_name $end_name]) && [$txt compare $startpos > [lindex $retval 0]]) || \ 00873 (($attr_name_start ne "") && ($selected eq [list $attr_name_start $attr_end]))} { 00874 ::tk::TextSetCursor $txt $end_name 00875 $txt tag add sel $start_name $end_name 00876 return 00877 } 00878 00879 # Get the previous tag 00880 set retval [get_tag $txt -dir $dir -type "??0" -start [lindex $retval 0]] 00881 00882 } 00883 00884 } 00885 00886 } 00887 00888 ###################################################################### 00889 # Perform next/previous item selection. 00890 proc select_item {dir} { 00891 00892 # Get the current text widget 00893 set txt [gui::current_txt] 00894 00895 # Get the language of the current insertion cursor 00896 if {[set lang [ctext::getLang $txt insert]] eq ""} { 00897 set lang [syntax::get_language $txt] 00898 } 00899 00900 if {$lang eq "CSS"} { 00901 emmet_css::select_item $txt $dir 00902 } else { 00903 select_html_item $txt $dir 00904 } 00905 00906 } 00907 00908 ###################################################################### 00909 # Toggles the current HTML node with an HTML comment. 00910 proc toggle_html_comment {txt} { 00911 00912 if {[$txt is incomment insert]} { 00913 00914 if {([set comment_end [lassign [$txt syntax prevrange comstr1c0 insert] comment_start]] eq "") || \ 00915 [$txt compare insert > $comment_end]} { 00916 lassign [$txt syntax prevrange comstr1c1 insert] comment_start comment_end 00917 } 00918 00919 set i 0 00920 foreach index [$txt search -backwards -all -count lengths -regexp -- {<!--\s*|\s*-->} $comment_end $comment_start] { 00921 $txt delete $index "$index+[lindex $lengths $i]c" 00922 incr i 00923 } 00924 00925 } else { 00926 00927 if {[set node_range [get_node_range $txt]] ne ""} { 00928 lassign [get_outer $node_range] comment_start comment_end 00929 } elseif {[set retval [inside_tag $txt -allow010 1]] ne ""} { 00930 lassign $retval comment_start comment_end 00931 } else { 00932 return 00933 } 00934 00935 # Remove any comments found within range that we are going to comment 00936 set i 0 00937 foreach index [$txt search -backwards -all -count lengths -regexp -- {<!--\s*|\s*-->} $comment_end $comment_start] { 00938 $txt delete $index "$index+[lindex $lengths $i]c" 00939 incr i 00940 } 00941 00942 $txt insert $comment_end " -->" 00943 $txt insert $comment_start "<!-- " 00944 00945 } 00946 00947 } 00948 00949 ###################################################################### 00950 # Toggles the comment of a full HTML tag or CSS rule/property. 00951 proc toggle_comment {} { 00952 00953 # Get the current text widget 00954 set txt [gui::current_txt] 00955 00956 # Get the language of the current insertion cursor 00957 if {[set lang [ctext::getLang $txt insert]] eq ""} { 00958 set lang [syntax::get_language $txt] 00959 } 00960 00961 if {$lang eq "CSS"} { 00962 emmet_css::toggle_comment $txt 00963 } else { 00964 toggle_html_comment $txt 00965 } 00966 00967 } 00968 00969 ###################################################################### 00970 # Split/Join a tag 00971 proc split_join_tag {} { 00972 00973 set txt [gui::current_txt] 00974 00975 # If the cursor is within a node range, join the range 00976 if {[set retval [get_node_range $txt]] ne ""} { 00977 00978 $txt delete [lindex $retval 1] [lindex $retval 3] 00979 $txt insert "[lindex $retval 1]-1c" " /" 00980 00981 # Otherwise, split the tag 00982 } elseif {[set retval [inside_tag $txt -allow010 1]] ne ""} { 00983 00984 set index [$txt search -regexp -- {\s*/>$} [lindex $retval 0] [lindex $retval 1]] 00985 $txt replace $index [lindex $retval 1] "></[lindex $retval 2]>" 00986 00987 } 00988 00989 } 00990 00991 ###################################################################### 00992 # Removes the current start/end tag and adjusts indentation of all 00993 # included tags. 00994 proc remove_tag {} { 00995 00996 set txt [gui::current_txt] 00997 00998 # If the cursor is within a node range, delete the start/end tags 00999 # and adjust indentation if necessary. 01000 if {[set retval [get_node_range $txt]] ne ""} { 01001 01002 # If the start and end tags are on the same line and the tag is the only 01003 # tag on the line. 01004 if {[$txt compare "[lindex $retval 0] linestart" == "[lindex $retval 3] linestart"] && \ 01005 ([string trim [$txt get [lindex $retval 1] [lindex $retval 2]]] eq "") && \ 01006 ([string trim [$txt get "[lindex $retval 0] linestart" [lindex $retval 0]]] eq "") && \ 01007 ([string trim [$txt get [lindex $retval 3] "[lindex $retval 3] lineend"]] eq "")} { 01008 01009 $txt delete "[lindex $retval 0] linestart" "[lindex $retval 3]+1l linestart" 01010 01011 } else { 01012 01013 # Adjust the starting tag range 01014 if {([string trim [$txt get "[lindex $retval 0] linestart" [lindex $retval 0]]] eq "") && \ 01015 ([string trim [$txt get [lindex $retval 1] "[lindex $retval 1] lineend"]] eq "")} { 01016 lset retval 0 [$txt index "[lindex $retval 0] linestart"] 01017 lset retval 1 [$txt index "[lindex $retval 1]+1l linestart"] 01018 } 01019 01020 # Adjust the ending tag range 01021 if {([string trim [$txt get "[lindex $retval 2] linestart" [lindex $retval 2]]] eq "") && \ 01022 ([string trim [$txt get [lindex $retval 3] "[lindex $retval 3] lineend"]] eq "")} { 01023 lset retval 2 [$txt index "[lindex $retval 2] linestart"] 01024 lset retval 3 [$txt index "[lindex $retval 3]+1l linestart"] 01025 } 01026 01027 # These are the number of characters that will be removed from the start 01028 set count [$txt count -lines {*}[lrange $retval 1 2]] 01029 01030 # Delete the tags 01031 $txt delete {*}[lrange $retval 2 3] 01032 $txt delete {*}[lrange $retval 0 1] 01033 01034 # Just use the indentation algorithm 01035 indent::format_text $txt.t [lindex $retval 0] "[lindex $retval 0]+${count}l linestart" 0 01036 01037 } 01038 01039 # Add a separator 01040 $txt edit separator 01041 01042 } elseif {[set retval [inside_tag $txt -allow010 1]] ne ""} { 01043 01044 # Delete the tag 01045 if {([string trim [$txt get "[lindex $retval 0] linestart" [lindex $retval 0]]] eq "") && \ 01046 ([string trim [$txt get [lindex $retval 1] "[lindex $retval 1] lineend"]] eq "")} { 01047 $txt delete "[lindex $retval 0] linestart" "[lindex $retval 1]+1l linestart" 01048 } else { 01049 $txt delete {*}[lrange $retval 0 1] 01050 } 01051 01052 # Add a separator 01053 $txt edit separator 01054 01055 } 01056 01057 } 01058 01059 ###################################################################### 01060 # Merges all lines for a given node range. 01061 proc merge_lines {} { 01062 01063 set txt [gui::current_txt] 01064 01065 if {[set range [get_node_range $txt]] ne ""} { 01066 01067 lassign $range startpos dummy1 dummy2 endpos 01068 01069 # Get the number of lines to join 01070 set lines [$txt count -lines $startpos $endpos] 01071 01072 for {set i 0} {$i < $lines} {incr i} { 01073 set line [string trimleft [$txt get "$startpos+1l linestart" "$startpos+1l lineend"]] 01074 $txt delete "$startpos lineend" "$startpos+1l lineend" 01075 if {$line ne ""} { 01076 $txt insert "$startpos lineend" $line 01077 } 01078 } 01079 01080 } 01081 01082 } 01083 01084 ###################################################################### 01085 # Updates the HTML size using the given image's width and height and 01086 # available attributes. 01087 proc update_html_image_size {txt} { 01088 01089 if {([set retval [inside_tag $txt -allow010 1]] ne "") && ([lindex $retval 2] eq "img") && [string match "??0" [lindex $retval 3]]} { 01090 01091 set width "" 01092 set height "" 01093 set src_end "" 01094 set width_start "" 01095 set width_end "" 01096 set hstart "" 01097 set height_start "" 01098 set height_end "" 01099 01100 foreach {attr_name attr_name_start attr_value attr_value_start} [get_tag_attributes $txt $retval] { 01101 switch $attr_name { 01102 "src" { 01103 if {![catch { exec php [file join $::tke_dir lib image_size.php] $attr_value } rc]} { 01104 lassign $rc width height 01105 if {![string is integer $width]} { 01106 set width "" 01107 } 01108 } 01109 set src_end [$txt index "$attr_value_start+[expr [string length $attr_value] + 1]c"] 01110 } 01111 "width" { 01112 set width_start $attr_value_start 01113 set width_end [$txt index "$attr_value_start+[string length $attr_value]c"] 01114 } 01115 "height" { 01116 set hstart $attr_name_start 01117 set height_start $attr_value_start 01118 set height_end [$txt index "$attr_value_start+[string length $attr_value]c"] 01119 } 01120 } 01121 } 01122 01123 if {$width ne ""} { 01124 if {$width_start ne ""} { 01125 if {$height_start ne ""} { 01126 if {[$txt compare $width_start < $height_start]} { 01127 $txt replace $height_start $height_end $height 01128 $txt replace $width_start $width_end $width 01129 } else { 01130 $txt replace $width_start $width_end $width 01131 $txt replace $height_start $height_end $height 01132 } 01133 } else { 01134 $txt insert "$width_end+1c" " height=\"$height\"" 01135 $txt replace $width_start $width_end $width 01136 } 01137 } else { 01138 if {$height_start ne ""} { 01139 $txt replace $height_start $height_end $height 01140 $txt insert $hstart "width=\"$width\" " 01141 } else { 01142 $txt insert $src_end " width=\"$width\" height=\"$height\"" 01143 } 01144 } 01145 } 01146 01147 } 01148 01149 } 01150 01151 ###################################################################### 01152 # Updates the image size of the current tag. 01153 proc update_image_size {} { 01154 01155 # Get the current text widget 01156 set txt [gui::current_txt] 01157 01158 # Get the language of the current insertion cursor 01159 if {[set lang [ctext::getLang $txt insert]] eq ""} { 01160 set lang [syntax::get_language $txt] 01161 } 01162 01163 if {$lang eq "CSS"} { 01164 emmet_css::update_image_size $txt 01165 } else { 01166 update_html_image_size $txt 01167 } 01168 01169 } 01170 01171 ###################################################################### 01172 # Increment/decrement the number under the insertion cursor by the 01173 # given amount. 01174 proc change_number {amount} { 01175 01176 set txt [gui::current_txt] 01177 01178 # Get the range of the number 01179 if {[$txt get insert] eq "-"} { 01180 set num_start "insert" 01181 set num_end [edit::get_index $txt.t numberend -startpos "insert+1c" -adjust "+1c"] 01182 if {[$txt compare $num_end == "insert+1c"]} { 01183 return 01184 } 01185 } else { 01186 set num_start [edit::get_index $txt.t numberstart] 01187 set num_end [edit::get_index $txt.t numberend -adjust "+1c"] 01188 if {[$txt compare $num_start == $num_end] || [$txt compare insert == $num_end]} { 01189 return 01190 } 01191 if {([$txt get "$num_start-1c"] eq "-") && ![$txt is escaped "$num_start-1c"]} { 01192 set num_start "$num_start-1c" 01193 } 01194 } 01195 01196 # Get the number and only continue on if the value is not a hexidecimal 01197 if {[string range [set number [$txt get $num_start $num_end]] 0 1] ne "0x"} { 01198 01199 # Get the decimal portions of the text number and the increment/decrement 01200 # amount 01201 set number_len [string length [lindex [split $number .] 1]] 01202 set amount_len [string length [lindex [split $amount .] 1]] 01203 set number [expr $number + $amount] 01204 01205 # Figure out the numerical formatting 01206 if {($number_len != 0) || ($amount_len != 0)} { 01207 if {$number_len < $amount_len} { 01208 set number [format "%.${amount_len}f" $number] 01209 if {[lindex [split $number .] 1] eq "0"} { 01210 set number [expr int( $number )] 01211 } 01212 } else { 01213 set number [format "%.${number_len}f" $number] 01214 if {[lindex [split $number .] 1] eq "0"} { 01215 set number [expr int( $number )] 01216 } 01217 } 01218 } 01219 01220 # Get the insertion cursor position 01221 set cursor [$txt index insert] 01222 01223 # Insert the number 01224 $txt replace $num_start $num_end $number 01225 01226 # Set the cursor 01227 ::tk::TextSetCursor $txt.t $cursor 01228 01229 # Create an undo separator 01230 $txt edit separator 01231 01232 } 01233 01234 } 01235 01236 ###################################################################### 01237 # Evaluate the current math expression. 01238 proc evaluate_math_expression {} { 01239 01240 set txt [gui::current_txt] 01241 set pre_match "" 01242 set post_match "" 01243 01244 regexp {(\S+)$} [$txt get "insert linestart" insert] pre_match 01245 regexp {^(\S+)} [$txt get insert "insert lineend"] post_match 01246 01247 if {[set expression "$pre_match$post_match"] ne ""} { 01248 01249 # Attempt to evaluate the expression 01250 if {![catch { expr $expression } rc]} { 01251 set startpos [$txt index "insert-[string length $pre_match]c"] 01252 set endpos [$txt index "insert+[string length $post_match]c"] 01253 $txt replace $startpos $endpos $rc 01254 ::tk::TextSetCursor $txt $startpos 01255 $txt edit separator 01256 } 01257 01258 } 01259 01260 } 01261 01262 ###################################################################### 01263 # Perform the data:URL replacement. 01264 proc replace_data_url {txt startpos endpos url args} { 01265 01266 array set opts { 01267 -test "" 01268 } 01269 array set opts $args 01270 01271 # If we have base64 data, decode and save the information to a file 01272 if {[regexp {^data:image/(gif|png|jpg);base64,(.*)$} $url -> ext data]} { 01273 set fname $opts(-test) 01274 if {($fname ne "") || [set fname [tk_getSaveFile -parent . -defaultextension .$ext -title [msgcat::mc "Select File to Save"]]] ne ""} { 01275 if {![catch { open $fname w } rc]} { 01276 fconfigure $rc -encoding binary 01277 puts $rc [base64::decode $data] 01278 close $rc 01279 $txt replace $startpos $endpos [utils::relative_to $fname [pwd]] 01280 $txt edit separator 01281 } 01282 } 01283 return 01284 } 01285 01286 # If the filename is a supported image type, convert the file to base64 01287 # and insert them. 01288 set type "" 01289 switch [file extension $url] { 01290 .gif { set type "image/gif" } 01291 .png { set type "image/png" } 01292 .jpg { set type "image/jpg" } 01293 .jpeg { set type "image/jpg" } 01294 } 01295 01296 # Get the filename to handle from the parsed URL 01297 set delete 1 01298 if {[file exists $url]} { 01299 set fname $url 01300 set delete 0 01301 } elseif {[set fname [utils::download_url $url]] eq ""} { 01302 return 01303 } 01304 01305 # Output the base64 output 01306 if {($type ne "") && ![catch { open $fname r } rc]} { 01307 fconfigure $rc -translation binary 01308 set data [read $rc] 01309 close $rc 01310 if {$delete} { 01311 file delete -force $fname 01312 } 01313 $txt replace $startpos $endpos "data:$type;base64,[base64::encode -maxlen 0 $data]" 01314 $txt edit separator 01315 } 01316 01317 } 01318 01319 ###################################################################### 01320 # Runs encode/decode image to data:URL in HTML. 01321 proc encode_decode_html_image_to_data_url {txt args} { 01322 01323 if {([set retval [inside_tag $txt -allow010 1]] eq "") || [string match "001" [lindex $retval 3]] || ([lindex $retval 2] ne "img")} { 01324 return 01325 } 01326 01327 # Find the URL in the current img tag 01328 set url "" 01329 foreach {attr_name attr_name_start attr_value attr_value_start} [get_tag_attributes $txt $retval] { 01330 if {($attr_name eq "src") && \ 01331 [$txt compare $attr_value_start <= insert] && \ 01332 [$txt compare insert <= "$attr_value_start+[string length $attr_value]c"]} { 01333 set url $attr_value 01334 set startpos $attr_value_start 01335 set endpos [$txt index "$attr_value_start+[string length $attr_value]c"] 01336 break 01337 } 01338 } 01339 01340 if {$url eq ""} { 01341 return 01342 } 01343 01344 # Perform the replacement 01345 replace_data_url $txt $startpos $endpos $url {*}$args 01346 01347 } 01348 01349 ###################################################################### 01350 # Executes encode/decode image to data:URL functionality. 01351 proc encode_decode_image_to_data_url {args} { 01352 01353 # Get the current text widget 01354 set txt [gui::current_txt] 01355 01356 # Get the language of the current insertion cursor 01357 if {[set lang [ctext::getLang $txt insert]] eq ""} { 01358 set lang [syntax::get_language $txt] 01359 } 01360 01361 if {$lang eq "CSS"} { 01362 emmet_css::encode_decode_image_to_data_url $txt {*}$args 01363 } else { 01364 encode_decode_html_image_to_data_url $txt {*}$args 01365 } 01366 01367 } 01368 01369 ###################################################################### 01370 # Displays the Emmet reference guide in a web browser. 01371 proc view_reference {} { 01372 01373 utils::open_file_externally "https://docs.emmet.io" 1 01374 01375 } 01376 01377 ###################################################################### 01378 # Returns a list of files/directories used by the Emmet namespace for 01379 # importing/exporting purposes. 01380 proc get_share_items {dir} { 01381 01382 return [list emmet.tkedat] 01383 01384 } 01385 01386 ###################################################################### 01387 # Called when the share directory changes. 01388 proc share_changed {dir} { 01389 01390 variable custom_file 01391 01392 set custom_file [file join $dir emmet.tkedat] 01393 01394 } 01395 01396 } 01397