1# ntext.tcl -- 2# derived from text.tcl 3# 4# This file defines the Ntext bindings for Tk text widgets and provides 5# procedures that help in implementing the bindings. 6# 7# $Id: ntext.tcl,v 1.1 2007/06/21 21:05:27 hobbs Exp $ 8# 9# Copyright (c) 1992-1994 The Regents of the University of California. 10# Copyright (c) 1994-1997 Sun Microsystems, Inc. 11# Copyright (c) 1998 by Scriptics Corporation. 12# Copyright (c) 2005-2007 additions by Keith Nash. 13# 14# See the file "license.terms" for information on usage and redistribution 15# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 16# 17 18##### START OF CODE THAT IS MODIFIED text.tcl, Tk 8.5a5 = ActiveTcl 8.5beta6 19 20#------------------------------------------------------------------------- 21# Elements of ::tk::Priv that are used in this file: 22# 23# afterId - If non-null, it means that auto-scanning is underway 24# and it gives the "after" id for the next auto-scan 25# command to be executed. 26# char - Character position on the line; kept in order 27# to allow moving up or down past short lines while 28# still remembering the desired position. 29# mouseMoved - Non-zero means the mouse has moved a significant 30# amount since the button went down (so, for example, 31# start dragging out a selection). 32# prevPos - Used when moving up or down lines via the keyboard. 33# Keeps track of the previous insert position, so 34# we can distinguish a series of ups and downs, all 35# in a row, from a new up or down. 36# selectMode - The style of selection currently underway: 37# char, word, or line. 38# x, y - Last known mouse coordinates for scanning 39# and auto-scanning. 40#------------------------------------------------------------------------- 41 42#------------------------------------------------------------------------- 43# The code below creates the Ntext class bindings for text widgets. 44#------------------------------------------------------------------------- 45 46package require Tk 8.5 47 48# Mouse bindings: use ::ntext::Bcount to deal with out-of-order multiple 49# clicks. This permits the bindings to be simplified 50 51bind Ntext <1> { 52 set ::ntext::Bcount 1 53 ntext::TextButton1 %W %x %y 54 %W tag remove sel 0.0 end 55} 56bind Ntext <B1-Motion> { 57 set tk::Priv(x) %x 58 set tk::Priv(y) %y 59 ntext::TextSelectTo %W %x %y 60} 61# Inside the if: 62# The previous Button-1 event was not a single-click, but a double, triple, 63# or quadruple. 64# We can simplify the bindings if we ensure that a double-click is 65# *always* preceded by a single-click. 66# So in this case run the same code as <1> before doing <Double-1> 67bind Ntext <Double-1> { 68 if {$::ntext::Bcount != 1} { 69 set ::ntext::Bcount 1 70 ntext::TextButton1 %W %x %y 71 %W tag remove sel 0.0 end 72 } 73 set ::ntext::Bcount 2 74 set tk::Priv(selectMode) word 75 ntext::TextSelectTo %W %x %y 76 catch {%W mark set insert sel.first} 77} 78# ignore an out-of-order triple click. This has no adverse consequences. 79bind Ntext <Triple-1> { 80 if {$::ntext::Bcount != 2} { 81 continue 82 } 83 set ::ntext::Bcount 3 84 set tk::Priv(selectMode) line 85 ntext::TextSelectTo %W %x %y 86 catch {%W mark set insert sel.first} 87} 88# don't care if a quadruple click is out-of-order (i.e. follows a quadruple 89# click, not a triple click). 90bind Ntext <Quadruple-1> { 91 set ::ntext::Bcount 4 92} 93bind Ntext <Shift-1> { 94 set ::ntext::Bcount 1 95 if {(!$::ntext::classicMouseSelect) && ([%W tag ranges sel] eq "")} { 96 # Move the selection anchor mark to the old insert mark 97 # Should the mark's gravity be set? 98 %W mark set tk::anchor%W insert 99 } 100 if {$::ntext::classicAnchor} { 101 tk::TextResetAnchor %W @%x,%y 102 # if sel exists, sets anchor to end furthest from x,y 103 # changes anchor only, not insert 104 } 105 set tk::Priv(selectMode) char 106 ntext::TextSelectTo %W %x %y 107} 108# Inside the outer if: 109# The previous Button-1 event was not a single-click, but a double, triple, 110# or quadruple. 111# We can simplify the bindings if we ensure that a double-click is 112# *always* preceded by a single-click. 113# So in this case run the same code as <Shift-1> before doing <Double-Shift-1> 114bind Ntext <Double-Shift-1> { 115 if {$::ntext::Bcount != 1} { 116 set ::ntext::Bcount 1 117 if {(!$::ntext::classicMouseSelect) && ([%W tag ranges sel] eq "")} { 118 # Move the selection anchor mark to the old insert mark 119 # Should the mark's gravity be set? 120 %W mark set tk::anchor%W insert 121 } 122 if {$::ntext::classicAnchor} { 123 tk::TextResetAnchor %W @%x,%y 124 # if sel exists, sets anchor to end furthest from x,y 125 # changes anchor only, not insert 126 } 127 set tk::Priv(selectMode) char 128 ntext::TextSelectTo %W %x %y 129 } 130 set ::ntext::Bcount 2 131 set tk::Priv(selectMode) word 132 ntext::TextSelectTo %W %x %y 1 133} 134# ignore an out-of-order triple click. This has no adverse consequences. 135bind Ntext <Triple-Shift-1> { 136 if {$::ntext::Bcount != 2} { 137 continue 138 } 139 set ::ntext::Bcount 3 140 set tk::Priv(selectMode) line 141 ntext::TextSelectTo %W %x %y 142} 143# don't care if a quadruple click is out-of-order (i.e. follows a quadruple 144# click, not a triple click). 145bind Ntext <Quadruple-Shift-1> { 146 set ::ntext::Bcount 4 147} 148bind Ntext <B1-Leave> { 149 set tk::Priv(x) %x 150 set tk::Priv(y) %y 151 ntext::TextAutoScan %W 152} 153bind Ntext <B1-Enter> { 154 tk::CancelRepeat 155} 156bind Ntext <ButtonRelease-1> { 157 tk::CancelRepeat 158} 159bind Ntext <Control-1> { 160 %W mark set insert @%x,%y 161 if {[%W cget -autoseparators]} { 162 %W edit separator 163 } 164} 165bind Ntext <Double-Control-1> { # nothing } 166bind Ntext <Control-B1-Motion> { # nothing } 167bind Ntext <Left> { 168 tk::TextSetCursor %W insert-1displayindices 169} 170bind Ntext <Right> { 171 tk::TextSetCursor %W insert+1displayindices 172} 173bind Ntext <Up> { 174 tk::TextSetCursor %W [tk::TextUpDownLine %W -1] 175} 176bind Ntext <Down> { 177 tk::TextSetCursor %W [tk::TextUpDownLine %W 1] 178} 179bind Ntext <Shift-Left> { 180 tk::TextKeySelect %W [%W index {insert - 1displayindices}] 181} 182bind Ntext <Shift-Right> { 183 tk::TextKeySelect %W [%W index {insert + 1displayindices}] 184} 185bind Ntext <Shift-Up> { 186 tk::TextKeySelect %W [tk::TextUpDownLine %W -1] 187} 188bind Ntext <Shift-Down> { 189 tk::TextKeySelect %W [tk::TextUpDownLine %W 1] 190} 191bind Ntext <Control-Left> { 192 tk::TextSetCursor %W \ 193 [tk::TextPrevPos %W insert ntext::new_startOfPreviousWord] 194} 195bind Ntext <Control-Right> { 196 tk::TextSetCursor %W [ntext::TextNextWord %W insert] 197} 198bind Ntext <Control-Up> { 199 tk::TextSetCursor %W [tk::TextPrevPara %W insert] 200} 201bind Ntext <Control-Down> { 202 tk::TextSetCursor %W [tk::TextNextPara %W insert] 203} 204bind Ntext <Shift-Control-Left> { 205 tk::TextKeySelect %W \ 206 [tk::TextPrevPos %W insert ntext::new_startOfPreviousWord] 207} 208bind Ntext <Shift-Control-Right> { 209 tk::TextKeySelect %W [ntext::TextNextWord %W insert] 210} 211bind Ntext <Shift-Control-Up> { 212 tk::TextKeySelect %W [tk::TextPrevPara %W insert] 213} 214bind Ntext <Shift-Control-Down> { 215 tk::TextKeySelect %W [tk::TextNextPara %W insert] 216} 217bind Ntext <Prior> { 218 tk::TextSetCursor %W [ntext::TextScrollPages %W -1 preScroll] 219} 220bind Ntext <Shift-Prior> { 221 tk::TextKeySelect %W [ntext::TextScrollPages %W -1 preScroll] 222} 223bind Ntext <Next> { 224 tk::TextSetCursor %W [ntext::TextScrollPages %W 1 preScroll] 225} 226bind Ntext <Shift-Next> { 227 tk::TextKeySelect %W [ntext::TextScrollPages %W 1 preScroll] 228} 229bind Ntext <Control-Prior> { 230 %W xview scroll -1 page 231} 232bind Ntext <Control-Next> { 233 %W xview scroll 1 page 234} 235 236bind Ntext <Home> { 237 tk::TextSetCursor %W [::ntext::HomeIndex %W insert] 238} 239bind Ntext <Shift-Home> { 240 tk::TextKeySelect %W [::ntext::HomeIndex %W insert] 241} 242bind Ntext <End> { 243 tk::TextSetCursor %W [::ntext::EndIndex %W insert] 244} 245bind Ntext <Shift-End> { 246 tk::TextKeySelect %W [::ntext::EndIndex %W insert] 247} 248bind Ntext <Control-Home> { 249 tk::TextSetCursor %W 1.0 250} 251bind Ntext <Control-Shift-Home> { 252 tk::TextKeySelect %W 1.0 253} 254bind Ntext <Control-End> { 255 tk::TextSetCursor %W {end - 1 indices} 256} 257bind Ntext <Control-Shift-End> { 258 tk::TextKeySelect %W {end - 1 indices} 259} 260 261bind Ntext <Tab> { 262 if {[%W cget -state] eq "normal"} { 263 ntext::TextInsert %W \t 264 focus %W 265 break 266 } 267} 268bind Ntext <Shift-Tab> { 269 # Needed only to keep <Tab> binding from triggering; doesn't 270 # have to actually do anything. 271 break 272} 273bind Ntext <Control-Tab> { 274 focus [tk_focusNext %W] 275} 276bind Ntext <Control-Shift-Tab> { 277 focus [tk_focusPrev %W] 278} 279bind Ntext <Control-i> { 280 if {$::ntext::classicExtras} { 281 ntext::TextInsert %W \t 282 } 283} 284bind Ntext <Return> { 285 ntext::TextInsert %W \n 286 if {[%W cget -autoseparators]} { 287 %W edit separator 288 } 289} 290bind Ntext <Delete> { 291 if {[%W tag nextrange sel 1.0 end] ne ""} { 292 set ::ntext::OldFirst [%W index sel.first] 293 %W delete sel.first sel.last 294 ntext::AdjustIndentOneLine %W $::ntext::OldFirst 295 } else { 296 %W delete insert 297 ntext::AdjustIndentOneLine %W insert 298 %W see insert 299 } 300} 301bind Ntext <BackSpace> { 302 if {[%W tag nextrange sel 1.0 end] ne ""} { 303 set ::ntext::OldFirst [%W index sel.first] 304 %W delete sel.first sel.last 305 ntext::AdjustIndentOneLine %W $::ntext::OldFirst 306 } elseif {[%W compare insert != 1.0]} { 307 %W delete insert-1c 308 ntext::AdjustIndentOneLine %W insert 309 %W see insert 310 } 311} 312 313bind Ntext <Control-space> { 314 if {$::ntext::classicExtras} { 315 %W mark set tk::anchor%W insert 316 } 317} 318bind Ntext <Select> { 319 %W mark set tk::anchor%W insert 320} 321bind Ntext <Control-Shift-space> { 322 if {$::ntext::classicExtras} { 323 set tk::Priv(selectMode) char 324 tk::TextKeyExtend %W insert 325 } 326} 327bind Ntext <Shift-Select> { 328 set tk::Priv(selectMode) char 329 tk::TextKeyExtend %W insert 330} 331bind Ntext <Control-slash> { 332 %W tag add sel 1.0 end 333} 334bind Ntext <Control-backslash> { 335 %W tag remove sel 1.0 end 336 if {[%W cget -autoseparators]} { 337 %W edit separator 338 } 339} 340bind Ntext <<Cut>> { 341 ntext::new_textCut %W 342} 343bind Ntext <<Copy>> { 344 tk_textCopy %W 345} 346bind Ntext <<Paste>> { 347 ntext::new_textPaste %W 348} 349bind Ntext <<Clear>> { 350 if {[%W tag nextrange sel 1.0 end] ne ""} { 351 set ::ntext::OldFirst [%W index sel.first] 352 %W delete sel.first sel.last 353 ntext::AdjustIndentOneLine %W $::ntext::OldFirst 354 } 355} 356bind Ntext <<PasteSelection>> { 357 if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] 358 || !$tk::Priv(mouseMoved)} { 359 ntext::TextPasteSelection %W %x %y 360 } 361} 362# Implement Insert/Overwrite modes 363bind Ntext <Insert> { 364 set ntext::overwrite [expr !$ntext::overwrite] 365# This behaves strangely on a newline or tab: 366# %W configure -blockcursor $ntext::overwrite 367 if {$ntext::overwrite} { 368 %W configure -insertbackground red 369 } else { 370 %W configure -insertbackground black 371 } 372} 373bind Ntext <KeyPress> { 374 ntext::TextInsert %W %A 375} 376 377# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. 378# Otherwise, if a widget binding for one of these is defined, the 379# <KeyPress> class binding will also fire and insert the character, 380# which is wrong. 381 382bind Ntext <Alt-KeyPress> {# nothing } 383bind Ntext <Meta-KeyPress> {# nothing} 384bind Ntext <Control-KeyPress> {# nothing} 385# Make Escape clear the selection 386bind Ntext <Escape> { 387 %W tag remove sel 0.0 end 388 if {[%W cget -autoseparators]} { 389 %W edit separator 390 } 391} 392bind Ntext <KP_Enter> {# nothing} 393if {[tk windowingsystem] eq "aqua"} { 394 bind Ntext <Command-KeyPress> {# nothing} 395} 396 397# Additional emacs-like bindings: 398 399bind Ntext <Control-a> { 400 if {$::ntext::classicExtras && !$tk_strictMotif} { 401 tk::TextSetCursor %W {insert display linestart} 402 } 403} 404bind Ntext <Control-b> { 405 if {$::ntext::classicExtras && !$tk_strictMotif} { 406 tk::TextSetCursor %W insert-1displayindices 407 } 408} 409bind Ntext <Control-d> { 410 if {$::ntext::classicExtras && !$tk_strictMotif} { 411 %W delete insert 412 ntext::AdjustIndentOneLine %W insert 413 } 414} 415bind Ntext <Control-e> { 416 if {$::ntext::classicExtras && !$tk_strictMotif} { 417 tk::TextSetCursor %W {insert display lineend} 418 } 419} 420bind Ntext <Control-f> { 421 if {$::ntext::classicExtras && !$tk_strictMotif} { 422 tk::TextSetCursor %W insert+1displayindices 423 } 424} 425bind Ntext <Control-k> { 426 if {$::ntext::classicExtras && !$tk_strictMotif} { 427 if {[%W compare insert == {insert lineend}]} { 428 %W delete insert 429 } else { 430 %W delete insert {insert lineend} 431 } 432 ntext::AdjustIndentOneLine %W insert 433 } 434} 435bind Ntext <Control-n> { 436 if {$::ntext::classicExtras && !$tk_strictMotif} { 437 tk::TextSetCursor %W [tk::TextUpDownLine %W 1] 438 } 439} 440bind Ntext <Control-o> { 441 if {$::ntext::classicExtras && !$tk_strictMotif} { 442 %W insert insert \n 443 %W mark set insert insert-1c 444 ntext::AdjustIndentOneLine %W "insert + 1 line" 445 } 446} 447bind Ntext <Control-p> { 448 if {$::ntext::classicExtras && !$tk_strictMotif} { 449 tk::TextSetCursor %W [tk::TextUpDownLine %W -1] 450 } 451} 452bind Ntext <Control-t> { 453 if {$::ntext::classicExtras && !$tk_strictMotif} { 454 ntext::TextTranspose %W 455 } 456} 457 458bind Ntext <<Undo>> { 459 # An Undo operation may remove the separator at the top of the Undo stack. 460 # Then the item at the top of the stack gets merged with the subsequent changes. 461 # Place separators before and after Undo to prevent this. 462 if {[%W cget -autoseparators]} { 463 %W edit separator 464 } 465 if {![catch { %W edit undo }]} { 466 # the undo stack does not record tags - so we need to reapply them 467 ntext::AdjustIndentMultipleLines %W 1.0 end 468 } 469 if {[%W cget -autoseparators]} { 470 %W edit separator 471 } 472} 473 474bind Ntext <<Redo>> { 475 if {![catch { %W edit redo }]} { 476 # the redo stack does not record tags - so we need to reapply them 477 ntext::AdjustIndentMultipleLines %W 1.0 end 478 } 479} 480 481bind Ntext <Meta-b> { 482 if {!$tk_strictMotif} { 483 tk::TextSetCursor %W \ 484 [tk::TextPrevPos %W insert ntext::new_startOfPreviousWord] 485 } 486} 487bind Ntext <Meta-d> { 488 if {!$tk_strictMotif} { 489 %W delete insert [ntext::TextNextWord %W insert] 490 } 491 ntext::AdjustIndentOneLine %W insert 492} 493bind Ntext <Meta-f> { 494 if {!$tk_strictMotif} { 495 tk::TextSetCursor %W [ntext::TextNextWord %W insert] 496 } 497} 498bind Ntext <Meta-less> { 499 if {!$tk_strictMotif} { 500 tk::TextSetCursor %W 1.0 501 } 502} 503bind Ntext <Meta-greater> { 504 if {!$tk_strictMotif} { 505 tk::TextSetCursor %W end-1c 506 } 507} 508bind Ntext <Meta-BackSpace> { 509 if {!$tk_strictMotif} { 510 %W delete \ 511 [tk::TextPrevPos %W insert ntext::new_startOfPreviousWord] insert 512 } 513 ntext::AdjustIndentOneLine %W insert 514} 515bind Ntext <Meta-Delete> { 516 if {!$tk_strictMotif} { 517 %W delete \ 518 [tk::TextPrevPos %W insert ntext::new_startOfPreviousWord] insert 519 } 520 ntext::AdjustIndentOneLine %W insert 521} 522 523# Macintosh only bindings: 524 525if {[tk windowingsystem] eq "aqua"} { 526bind Ntext <Option-Left> { 527 tk::TextSetCursor %W \ 528 [tk::TextPrevPos %W insert ntext::new_startOfPreviousWord] 529} 530bind Ntext <Option-Right> { 531 tk::TextSetCursor %W [ntext::TextNextWord %W insert] 532} 533bind Ntext <Option-Up> { 534 tk::TextSetCursor %W [tk::TextPrevPara %W insert] 535} 536bind Ntext <Option-Down> { 537 tk::TextSetCursor %W [tk::TextNextPara %W insert] 538} 539bind Ntext <Shift-Option-Left> { 540 tk::TextKeySelect %W \ 541 [tk::TextPrevPos %W insert ntext::new_startOfPreviousWord] 542} 543bind Ntext <Shift-Option-Right> { 544 tk::TextKeySelect %W [ntext::TextNextWord %W insert] 545} 546bind Ntext <Shift-Option-Up> { 547 tk::TextKeySelect %W [tk::TextPrevPara %W insert] 548} 549bind Ntext <Shift-Option-Down> { 550 tk::TextKeySelect %W [tk::TextNextPara %W insert] 551} 552# ntext::TextScrollPages is probably not what is needed here, because 553# tk::TextScrollPages only scrolls, and relies on the calling code to set the 554# insert mark. Keep the old functionality. 555# Don't Mac users need to scroll up as well as down? 556# Feedback from Mac users please. 557bind Ntext <Control-v> { 558# tk::TextScrollPages %W 1 559 %W yview scroll 1 pages 560} 561 562# End of Mac only bindings 563} 564 565# A few additional bindings of my own. 566 567bind Ntext <Control-h> { 568 if {$::ntext::classicExtras && (!$tk_strictMotif) 569 && [%W compare insert != 1.0]} { 570 %W delete insert-1c 571 %W see insert 572 ntext::AdjustIndentOneLine %W insert 573 } 574} 575bind Ntext <2> { 576 if {!$tk_strictMotif} { 577 tk::TextScanMark %W %x %y 578 } 579} 580bind Ntext <B2-Motion> { 581 if {!$tk_strictMotif} { 582 tk::TextScanDrag %W %x %y 583 } 584} 585set ::tk::Priv(prevPos) {} 586 587# The MouseWheel will typically only fire on Windows and MacOS X. 588# However, someone could use the "event generate" command to produce one 589# on other platforms. We must be careful not to round -ve values of %D 590# down to zero. 591 592if {[tk windowingsystem] eq "aqua"} { 593 bind Ntext <MouseWheel> { 594 %W yview scroll [expr {-15 * (%D)}] pixels 595 } 596 bind Ntext <Option-MouseWheel> { 597 %W yview scroll [expr {-150 * (%D)}] pixels 598 } 599 bind Ntext <Shift-MouseWheel> { 600 %W xview scroll [expr {-15 * (%D)}] pixels 601 } 602 bind Ntext <Shift-Option-MouseWheel> { 603 %W xview scroll [expr {-150 * (%D)}] pixels 604 } 605} else { 606 # We must make sure that positive and negative movements are rounded 607 # equally to integers, avoiding the problem that 608 # (int)1/3 = 0, 609 # but 610 # (int)-1/3 = -1 611 # The following code ensure equal +/- behaviour. 612 bind Ntext <MouseWheel> { 613 if {%D >= 0} { 614 %W yview scroll [expr {-%D/3}] pixels 615 } else { 616 %W yview scroll [expr {(2-%D)/3}] pixels 617 } 618 } 619} 620 621if {"x11" eq [tk windowingsystem]} { 622 # Support for mousewheels on Linux/Unix commonly comes through mapping 623 # the wheel to the extended buttons. If you have a mousewheel, find 624 # Linux configuration info at: 625 # http://www.inria.fr/koala/colas/mouse-wheel-scroll/ 626 bind Ntext <4> { 627 if {!$tk_strictMotif} { 628 %W yview scroll -50 pixels 629 } 630 } 631 bind Ntext <5> { 632 if {!$tk_strictMotif} { 633 %W yview scroll 50 pixels 634 } 635 } 636} 637 638bind Ntext <Configure> { 639 ::ntext::AdjustIndentMultipleLines %W 1.0 end 640} 641 642 643##### End of bindings. Now define the namespace and its variables. 644 645 646namespace eval ::ntext { 647 648# Variables that control the behaviour of certain bindings and may be changed 649# by the user's script 650# Set to 1 for "classic Text" style (the Tcl/Tk defaults), 0 for "Ntext" style 651 652# Whether Shift-Button-1 has a variable or fixed anchor 653variable classicAnchor 0 654 655# Whether to activate certain traditional "extra" bindings 656variable classicExtras 0 657 658# Whether Shift-Button-1 ignores changes made by the keyboard to the insert 659# mark 660variable classicMouseSelect 0 661 662# Type of word-boundary search 663variable classicWordBreak 0 664 665# Whether to use -lmargin2 to align the wrapped display lines with their 666# own first display line 667variable classicWrap 1 668 669# Advanced use (see man page): align to this character on the first display 670# line 671variable newWrapRegexp {[^[:space:]]} 672 673# Variable that sets overwrite/insert mode: may be changed by the user's script 674# but is normally controlled by a binding to <KeyPress-Insert> 675variable overwrite 0 676 677# Debugging aid for developers: sets the background color for each logical line 678# according to the magnitude of its hanging (-lmargin2) indent. 679variable lm2IndentDebug 0 680 681# Variables that will hold regexp's for word boundary detection 682 683variable tcl_match_wordBreakAfter 684variable tcl_match_wordBreakBefore 685variable tcl_match_endOfWord 686variable tcl_match_startOfNextWord 687variable tcl_match_startOfPreviousWord 688 689 690# These variables are for internal use by ntext only. They should not be 691# modified by the user's script. 692variable Bcount 0 693variable OldFirst {} 694 695 696} 697 698##### End of namespace definition. Now define the procs. 699 700# ::tk::TextClosestGap -- 701# Given x and y coordinates, this procedure finds the closest boundary 702# between characters to the given coordinates and returns the index 703# of the character just after the boundary. 704# 705# Arguments: 706# w - The text window. 707# x - X-coordinate within the window. 708# y - Y-coordinate within the window. 709 710# ::ntext::TextClosestGap is copied from ::tk with modifications: 711# modified to fix the jump-to-next-line issue. 712 713proc ::ntext::TextClosestGap {w x y} { 714 set pos [$w index @$x,$y] 715 set bbox [$w bbox $pos] 716 if {$bbox eq ""} { 717 return $pos 718 } 719 if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { 720 return $pos 721 } 722 # Never return a position that will place the cursor on the next display 723 # line. This used to happen if $x is closer to the end of the display line 724 # than to its last character. 725 if {[$w cget -wrap] eq "word"} { 726 set lineType displaylines 727 } else { 728 set lineType lines 729 } 730 if {[$w count -$lineType $pos "$pos + 1 char"] != 0} { 731 return $pos 732 } else { 733 } 734 $w index "$pos + 1 char" 735} 736 737# ::tk::TextButton1 -- 738# This procedure is invoked to handle button-1 presses in text 739# widgets. It moves the insertion cursor, sets the selection anchor, 740# and claims the input focus. 741# 742# Arguments: 743# w - The text window in which the button was pressed. 744# x - The x-coordinate of the button press. 745# y - The x-coordinate of the button press. 746 747# ::ntext::TextButton1 is copied from ::tk with no modifications: 748# so it calls functions in ::ntext, not ::tk 749 750proc ::ntext::TextButton1 {w x y} { 751 variable ::tk::Priv 752 753 set Priv(selectMode) char 754 set Priv(mouseMoved) 0 755 set Priv(pressX) $x 756 $w mark set insert [TextClosestGap $w $x $y] 757 $w mark set tk::anchor$w insert 758 # Set the anchor mark's gravity depending on the click position 759 # relative to the gap 760 set bbox [$w bbox [$w index tk::anchor$w]] 761 if {$x > [lindex $bbox 0]} { 762 $w mark gravity tk::anchor$w right 763 } else { 764 $w mark gravity tk::anchor$w left 765 } 766 # Allow focus in any case on Windows, because that will let the 767 # selection be displayed even for state disabled text widgets. 768 if {$::tcl_platform(platform) eq "windows" \ 769 || [$w cget -state] eq "normal"} { 770 focus $w 771 } 772 if {[$w cget -autoseparators]} { 773 $w edit separator 774 } 775} 776 777# ::tk::TextSelectTo -- 778# This procedure is invoked to extend the selection, typically when 779# dragging it with the mouse. Depending on the selection mode (character, 780# word, line) it selects in different-sized units. This procedure 781# ignores mouse motions initially until the mouse has moved from 782# one character to another or until there have been multiple clicks. 783# 784# Note that the 'anchor' is implemented programmatically using 785# a text widget mark, and uses a name that will be unique for each 786# text widget (even when there are multiple peers). Currently the 787# anchor is considered private to Tk, hence the name 'tk::anchor$w'. 788# 789# Arguments: 790# w - The text window in which the button was pressed. 791# x - Mouse x position. 792# y - Mouse y position. 793 794# ::ntext::TextSelectTo is copied from ::tk with modifications: 795# modified to prevent word selection from crossing a line end. 796 797proc ::ntext::TextSelectTo {w x y {extend 0}} { 798 global tcl_platform 799 variable ::tk::Priv 800 801 set cur [TextClosestGap $w $x $y] 802 if {[catch {$w index tk::anchor$w}]} { 803 $w mark set tk::anchor$w $cur 804 } 805 set anchor [$w index tk::anchor$w] 806 if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} { 807 set Priv(mouseMoved) 1 808 } 809 switch -- $Priv(selectMode) { 810 char { 811 if {[$w compare $cur < tk::anchor$w]} { 812 set first $cur 813 set last tk::anchor$w 814 } else { 815 set first tk::anchor$w 816 set last $cur 817 } 818 } 819 word { 820 # Set initial range based only on the anchor (1 char min width - 821 # MOD - unless this straddles a display line end) 822 if {[$w cget -wrap] eq "word"} { 823 set lineType displaylines 824 } else { 825 set lineType lines 826 } 827 if {[$w mark gravity tk::anchor$w] eq "right"} { 828 set first "tk::anchor$w" 829 set last "tk::anchor$w + 1c" 830 if {[$w count -$lineType $first $last] != 0} { 831 set last $first 832 } else { 833 } 834 } else { 835 set first "tk::anchor$w - 1c" 836 set last "tk::anchor$w" 837 if {[$w count -$lineType $first $last] != 0} { 838 set first $last 839 } else { 840 } 841 } 842 if {($last eq $first) && ([$w index $first] eq $cur)} { 843 # Use $first and $last as above; further extension will straddle 844 # a display line. Better to have no selection than a bad one. 845 } else { 846 # Extend range (if necessary) based on the current point 847 if {[$w compare $cur < $first]} { 848 set first $cur 849 } elseif {[$w compare $cur > $last]} { 850 set last $cur 851 } 852 853 # Now find word boundaries 854 set first1 [$w index "$first + 1c"] 855 set last1 [$w index "$last - 1c"] 856 if {[$w count -$lineType $first $first1] != 0} { 857 set first1 [$w index $first] 858 } else { 859 } 860 if {[$w count -$lineType $last $last1] != 0} { 861 set last1 [$w index $last] 862 } else { 863 } 864 set first2 [::tk::TextPrevPos $w "$first1" \ 865 ntext::new_wordBreakBefore] 866 set last2 [::tk::TextNextPos $w "$last1" \ 867 ntext::new_wordBreakAfter] 868 # Don't allow a "word" to straddle a display line boundary (or, 869 # in -wrap char mode, a logical line boundary). This is not the 870 # right result if -wrap word has been forced into -wrap char 871 # because a word is too long. 872 if {[$w count -$lineType $first2 $first] != 0} { 873 set first [$w index "$first display linestart"] 874 } else { 875 set first $first2 876 } 877 if {[$w count -$lineType $last2 $last] != 0} { 878 set last [$w index "$last display lineend"] 879 } else { 880 set last $last2 881 } 882 } 883 } 884 line { 885 # Set initial range based only on the anchor 886 set first "tk::anchor$w linestart" 887 set last "tk::anchor$w lineend" 888 889 # Extend range (if necessary) based on the current point 890 if {[$w compare $cur < $first]} { 891 set first "$cur linestart" 892 } elseif {[$w compare $cur > $last]} { 893 set last "$cur lineend" 894 } 895 set first [$w index $first] 896 set last [$w index "$last + 1c"] 897 } 898 } 899 if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} { 900 $w tag remove sel 0.0 end 901 $w mark set insert $cur 902 $w tag add sel $first $last 903 $w tag remove sel $last end 904 update idletasks 905 } 906} 907 908 909# ::tk::TextKeyExtend -- called without modification 910 911# ::tk::TextPasteSelection -- 912# This procedure sets the insertion cursor to the mouse position, 913# inserts the selection, and sets the focus to the window. 914# 915# Arguments: 916# w - The text window. 917# x, y - Position of the mouse. 918 919# ::ntext::TextPasteSelection is copied from ::tk with modifications: 920# modified to set oldInsert and call AdjustIndentMultipleLines. 921 922proc ::ntext::TextPasteSelection {w x y} { 923 $w mark set insert [TextClosestGap $w $x $y] 924 set oldInsert [$w index insert] 925 if {![catch {::tk::GetSelection $w PRIMARY} sel]} { 926 set oldSeparator [$w cget -autoseparators] 927 if {$oldSeparator} { 928 $w configure -autoseparators 0 929 $w edit separator 930 } 931 $w insert insert $sel 932 AdjustIndentMultipleLines $w $oldInsert insert 933 if {$oldSeparator} { 934 $w edit separator 935 $w configure -autoseparators 1 936 } 937 } 938 if {[$w cget -state] eq "normal"} { 939 focus $w 940 } 941} 942 943 944# ::tk::TextAutoScan -- 945# This procedure is invoked when the mouse leaves a text window 946# with button 1 down. It scrolls the window up, down, left, or right, 947# depending on where the mouse is (this information was saved in 948# ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after" 949# command so that the window continues to scroll until the mouse 950# moves back into the window or the mouse button is released. 951# 952# Arguments: 953# w - The text window. 954 955# ::ntext::TextAutoScan is copied from ::tk with modifications: 956# chiefly so it calls ::ntext::TextSelectTo not ::tk::TextSelectTo 957# modified so it calls itself and not ::tk::TextAutoScan 958 959proc ::ntext::TextAutoScan {w} { 960 variable ::tk::Priv 961 if {![winfo exists $w]} { 962 return 963 } 964 if {$Priv(y) >= [winfo height $w]} { 965 $w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels 966 } elseif {$Priv(y) < 0} { 967 $w yview scroll [expr {-1 + $Priv(y)}] pixels 968 } elseif {$Priv(x) >= [winfo width $w]} { 969 $w xview scroll 2 units 970 } elseif {$Priv(x) < 0} { 971 $w xview scroll -2 units 972 } else { 973 return 974 } 975 TextSelectTo $w $Priv(x) $Priv(y) 976 set Priv(afterId) [after 50 [list ntext::TextAutoScan $w]] 977} 978 979# ::tk::TextSetCursor -- called without modification 980 981# ::tk::TextKeySelect -- called without modification 982 983# ::tk::TextResetAnchor -- called without modification 984 985# ::tk::TextInsert -- 986# Insert a string into a text at the point of the insertion cursor. 987# If there is a selection in the text, and it covers the point of the 988# insertion cursor, then delete the selection before inserting. 989# 990# Arguments: 991# w - The text window in which to insert the string 992# s - The string to insert (usually just a single character) 993 994# ::ntext::TextInsert is copied from ::tk with modifications: 995# modified to implement Insert/Overwrite and to call AdjustIndentOneLine 996# combine nested 'if' statements to avoid repetition of 'else' code 997 998proc ::ntext::TextInsert {w s} { 999 if {($s eq "") || ([$w cget -state] eq "disabled")} { 1000 return 1001 } 1002 set compound 0 1003 if {[llength [set range [$w tag ranges sel]]] && 1004 [$w compare [lindex $range 0] <= insert] && 1005 [$w compare [lindex $range end] >= insert]} { 1006 1007 set oldSeparator [$w cget -autoseparators] 1008 if {$oldSeparator} { 1009 $w configure -autoseparators 0 1010 $w edit separator 1011 set compound 1 1012 } 1013 $w delete [lindex $range 0] [lindex $range end] 1014 } elseif {$::ntext::overwrite && ($s ne "\n") && ($s ne "\t") && 1015 ([$w get insert] ne "\n")} { 1016 set oldSeparator [$w cget -autoseparators] 1017 if {$oldSeparator} { 1018 $w configure -autoseparators 0 1019 $w edit separator 1020 set compound 1 1021 # When undoing an overwrite, the insert mark is left 1022 # in the "wrong" place - after and not before the change. 1023 # Some non-Tk editors do this too. 1024 } 1025 $w delete insert 1026 } 1027 $w insert insert $s 1028 AdjustIndentOneLine $w insert 1029 $w see insert 1030 if {$compound && $oldSeparator} { 1031 $w edit separator 1032 $w configure -autoseparators 1 1033 } 1034} 1035 1036# ::tk::TextUpDownLine -- called without modification 1037 1038# ::tk::TextPrevPara -- called without modification 1039 1040# ::tk::TextNextPara -- called without modification 1041 1042# ::tk::TextScrollPages -- 1043# This is a utility procedure used in bindings for moving up and down 1044# pages and possibly extending the selection along the way. It scrolls 1045# the view in the widget by the number of pages, and it returns the 1046# index of the character that is at the same position in the new view 1047# as the insertion cursor used to be in the old view. 1048# 1049# Arguments: 1050# w - The text window in which the cursor is to move. 1051# count - Number of pages forward to scroll; may be negative 1052# to scroll backwards. 1053 1054# ::ntext::TextScrollPages is called like ::tk::TextScrollPages, but is 1055# completely rewritten, and behaves differently. 1056# 1057# ::tk::TextScrollPages scrolls the widget, and returns an index (a new value 1058# for the insert mark); if the mark was on-screen before the scroll, 1059# ::tk::TextScrollPages tries to return an index that keeps it in the same 1060# screen position. 1061# 1062# ::ntext::TextScrollPages takes a slightly different approach: 1063# like ::tk::TextScrollPages, it returns an index (a new value for the insert 1064# mark), and lets the calling code decide whether to move the mark. 1065# Unlike ::tk::TextScrollPages, when called with two arguments it does no 1066# scrolling - it relies on the calling code to do the scrolling, which in 1067# practice is usually when it tries to 'see' the returned index value. 1068# 1069# By focussing on the insert mark, ::ntext::TextScrollPages has the 1070# following useful features: 1071# - When the slack is less than one page, it "moves" the insert mark as far 1072# as possible. 1073# - When there is no slack, it "moves" the insert mark to the start/end of 1074# the widget. 1075# - It uses ::tk::TextUpDownLine to remember the initial x-value. 1076# 1077# When called with three arguments, 3rd argument = "preScroll", then, if the 1078# new position of the insert mark is off-screen, ::ntext::TextScrollPages 1079# will scroll the widget, to try to make the calling code's "see" move the 1080# returned index value to the middle, not the edge, of the widget. This 1081# feature is most useful in widgets with only a few visible lines, where it 1082# prevents successive calls from moving the insert mark between the middle and 1083# the edge of the widget. 1084 1085proc ::ntext::TextScrollPages {w count {help ""}} { 1086 set spareLines 1 ;# adjustable 1087 1088 set oldInsert [$w index insert] 1089 set count [expr {int($count)}] 1090 if {$count == 0} { 1091 return $oldInsert 1092 } 1093 set visibleLines [$w count -displaylines @0,0 @0,20000] 1094 if {$visibleLines > $spareLines} { 1095 set pageLines [expr {$visibleLines - $spareLines}] 1096 } else { 1097 set pageLines 1 1098 } 1099 set newInsert [::tk::TextUpDownLine $w [expr {$pageLines * $count}]] 1100 if {[$w compare $oldInsert != $newInsert]} { 1101 set finalInsert $newInsert 1102 } elseif {$count < 0} { 1103 set finalInsert 1.0 1104 } else { 1105 set finalInsert [$w index "end -1 char"] 1106 } 1107 if {($help eq "preScroll") && ([$w bbox $finalInsert] eq "")} { 1108 # If $finalInsert is offscreen, try to put it in the middle 1109 if { [$w count -displaylines 1.0 $finalInsert] > \ 1110 [$w count -displaylines $finalInsert end]} { 1111 $w see 1.0 1112 } else { 1113 $w see end 1114 } 1115 $w see $finalInsert 1116 } 1117 return $finalInsert 1118} 1119 1120# ::tk::TextTranspose -- 1121# This procedure implements the "transpose" function for text widgets. 1122# It tranposes the characters on either side of the insertion cursor, 1123# unless the cursor is at the end of the line. In this case it 1124# transposes the two characters to the left of the cursor. In either 1125# case, the cursor ends up to the right of the transposed characters. 1126# 1127# Arguments: 1128# w - Text window in which to transpose. 1129 1130# ::ntext::TextTranspose is copied from ::tk::TextTranspose with modifications: 1131# modified to call AdjustIndentOneLine. 1132# rename local variable autosep to oldSeparator for uniformity with other procs 1133 1134proc ::ntext::TextTranspose w { 1135 set pos insert 1136 if {[$w compare $pos != "$pos lineend"]} { 1137 set pos [$w index "$pos + 1 char"] 1138 } 1139 set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"] 1140 if {[$w compare "$pos - 1 char" == 1.0]} { 1141 return 1142 } 1143 # ensure this is seen as an atomic op to undo 1144 set oldSeparator [$w cget -autoseparators] 1145 if {$oldSeparator} { 1146 $w configure -autoseparators 0 1147 $w edit separator 1148 } 1149 $w delete "$pos - 2 char" $pos 1150 $w insert insert $new 1151 1152 if {[$w compare insert == "insert linestart"]} { 1153 AdjustIndentOneLine $w "insert - 1 line" 1154 } 1155 AdjustIndentOneLine $w insert 1156 1157 $w see insert 1158 if {$oldSeparator} { 1159 $w edit separator 1160 $w configure -autoseparators 1 1161 } 1162} 1163 1164# ::tk_textCopy -- called without modification 1165 1166# ::tk_textCut -- 1167# This procedure copies the selection from a text widget into the 1168# clipboard, then deletes the selection (if it exists in the given 1169# widget). 1170# 1171# Arguments: 1172# w - Name of a text widget. 1173 1174# ::ntext::new_textCut is copied from ::tk_textCut with modifications: 1175# modified to set LocalOldFirst, call AdjustIndentOneLine, and add autoseparators 1176 1177# LocalOldFirst is never off by one: the final newline of the widget cannot 1178# be deleted. 1179 1180proc ::ntext::new_textCut w { 1181 if {![catch {set data [$w get sel.first sel.last]}]} { 1182 set oldSeparator [$w cget -autoseparators] 1183 if {$oldSeparator} { 1184 $w configure -autoseparators 0 1185 $w edit separator 1186 } 1187 set LocalOldFirst [$w index sel.first] 1188 clipboard clear -displayof $w 1189 clipboard append -displayof $w $data 1190 $w delete sel.first sel.last 1191 AdjustIndentOneLine $w $LocalOldFirst 1192 if {$oldSeparator} { 1193 $w edit separator 1194 $w configure -autoseparators 1 1195 } 1196 } 1197 return 1198} 1199 1200# ::tk_textPaste -- 1201# This procedure pastes the contents of the clipboard to the insertion 1202# point in a text widget. 1203# 1204# Arguments: 1205# w - Name of a text widget. 1206 1207# ::ntext::new_textPaste is copied from ::tk_textPaste with modifications: 1208# - modified to set oldInsert, LocalOldFirst and ntextIndentMark, and call 1209# AdjustIndentMultipleLines. 1210# - modified to behave the same way for X11 as for other windowing systems 1211# - modified to overwrite the selection (if it exists), even if the insert mark 1212# is elsewhere 1213 1214proc ::ntext::new_textPaste w { 1215 set oldInsert [$w index insert] 1216 global tcl_platform 1217 if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { 1218 set oldSeparator [$w cget -autoseparators] 1219 if {$oldSeparator} { 1220 $w configure -autoseparators 0 1221 $w edit separator 1222 } 1223 if {([tk windowingsystem] ne "x11TheOldFashionedWay") && \ 1224 ([$w tag nextrange sel 1.0 end] ne "")} { 1225 set LocalOldFirst [$w index sel.first] 1226 $w mark set ntextIndentMark sel.last 1227 # right gravity mark, survives deletion 1228 $w delete sel.first sel.last 1229 $w insert $LocalOldFirst $sel 1230 AdjustIndentMultipleLines $w $LocalOldFirst ntextIndentMark 1231 } else { 1232 $w insert insert $sel 1233 AdjustIndentMultipleLines $w $oldInsert insert 1234 } 1235 if {$oldSeparator} { 1236 $w edit separator 1237 $w configure -autoseparators 1 1238 } 1239 } 1240 return 1241} 1242 1243# ::tk::TextNextWord -- 1244# Returns the index of the next word position after a given position in the 1245# text. The next word is platform dependent and may be either the next 1246# end-of-word position or the next start-of-word position after the next 1247# end-of-word position. 1248# 1249# Arguments: 1250# w - The text window in which the cursor is to move. 1251# start - Position at which to start search. 1252 1253# ::ntext::TextNextWord is copied from ::tk::TextNextWord with modifications: 1254# modified to use a platform-independent definition: always goes to the start 1255# of the next word. 1256 1257proc ::ntext::TextNextWord {w start} { 1258 ::tk::TextNextPos $w $start ntext::new_startOfNextWord 1259} 1260 1261# ::tk::TextNextPos -- called without modification 1262# ::tk::TextPrevPos -- called without modification 1263# ::tk::TextScanMark -- called without modification 1264# ::tk::TextScanDrag -- called without modification 1265 1266 1267# Two new functions, HomeIndex and EndIndex, that can be used for "smart" Home 1268# and End operations 1269 1270# ::ntext::HomeIndex -- 1271# 1272# Return the index to jump to (from $index) as "Smart Home" 1273# Some corner cases (e.g. lots of leading whitespace, wrapped around) 1274# probably have a better solution; but there's no consensus on how a 1275# text editor should behave in such cases. 1276# 1277# Arguments: 1278# w - Name of a text widget. 1279# index - an index in the widget 1280 1281proc ::ntext::HomeIndex {w index} { 1282 set index [$w index $index] 1283 set dls [$w index "$index display linestart"] 1284 1285 # Set firstNonSpace to the index of the first non-space character on the 1286 # logical line. 1287 set dlsList [split $dls .] 1288 set dlsLine [lindex $dlsList 0] 1289 set lls $dlsLine.0 1290 set firstNonSpace \ 1291 [$w search -regexp -- {[^[:space:]]} \ 1292 $dlsLine.0 [expr {$dlsLine + 1}].0] 1293 1294 # Now massage $firstNonSpace so it contains the "usual" home position on 1295 # the first display line 1296 if {$firstNonSpace eq {}} { 1297 # No non-whitespace characters on the line 1298 set firstNonSpace $dlsLine.0 1299 } elseif {[$w count -displaylines $lls $firstNonSpace] != 0} { 1300 # Either lots of whitespace, or whitespace with character wrap forces 1301 # $firstNonSpace onto the next. 1302 # display line 1303 set firstNonSpace $dlsLine.0 1304 } else { 1305 # The usual case: the first non-whitespace $firstNonSpace is on the 1306 # first display line 1307 } 1308 1309 if {$dls eq $lls} { 1310 # We're on the first display line 1311 if {$index eq $firstNonSpace} { 1312 # we're at the first non-whitespace of the first display line 1313 set home $lls 1314 } else { 1315 # we're on the first display line, but not at the first 1316 # non-whitespace 1317 set home $firstNonSpace 1318 } 1319 } else { 1320 if {$dls eq $index} { 1321 # we're at the start of a display line other than the first 1322 set home $firstNonSpace 1323 } else { 1324 # we're not on the first display line, and we're not at our display 1325 # line's start 1326 set home $dls 1327 } 1328 } 1329 return $home 1330} 1331 1332# ::ntext::EndIndex -- 1333# 1334# Return the index to jump to (from $index) as "Smart End" 1335# 1336# Arguments: 1337# w - Name of a text widget. 1338# index - an index in the widget 1339 1340proc ::ntext::EndIndex {w index} { 1341 set index [$w index $index] 1342 set dle [$w index "$index display lineend"] 1343 1344 if {$dle eq $index} { 1345 # we're at the end of a display line: return the logical line end 1346 return [$w index "$index lineend"] 1347 } else { 1348 # return the display line end 1349 return $dle 1350 } 1351} 1352 1353##### END OF CODE THAT IS MODIFIED text.tcl 1354##### THE CODE ABOVE DEPENDS ON THE PROCS DEFINED BELOW 1355 1356##### START OF CODE FOR WORD BOUNDARY DETECTION 1357 1358# We define ::ntext counterparts for the functions in lib/tcl8.5/word.tcl 1359# such as ::tcl_wordBreakAfter 1360# See man page for discussion of the variables ::tcl_wordchars 1361# and ::tcl_nonwordchars defined in word.tcl 1362 1363# This code block defines the seven namespace procs 1364# createMatchPatterns 1365# initializeMatchPatterns 1366# new_wordBreakAfter 1367# new_wordBreakBefore 1368# new_endOfWord 1369# new_startOfNextWord 1370# new_startOfPreviousWord 1371 1372 1373# ::ntext::createMatchPatterns -- 1374# 1375# This procedure defines the regexp patterns that are used in text 1376# searches, and saves them in namespace variables ::ntext::tcl_match_* 1377# 1378# Each argument should be a regexp expression defining a class of 1379# characters (usually a bracket expression, a class-shorthand escape, 1380# or a single character); the third argument may be omitted, or supplied 1381# as the empty string, in which case it is unused. 1382# 1383# The arguments are analogous to lib/tcl8.5/word.tcl's global variables 1384# tcl_wordchars and tcl_nonwordchars, but are not exposed as global or 1385# namespace variables: instead, the regexp patterns that are used for 1386# the searches are exposed as namespace variables. 1387# 1388# Usually this procedure is called by ::ntext::initializeMatchPatterns 1389# with machine-generated arguments. 1390# 1391# Arguments: 1392# new_nonwordchars - regexp expression for non-word characters 1393# (e.g. whitespace) 1394# new_word1chars - regexp expression for first set of word 1395# characters (e.g. alphanumerics) 1396# new_word2chars - (optional) regexp expression for second set 1397# of word characters (e.g. punctuation) 1398 1399proc ::ntext::createMatchPatterns {new_nonwordchars new_word1chars {new_word2chars {}}} { 1400 1401 variable tcl_match_wordBreakAfter 1402 variable tcl_match_wordBreakBefore 1403 variable tcl_match_endOfWord 1404 variable tcl_match_startOfNextWord 1405 variable tcl_match_startOfPreviousWord 1406 1407 if {$new_word2chars eq {}} { 1408 # With one "non-word" character class, and one "word" class, generate 1409 # the same regexp patterns as Tcl's default search functions: 1410 # The shorthand is based on ntext's default definitions for the 1411 # function arguments: 1412 # "s" $new_nonwordchars (space) 1413 # "w" $new_word1chars (word) 1414 # "p" $new_word2chars (punctuation) 1415 set wordBreakAfter "ws|sw" 1416 set wordBreakBefore "^.*($wordBreakAfter)" 1417 set endOfWord "s*w+s" 1418 set startOfNextWord "w*s+w" 1419 set startOfPreviousWord "s*(w+)s*\$" 1420 } else { 1421 # Generalise to one "non-word" character class, and two "word" classes 1422 set wordBreakAfter "ps|pw|sp|sw|wp|ws" 1423 set wordBreakBefore "^.*($wordBreakAfter)" 1424 set endOfWord "s*w+s|s*w+p|s*p+s|s*p+w" 1425 set startOfNextWord "w*s+w|p*s+w|p+w|w*s+p|p*s+p|w+p" 1426 set startOfPreviousWord "s*(w+)s*\$|p*(w+)s*\$|w*(p+)s*\$|s*(p+)s*\$" 1427 # all tested, the first two with Double-1 1428 # in the last three, note that whitespace is not considered a "word" 1429 # - in endOfWord, note that leading space is acceptable, but not leading 1430 # anything else 1431 # - in startOfNextWord, note that leading characters are acceptable only 1432 # before a space 1433 # - in startOfPreviousWord, note that trailing space is acceptable, but 1434 # - not trailing anything else 1435 # With these rules, generalisation to more classes of characters is 1436 # straightforward. 1437 } 1438 1439 foreach pattern {wordBreakAfter wordBreakBefore endOfWord \ 1440 startOfNextWord startOfPreviousWord} { 1441 # Define the search pattern 1442 set tcl_match_$pattern [string map [list w $new_word1chars p \ 1443 $new_word2chars s $new_nonwordchars] [set $pattern]] 1444 } 1445 return 1446} 1447 1448# ::ntext::initializeMatchPatterns -- 1449# 1450# This procedure calls createMatchPatterns with arguments appropriate for 1451# the values of ::ntext::classicWordBreak and ::tcl_platform(platform). 1452 1453proc ::ntext::initializeMatchPatterns {} { 1454 variable classicWordBreak 1455 if {!$classicWordBreak} { 1456 # ntext style: two classes of word character 1457 set punct {]`|.,:;/~!%&*_+='~[{}^"?()} ;#" keep \ as a word char 1458 set space {[:space:]} 1459 set tcl_punctchars "\[${punct}-\]" 1460 set tcl_spacechars "\[${space}\]" 1461 set tcl_word1chars "\[^${punct}${space}-\]" 1462 } elseif {$::tcl_platform(platform) eq "windows"} { 1463 # Windows style - any but a unicode space char 1464 set tcl_word1chars "\\S" 1465 set tcl_spacechars "\\s" 1466 set tcl_punctchars {} 1467 } else { 1468 # Motif style - any unicode word char (number, letter, or underscore) 1469 set tcl_word1chars "\\w" 1470 set tcl_spacechars "\\W" 1471 set tcl_punctchars {} 1472 } 1473 1474 createMatchPatterns $tcl_spacechars $tcl_word1chars $tcl_punctchars 1475 return 1476} 1477 1478 1479# Now procs derived from those in lib/tcl8.5/word.tcl, Tcl 8.5a5 1480# = ActiveTcl 8.5beta6 1481 1482# tcl_wordBreakAfter -- 1483# 1484# This procedure returns the index of the first word boundary 1485# after the starting point in the given string, or -1 if there 1486# are no more boundaries in the given string. The index returned refers 1487# to the first character of the pair that comprises a boundary. 1488# 1489# Arguments: 1490# str - String to search. 1491# start - Index into string specifying starting point. 1492 1493# ::ntext::new_wordBreakAfter is copied from ::tcl_wordBreakAfter with 1494# modifications: new word-boundary detection rules 1495 1496proc ::ntext::new_wordBreakAfter {str start} { 1497 variable tcl_match_wordBreakAfter 1498 set str [string range $str $start end] 1499 if {[regexp -indices $tcl_match_wordBreakAfter $str result]} { 1500 return [expr {[lindex $result 1] + $start}] 1501 } 1502 return -1 1503} 1504 1505# tcl_wordBreakBefore -- 1506# 1507# This procedure returns the index of the first word boundary 1508# before the starting point in the given string, or -1 if there 1509# are no more boundaries in the given string. The index returned 1510# refers to the second character of the pair that comprises a boundary. 1511# 1512# Arguments: 1513# str - String to search. 1514# start - Index into string specifying starting point. 1515 1516# ::ntext::new_wordBreakBefore is copied from ::tcl_wordBreakBefore with 1517# modifications: new word-boundary detection rules 1518 1519proc ::ntext::new_wordBreakBefore {str start} { 1520 variable tcl_match_wordBreakBefore 1521 if {$start eq "end"} { 1522 set start [string length $str] 1523 } 1524 if {[regexp -indices $tcl_match_wordBreakBefore \ 1525 [string range $str 0 $start] result]} { 1526 return [lindex $result 1] 1527 } 1528 return -1 1529} 1530 1531# tcl_endOfWord -- 1532# 1533# This procedure returns the index of the first end-of-word location 1534# after a starting index in the given string. An end-of-word location 1535# is defined to be the first whitespace character following the first 1536# non-whitespace character after the starting point. Returns -1 if 1537# there are no more words after the starting point. 1538# 1539# Arguments: 1540# str - String to search. 1541# start - Index into string specifying starting point. 1542 1543# ::ntext::new_endOfWord is copied from ::tcl_endOfWord with 1544# modifications: 1545# new word-boundary detection rules 1546 1547proc ::ntext::new_endOfWord {str start} { 1548 variable tcl_match_endOfWord 1549 if {[regexp -indices $tcl_match_endOfWord \ 1550 [string range $str $start end] result]} { 1551 return [expr {[lindex $result 1] + $start}] 1552 } 1553 return -1 1554} 1555 1556# tcl_startOfNextWord -- 1557# 1558# This procedure returns the index of the first start-of-word location 1559# after a starting index in the given string. A start-of-word 1560# location is defined to be a non-whitespace character following a 1561# whitespace character. Returns -1 if there are no more start-of-word 1562# locations after the starting point. 1563# 1564# Arguments: 1565# str - String to search. 1566# start - Index into string specifying starting point. 1567 1568# ::ntext::new_startOfNextWord is copied from ::tcl_startOfNextWord with 1569# modifications: new word-boundary detection rules 1570 1571proc ::ntext::new_startOfNextWord {str start} { 1572 variable tcl_match_startOfNextWord 1573 if {[regexp -indices $tcl_match_startOfNextWord \ 1574 [string range $str $start end] result]} { 1575 return [expr {[lindex $result 1] + $start}] 1576 } 1577 return -1 1578} 1579 1580# tcl_startOfPreviousWord -- 1581# 1582# This procedure returns the index of the first start-of-word location 1583# before a starting index in the given string. 1584# 1585# Arguments: 1586# str - String to search. 1587# start - Index into string specifying starting point. 1588 1589# ::ntext::new_startOfPreviousWord is copied from ::tcl_startOfPreviousWord 1590# with modifications: new word-boundary detection rules 1591 1592proc ::ntext::new_startOfPreviousWord {str start} { 1593 variable tcl_match_startOfPreviousWord 1594 if {$start eq "end"} { 1595 set start [string length $str] 1596 } 1597 if {[regexp -indices \ 1598 $tcl_match_startOfPreviousWord \ 1599 [string range $str 0 [expr {$start - 1}]] result words(1) \ 1600 words(2) words(3) words(4) words(5) words(6) words(7) words(8) \ 1601 words(9) words(10) words(11) words(12) words(13) words(14) \ 1602 words(15) words(16)]} { 1603 set result -1 1604 foreach name [array names words] { 1605 set val [lindex $words($name) 0] 1606 if {$val != -1} { 1607 set result $val 1608 break 1609 } 1610 } 1611 return $result 1612 } 1613 return -1 1614} 1615 1616##### END OF CODE FOR WORD BOUNDARY DETECTION 1617 1618##### START OF CODE TO HANDLE (OPTIONAL) INDENTATION USING -lmargin2 1619 1620# ::ntext::wrapIndent -- 1621# 1622# Procedure to adjust the hanging indent of a text widget. 1623# If indentation is active, i.e. if 1624# ::ntext::classicWrap == 0 and the widget has "-wrap word", 1625# the logical lines specified by the arguments will be indented so that for 1626# each logical line, the start of every wrapped display line is aligned with 1627# the first display line. 1628# If indentation is inactive, the procedure removes any existing indentation. 1629# 1630# This procedure is the only indentation procedure that should be called 1631# by user scripts. It uses -lmargin2 to adjust the hanging indent of lines 1632# in a text widget. 1633# 1634# Call with one argument to adjust the indentation of the entire widget; 1635# with two arguments, to adjust the indentation of a single logical line; 1636# with three arguments, to adjust the indentation of a range of logical lines. 1637# 1638# Arguments: 1639# textWidget - text widget to be indented 1640# index1 - (optional) index in the first logical line to be 1641# indented 1642# index2 - (optional) index in the last logical line to be indented 1643 1644proc ::ntext::wrapIndent {textWidget args} { 1645 variable classicWrap 1646 if {([$textWidget cget -wrap] eq "word") && !$classicWrap} { 1647 if {[llength $args] == 0} { 1648 AdjustIndentMultipleLines $textWidget 1.0 end 1649 } elseif {[llength $args] == 1} { 1650 AdjustIndentOneLine $textWidget [lindex $args 0] 1651 } else { 1652 AdjustIndentMultipleLines $textWidget \ 1653 [lindex $args 0] [lindex $args 1] 1654 } 1655 } else { 1656 if {[llength $args] == 0} { 1657 RemoveIndentMultipleLines $textWidget 1.0 end 1658 } elseif {[llength $args] == 1} { 1659 RemoveIndentOneLine $textWidget [lindex $args 0] 1660 } else { 1661 RemoveIndentMultipleLines $textWidget \ 1662 [lindex $args 0] [lindex $args 1] 1663 } 1664 } 1665 return 1666} 1667 1668# ::ntext::AdjustIndentMultipleLines -- 1669# 1670# Procedure to adjust the hanging indent of multiple logical lines 1671# of a text widget - but only if indentation is active, 1672# i.e. if ::ntext::classicWrap == 0 and the widget has "-wrap word"; 1673# otherwise the procedure does nothing. 1674# 1675# User scripts should call ::ntext::wrapIndent instead. 1676# 1677# Arguments: 1678# textWidget - text widget to be indented 1679# index1 - index in the first logical line to be indented 1680# index2 - index in the last logical line to be indented 1681 1682proc ::ntext::AdjustIndentMultipleLines {textWidget index1 index2} { 1683 # Ensure that each line has precisely one tag whose name begins 1684 # "ntextAlignLM2Indent=", and that this tag covers the whole line; set 1685 # its -lmargin2 value so that for each line, the start of every wrapped 1686 # display line is aligned with the first display line. 1687 variable classicWrap 1688 if {([$textWidget cget -wrap] eq "word") && !$classicWrap} { 1689 if {[$textWidget count -lines $index1 $index2] < 0} { 1690 set index3 $index1 1691 set index1 $index2 1692 set index2 $index3 1693 } 1694 set index1 [$textWidget index "$index1 linestart"] 1695 set index2 [$textWidget index "$index2 linestart"] 1696 for {set index $index1} \ 1697 {$index <= $index2 && [$textWidget compare $index != end]} \ 1698 {set index [$textWidget index "$index + 1 line"]} { 1699 AdjustIndentOneLine $textWidget $index 1700 set oldIndex $index 1701 } 1702 } else { 1703 # indentation not active 1704 } 1705 return 1706} 1707 1708# ::ntext::AdjustIndentOneLine -- 1709# 1710# Procedure to adjust the hanging indent of a single logical line 1711# of a text widget - but only if indentation is active, 1712# i.e. if ::ntext::classicWrap == 0 and the widget has "-wrap word"; 1713# otherwise the procedure does nothing. 1714# 1715# User scripts should call ::ntext::wrapIndent instead. 1716# 1717# Arguments: 1718# textWidget - text widget to be indented 1719# index - index in the logical line to be indented 1720 1721proc ::ntext::AdjustIndentOneLine {textWidget index} { 1722 # Ensure that the line has precisely one tag whose name begins 1723 # "ntextAlignLM2Indent=", and that this tag covers the whole line; set 1724 # its -lmargin2 value so that the start of every wrapped display line 1725 # is aligned with the first display line. 1726 variable classicWrap 1727 if {([$textWidget cget -wrap] eq "word") && !$classicWrap} { 1728 RemoveIndentOneLine $textWidget $index 1729 set pix [HowMuchIndent $textWidget $index] 1730 AddIndent $textWidget $index $pix 1731 } else { 1732 # indentation not active 1733 } 1734 return 1735} 1736 1737# ::ntext::AddIndent -- 1738# 1739# Procedure to set the hanging indent of a single logical line 1740# of a text widget. The line must not already have indentation. 1741# 1742# User scripts should call ::ntext::wrapIndent instead. 1743# 1744# Arguments: 1745# textWidget - text widget to be indented 1746# index - index in the logical line to be indented 1747# pix - number of pixels of indentation 1748 1749proc ::ntext::AddIndent {textWidget index pix} { 1750 # Add a tag with properties "-lmargin2 $pix" to the entire logical line 1751 variable lm2IndentDebug 1752 set lineStart [$textWidget index "$index linestart"] 1753 set nextLineStart [$textWidget index "$lineStart + 1 line"] 1754 set tagName ntextAlignLM2Indent=${pix} 1755 $textWidget tag add $tagName $lineStart $nextLineStart 1756 $textWidget tag configure $tagName -lmargin2 ${pix} 1757 if {$lm2IndentDebug} { 1758 $textWidget tag configure $tagName -background [IntToColor $pix 100] 1759 } 1760 $textWidget tag lower $tagName 1761 return $tagName 1762} 1763 1764# ::ntext::HowMuchIndent -- 1765# 1766# Procedure to measure and return the number of pixels of hanging 1767# indent required by a single logical line of a text widget; 1768# i.e. how many pixels of -lmargin2 indentation does the logical line 1769# need, for alignment with its own first display line? 1770# 1771# User scripts should call ::ntext::wrapIndent instead. 1772# 1773# N.B. This procedure cannot be used before the widget is drawn: it uses 1774# display lines, which the widget calculates only when it is drawn. 1775# 1776# Arguments: 1777# textWidget - text widget to be examined 1778# index - index in the logical line to be examined 1779 1780proc ::ntext::HowMuchIndent {textWidget index} { 1781 variable newWrapRegexp 1782 set lineStart [$textWidget index "$index linestart"] 1783 set secondDispLineStart [$textWidget index "$lineStart + 1 display line"] 1784 # checked that this gives the start of the next display line in 1785 # the *updated* display 1786 set indentTo [$textWidget search -regexp -count matchLen -- \ 1787 $newWrapRegexp $lineStart $secondDispLineStart] 1788 if {$indentTo eq {}} { 1789 set pix 0 1790 } else { 1791 set indentTo [$textWidget index "$indentTo + $matchLen chars - 1 char"] 1792 set pix [$textWidget count -xpixels $lineStart $indentTo] 1793 # -update doesn't work yet for -xpixels: so this line appears to 1794 # assume a fixed-width font: yet it gets the correct result (with or 1795 # without -update) when a tab is inserted. 1796 } 1797 return $pix 1798} 1799 1800# ::ntext::RemoveIndentOneLine -- 1801# 1802# Procedure to remove the hanging indent of a single logical line 1803# of a text widget. It does this regardless of whether indentation 1804# is active, i.e. regardless of the value of ::ntext::classicWrap 1805# 1806# User scripts should call ::ntext::wrapIndent instead. 1807# 1808# Arguments: 1809# textWidget - text widget to be dedented 1810# index - index in the logical line to be dedented 1811 1812proc ::ntext::RemoveIndentOneLine {textWidget index} { 1813 # Remove -lmargin2 indentation, by removing each tag in the 1814 # line whose name begins "ntextAlignLM2Indent=" 1815 1816 set lineStart [$textWidget index "$index linestart"] 1817 set nextLineStart [$textWidget index "$lineStart + 1 line"] 1818 1819 set tagNames [$textWidget tag names $lineStart] 1820 1821 foreach {dum1 tag dum2} [$textWidget dump -tag $lineStart $nextLineStart] { 1822 lappend tagNames $tag 1823 } 1824 1825 # tagNames now holds all tags on this logical line 1826 # Remove the ones that ntext has previously used to set -lmargin2 1827 # These tags' names all begin with the same string. 1828 1829 foreach tag $tagNames { 1830 if {[string range $tag 0 19] eq "ntextAlignLM2Indent="} { 1831 #### puts $tag 1832 $textWidget tag remove $tag $lineStart $nextLineStart 1833 } 1834 } 1835 return 1836} 1837 1838# ::ntext::RemoveIndentMultipleLines -- 1839# 1840# Procedure to remove the hanging indent of multiple logical lines 1841# of a text widget. It does this regardless of whether indentation 1842# is active, i.e. regardless of the value of ::ntext::classicWrap 1843# 1844# User scripts should call ::ntext::wrapIndent instead. 1845# 1846# Arguments: 1847# textWidget - text widget to be dedented 1848# index1 - index in the first logical line to be dedented 1849# index2 - index in the last logical line to be dedented 1850 1851proc ::ntext::RemoveIndentMultipleLines {textWidget index1 index2} { 1852 # Remove -lmargin2 indentation, by removing each tag in these 1853 # lines whose name begins "ntextAlignLM2Indent=" 1854 1855 if {[$textWidget count -lines $index1 $index2] < 0} { 1856 set index3 $index1 1857 set index1 $index2 1858 set index2 $index3 1859 } else { 1860 } 1861 if { [$textWidget compare $index1 == 1.0] && \ 1862 [$textWidget compare $index2 == end]} { 1863 # shortcut if whole widget needs processing 1864 1865 # Remove -lmargin2 indentation, by removing each tag in the 1866 # widget whose name begins "ntextAlignLM2Indent=" 1867 1868 set tagNames [$textWidget tag names] 1869 1870 # tagNames now holds all tags in the widget 1871 # Remove the ones that ntext has previously used to set -lmargin2 1872 # These tags' names all begin with the same string. 1873 1874 foreach tag $tagNames { 1875 if {[string range $tag 0 19] eq "ntextAlignLM2Indent="} { 1876 #### puts $tag 1877 $textWidget tag remove $tag 1.0 end 1878 } 1879 } 1880 } else { 1881 # go through the widget line-by-line 1882 set index1 [$textWidget index "$index1 linestart"] 1883 set index2 [$textWidget index "$index2 linestart"] 1884 for {set index $index1} \ 1885 {$index <= $index2 && [$textWidget compare $index != end]} \ 1886 {set index [$textWidget index "$index + 1 line"]} { 1887 RemoveIndentOneLine $textWidget $index 1888 set oldIndex $index 1889 } 1890 } 1891 return 1892} 1893 1894# ::ntext::IntToColor -- 1895# 1896# Return a color in 24-bit hexadecimal format (e.g. "#FF8080") whose 1897# value is a periodic function of the number $pix, with period $range. 1898# Nothing too dark: each of R, G and B is in the range 156 to 255. 1899# Return value is white if $pix == 0 1900# 1901# Arguments: 1902# pix - real or integer number 1903# range - real or integer number, non-zero 1904 1905proc ::ntext::IntToColor {pix range} { 1906 set val [expr {int(99.9 - $pix * 100.0 / $range) % 100 + 156}] 1907 set r $val 1908 set g $val 1909 set b 255 1910 set color [format "#%02x%02x%02x" $r $g $b] 1911 return $color 1912} 1913 1914##### END OF CODE TO HANDLE (OPTIONAL) INDENTATION USING -lmargin2 1915 1916##### End of procs. 1917 1918# Initialize match patterns for word boundary detection - 1919 1920::ntext::initializeMatchPatterns 1921 1922package provide ntext 0.81 1923