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
