1#!/usr/local/bin/wish 2# 3# System: Sgtool, a frontend to sgrep. 4# Module: sgtool 5# Author: Pekka Kilpel�inen & Jani Jaakkola 6# Description: Implements a X interface to sgrep with tcl/tk 7# Version history: Original version July 1995 by JJ & PK 8# Copyright: University of Helsinki, Dept. of Computer Science 9# Distributed under GNU General Public Lisence 10# See file COPYING for details 11 12# Here is some definitions you might like to check out 13 14# The version number 15set sgtversion 0.90 16 17# Default output style is short 18set opt_out "-s" 19# Default preprocessor is m4 ( only one we can get macros from ) 20set preprocessor "m4" 21set ostyle "" 22set outstylefile "" 23 24# Default preferences 25set pref_input 1 26set pref_macrofiles 1 27set pref_macros 1 28set pref_ver 1 29set pref_status 1 30 31# default filters 32set filter_save * 33set filter_input * 34set filter_macro *.macros 35set filter_ostyle * 36 37# default directories 38set input_dir . 39set macro_dir . 40 41# Macrofiles default to /usr/lib/sgreprc and ~/.sgreprc 42catch { glob ~/.sgreprc } macrofiles 43if { ! [ file isfile $macrofiles ] } { set macrofiles "/usr/local/lib/sgreprc" } 44if { ! [ file isfile $macrofiles ] } { set macrofiles "" } 45 46# The actual program starts here 47 48set macros "" 49set body_array(0) "" 50set macro_file_array(0) "" 51 52# How many macro editors is active ? 53set macro_editors 0 54 55# fetch the sgrep version string. Error means that we couldn't exec sgrep. 56# in which case there is no point to continue. 57if { [ catch { exec sgrep -V } sgrepver ] } { puts $sgrepver ; exit 1 } 58 59# Check for command line arguments ( input files ) 60if { $argv == "" } { 61 set input_files "" 62} else { 63 set input_files $argv 64} 65 66# Using this variable to give individual number to textwindows 67set textwnum 0 68# Using this var to give individual save file numbers 69set sfilenum 0 70 71set sgrep_define { "define" not in ( inner("#".."\n") or ("("..")") ) } 72 73# Procedure which fetches macro names from given macrofiles using sgrep 74# Macro names have a "\n" between them 75# Returns macronames or error in variable var 76# returs nonzero when error occurred 77proc fetch_macro_names { files var } { 78 global sgrep_define 79 upvar $var macros 80 81 if { $files == "" } { 82 set macros "" 83 return 0 84 } 85 86 set sgexpr { .. "(" __ "," } 87 set sgexpr "$sgrep_define $sgexpr" 88 if { [ 89 catch { eval exec sgrep -n -p - -o { "%r " } { $sgexpr } $files } macros 90 ] } { 91 errwin .macroerr "Could not fetch macro names" $macros { } 92 centerwin .macroerr . 93 return 1 94 } 95 return 0 96} 97 98# Procedure which fetches macro bodies from given macrofiles using sgrep 99# Macro bodies are stored in array starting with index 0 100# Array name is given in variable var 101# return nonzero when error occurred 102proc fetch_macro_bodies { files body_var file_var } { 103 global sgrep_define 104 upvar $body_var bodies 105 upvar $file_var macro_file_array 106 107 if { $files == "" } { 108 array set bodies { } 109 return 0 110 } 111 # Open a pipe and try to catch errors 112 set sgexpr { .. "(" .. "," _. ( "(" .. ")" ) } 113 set sgexpr "$sgrep_define $sgexpr" 114 if { [ catch { 115 open "|sgrep -n -p - -o %f\\n%r\\n!@�$%&/\\n \{$sgexpr\} $files" r 116 } openerr ] } { 117 # Error when creating pipe 118 errwin .bodyerr "Couldn't create sgrep pipe" $openerr { } 119 centerwin .bodyerr . 120 return 1 121 } 122 # Read from pipe. Function bodies are separated with output style 123 # !@�$%/ . Bodies are stored in array a 124 set bodynum 0 125 set body "" 126 set f(0) "" 127 while { [gets $openerr line] != -1 } { 128 if { "$line" == "!@�$%&/" } { 129 set a($bodynum) $body 130 set body "" 131 incr bodynum 132 set f($bodynum) "" 133 } else { 134 if { $f($bodynum)=="" } { 135 set f($bodynum) $line 136 } else { 137 set body "$body$line\n" 138 } 139 } 140 } 141 if { [catch { close $openerr } closeerr] } { 142 errwin .bodyerr "Could not fetch macro bodies" $closeerr { } 143 centerwin .bodyerr . 144 return 1 145 } 146 # If bodies won't exists unset returns error, which is okay 147 catch { unset bodies } 148 array set bodies [array get a] 149 catch { unser files } 150 array set macro_file_array [array get f] 151 return 0 152} 153 154# Procedure witch fetches macros. Returns 0 if fetch was ok 155proc fetch_macros { } { 156 global macrofiles 157 global macros 158 global body_array 159 global mlist 160 global macro_file_array 161 global macro_editors 162 163 # If there are macro editors around, we won't fetch macros 164 if { $macro_editors > 0 } { 165 errwin .fetcherr "Macro fetching error" \ 166"Close all macro editors before scanning 167for macros. Otherwise all changes would 168be lost." { } 169 return 170 } 171 172 .state configure -text "Fetching macros" 173 update 174 175 set m "" 176 if { [fetch_macro_names $macrofiles m ] } { 177 # Fetching macros was not ok 178 return 1 179 } 180 if { [fetch_macro_bodies $macrofiles body_array macro_file_array ] } { 181 # Fetching macro bodies was not ok 182 return 1 183 } 184 set macros $m 185 update_macro_list 186} 187 188# Updates macrolistbox macro list 189proc update_macro_list { } { 190 global mlist 191 global macros 192 193 $mlist delete 0 end 194 foreach i [set macros] { 195 $mlist insert end $i 196 } 197 198 .state configure -text "Ready" 199 return 0 200} 201 202# Procedure which returns a m4 macro file from given macro names 203proc generate_macro_file { names } { 204 global macros 205 global body_array 206 207 .state configure -text "Generating macrofile" 208 update 209 210 # r is the result variable 211 set r \ 212"# sgrep macrofile for m4 preprocessor 213# This file was automatically generated by sgreptool 214" 215 foreach i "$names" { 216 set j [lsearch -exact "$macros" $i] 217 set m $body_array($j) 218 set r "$r\ndefine($i,$m)" 219 } 220 .state configure -text "Ready" 221 return "$r\n" 222} 223 224# Procedure which is invoked instead of scrollbar set to enable or disable 225# when they are needed or aren't needed 226proc doset { sbar packopt first last } { 227 if { $first=="0" && $last=="1" } { 228 pack forget $sbar 229 } else { 230 eval "pack $sbar $packopt" 231 $sbar set $first $last 232 } 233} 234 235# Centers a window to given parent ( for popups and such ) 236proc centerwin { win dad } { 237 set dx [ winfo rootx $dad ] 238 set dy [ winfo rooty $dad ] 239 set x [ expr 25+$dx ] 240 set y [ expr 25+$dy ] 241 wm geometry $win +$x+$y 242} 243 244# Creates given error window, with given label and error text. 245# sets .status to error, and when error window is closed sets it to ready. 246# Grabs input focus 247proc errwin { errw label text dest_com } { 248 # Create error window 249 toplevel $errw 250 # This is how this window gets killed 251 set destroy_c ".state configure -text Ready; destroy $errw; 252 focus [focus] ; $dest_com" 253 # Information for window manages 254 wm protocol $errw WM_DELETE_WINDOW $destroy_c 255 wm transient $errw [winfo toplevel [winfo parent $errw]] 256 # How we look like 257 button $errw.errokbutton -text "OK" -command $destroy_c 258 pack $errw.errokbutton -side bottom 259 .state configure -text "Error" 260 label $errw.state -text $label 261 pack $errw.state -side top -fill x 262 pack [ label $errw.bitmap -bitmap error ] -side left -padx 10 -pady 10 263 message $errw.msg \ 264 -relief raised -width 500 \ 265 -borderwidth 1 \ 266 -text $text 267 pack $errw.msg -fill both -expand 1 268 # Escape and enter also kills this window 269 bind $errw <Escape> $destroy_c 270 centerwin $errw [winfo toplevel [winfo parent $errw]] 271 # This window must die before anything else can be done 272 focus [winfo toplevel [winfo parent $errw]] 273 focus $errw.errokbutton 274 update 275 grab $errw.errokbutton 276 return 0 277} 278 279# Creates window with yes and no buttons executing script yes_com on yes 280# button and no_com on no button. Establshes a grab, so that nothing will 281# be done before query is answered 282proc yesno { win text yes no } { 283 set w $win 284 # Create error window 285 toplevel $w 286 # This is how this window gets killed 287 set destroy_c ".state configure -text Ready; destroy $w 288 focus [focus]" 289 # This window must be answered 290 wm protocol $w WM_DELETE_WINDOW { } 291 wm transient $w [winfo toplevel [winfo parent $w]] 292 # How we look like 293 .state configure -text "Yes or No" 294 pack [label $w.question -bitmap question ] -side left -padx 10 295 message $w.msg -font -Adobe-times-medium-r-normal--*-180-*-*-*-*-*-* \ 296 -relief raised -width 500 \ 297 -borderwidth 1 \ 298 -text $text 299 pack $w.msg -fill x 300 # Create buttons 301 frame $w.bf 302 pack $w.bf -side bottom 303 foreach i { yes no } { 304 button $w.bf.$i -width 8 -text $i\ 305 -command "$destroy_c ; [set $i]" 306 pack $w.bf.$i -side left -padx 5 -pady 5 307 } 308 # y and n are valid answers 309 bind $w <y> "focus $w.bf.yes" 310 bind $w <n> "focus $w.bf.no" 311 bind $w <Return> { [focus] invoke } 312 centerwin $w [winfo toplevel [winfo parent $w]] 313 # This window must die before anything else can be done 314 focus . 315 focus $w.bf.yes 316 update 317 grab $w 318 return 0 319} 320 321# Checks if it is ok save file with given name. If it's ok, destroys $win, 322# exec $savecommand giving filename as parameter. $file is name of global 323# variable containing filename 324proc oktosave { win savecommand file dir} { 325 global $file 326 global $dir 327 328 set f [make_name [set $dir] [set $file] ] 329 330 set c " 331 destroy $win 332 eval $savecommand \"$f\" 333 unset $file 334 unset $dir 335 " 336 #if we dont't have a file name, we do nothing 337 if { [set $file] == ""} { return } 338 339 # Make sure that it's okay to overwrite existing files 340 if { [ file exists "$f" ] } { 341 yesno $win.yesnowin "File $f exists. OK to overwrite ?" "$c" { } 342 } else "$c" 343} 344 345# Window for asking filename for saving. Will create it into window win, and 346# exec script savecommand when file is selected 347proc savefile { win savecommand filtervar } { 348 global sfilenum 349 global filter_save 350 351 incr sfilenum 352 353 set file sfile$sfilenum 354 set dir sdir$sfilenum 355 set filter $filtervar 356 357 global $file 358 global $dir 359 global $filter 360 361 set $dir . 362 set $file "" 363 364 # Button frame 365 frame $win.bf 366 pack $win.bf -side bottom 367 foreach i { save cancel } { 368 button $win.bf.$i -text $i -width 8 369 pack $win.bf.$i -side left -padx 5 370 } 371 # Command to execute when save button is pressed 372 set c_save "oktosave $win \{ $savecommand \} $file $dir" 373 $win.bf.save configure -command "$c_save" 374 chooser $win $file $dir $filter "$c_save" 375 376 # Command to execute when cancel is requested 377 set c_cancel "destroy $win;unset $file; unset $dir" 378 wm protocol $win WM_DELETE "unset $file;unset $dir" 379 $win.bf.cancel configure -command $c_cancel 380} 381 382# Window for asking file name. 383# exec script selectcommand when file is selected. 384# File must exist and be a regular file (that's checked) 385proc selectfile { win selectcommand default_file default_filter } { 386 set file selfile$win 387 set dir seldir$win 388 set filter $default_filter 389 390 global $file 391 global $dir 392 global $filter 393 394 set $dir [file dirname $default_file] 395 if { $dir == "" } { set dir "." } 396 set $file [file tail $default_file] 397 398 # Button frame 399 frame $win.bf 400 pack $win.bf -side bottom 401 foreach i { ok cancel } { 402 button $win.bf.$i -text $i -width 8 403 pack $win.bf.$i -side left -padx 5 404 } 405 # Command to execute when ok button is pressed 406 proc file_exists { win selectcommand filevar dirvar } { 407 global $filevar 408 global $dirvar 409 410 set f [ make_name [ set $dirvar ] [ set $filevar ] ] 411 if { [file isfile $f] } { 412 destroy $win 413 eval $selectcommand $f 414 } else { 415 errwin $win.errw "File selection error:" \ 416 "Selected file isn't regular file" { } 417 } 418 } 419 set c_sel "file_exists $win \ 420 \{ unset $file; unset $dir; $selectcommand \} $file $dir" 421 $win.bf.ok configure -command "$c_sel" 422 423 chooser $win $file $dir $filter "$c_sel" 424 425 # Command to execute when cancel is requested 426 set c_cancel "destroy $win;unset $file; unset $dir" 427 wm protocol $win WM_DELETE "unset $file;unset $dir" 428 $win.bf.cancel configure -command $c_cancel 429} 430 431# Window for selecting outputstylefile 432proc select_outfile { } { 433 # If window exists do nothing 434 if { [ winfo exists .outstylefilewin ] } { return } 435 # Create window 436 set w .outstylefilewin 437 toplevel $w 438 centerwin $w . 439 wm title $w "sgreptool - Output style file" 440 global outstylefile 441 selectfile $w "global outstylefile; set outstylefile" $outstylefile filter_ostyle 442 return 443} 444 445# Saves given textwindow to filename 446proc textsave { twin filename } { 447 # Status window tells what we are doing 448 .state configure -text "Saving .." 449 update 450 # Open file, and catch errors 451 if { [catch { open $filename w } f] } { 452 errwin $twin.fileerror "Error opening file '$filename' for saving" $f {} 453 return 454 } 455 if { [catch { puts -nonewline $f [$twin get 1.0 end] } err] } { 456 catch { close $f } 457 errwin $twin.fileerror "Error writing file '$filename'" \ 458 $err { } 459 return 460 } 461 if { [catch { close $f } err ] } { 462 errwin $twin.fileerror "Error closing file '$filename'" \ 463 $err { } 464 return 465 } 466 .state configure -text "Ready" 467} 468 469# Creates a window for saving text windows 470proc textsavewindow { twin twid} { 471 savefile $twin "textsave $twid" filter_save 472 return 473} 474 475# Figures out the command line switches to be given to sgrep 476proc sgrep_options {} { 477 set o "" 478 479 global opt_filter 480 if { $opt_filter } { set o "-a" } 481 global opt_count 482 if { $opt_count } { set o "$o -c" } 483 global opt_concat 484 if { $opt_concat } { set o "$o -d" } 485 global opt_nl 486 if { $opt_nl } { set o "$o -N" } 487 global opt_preproexpr 488 if { $opt_preproexpr } { set o "$o -P" } 489 global opt_stream 490 if { $opt_stream } { set o "$o -S" } 491 global opt_job 492 if { $opt_job } { set o "$o -T" } 493 global opt_time 494 if { $opt_time } { set o "$o -t " } 495 global opt_out 496 set o "$o $opt_out" 497 # we have custom output style 498 global ostyle 499 if { $opt_out == "-o" } { set o "$o $ostyle" } 500 # we have style file 501 global outstylefile 502 if { $opt_out == "-O" } { set o "$o $outstylefile"} 503 # set preprocessor 504 global preprocessor 505 set o "$o -p $preprocessor" 506 return $o 507} 508 509# Procedure for executing sgrep 510proc execsgrep { sexpr } { 511 global textwnum 512 global errorCode 513 global input_files 514 global macros 515 global body_array 516 517 if { [llength $input_files] == 0 } { 518 # no input files is an error 519 errwin .sgerr "sgtool error" "No input files" { } 520 return 0 521 } 522 523 set m [generate_macro_file $macros] 524 525 .state configure -text "Executing query..." 526 update 527 528 # Execute sgrep 529 set e [catch { 530 eval exec sgrep -n -f - -e {$sexpr} [ sgrep_options ] $input_files << {$m} 531 } errstr ] 532 .state configure -text "Ready" 533 534 incr textwnum 535 set t .texttop$textwnum 536 537 #create top level window 538 toplevel $t 539 540 # baptizing windows 541 wm title $t "sgreptool - query #$textwnum" 542 wm iconname $t "query #$textwnum" 543 544 # Create state label 545 label $t.state -relief ridge -width 80 546 pack $t.state -side top -fill x 547 548 # If exit status != 1 it means sgrep error 549 if { [lindex $errorCode 0] == "CHILDSTATUS" && $e != 0 } { 550 if { [lindex $errorCode 2] != "1" } { 551 destroy $t 552 errwin .sgerr "sgrep error" $errstr { } 553 return 0 554 } 555 # We had empty output file 556 # Label with the actual query 557 $t.state config -text "Output from '$sexpr'" 558 label $t.empty -text "No matching regions found." -relief ridge 559 pack $t.empty -side top -fill x 560 button $t.okbutton -text "OK" -command "destroy $t" 561 pack $t.okbutton -side top 562 focus $t.okbutton 563 return 0 564 } elseif { [lindex $errorCode 0] != "NONE" && $e != 0 } { 565 # Using default error handling 566 destroy $t 567 error $errstr 568 } 569 570 #create bottom byttons 571 frame $t.bf 572 pack $t.bf -side bottom 573 foreach i "ok save edit wrap" { 574 button $t.bf.$i -text "$i" -width 8 -underline 0 575 pack $t.bf.$i -side left -padx 5 576 } 577 578 # ok button 579 $t.bf.ok configure -command "destroy $t" -underline -1 580 bind $t <Escape> "destroy $t" 581 582 # wrap button 583 proc wrap_b { dad } { 584 if { [$dad.bf.wrap cget -relief] == "raised" } { 585 $dad.bf.wrap configure -relief sunken 586 $dad.text configure -wrap char 587 } else { 588 $dad.bf.wrap configure -relief raised 589 $dad.text configure -wrap none 590 } 591 } 592 $t.bf.wrap configure -relief sunken -command "wrap_b $t" 593 bind $t <Alt-w> "$t.bf.wrap invoke" 594 595 # edit button 596 proc edit_b { dad } { 597 if { [$dad.bf.edit cget -relief] == "raised" } { 598 $dad.bf.edit configure -relief sunken 599 $dad.text configure -state normal 600 } else { 601 $dad.bf.edit configure -relief raised 602 $dad.text configure -state disabled 603 } 604 } 605 $t.bf.edit configure -relief raised -command "edit_b $t" 606 bind $t <Alt-e> "$t.bf.edit invoke" 607 608 # save button 609 proc save_b { dad num } { 610 # Do nothing if save window already exists 611 if { [winfo exists $dad.savewin] } { return } 612 # Create save window 613 toplevel $dad.savewin 614 centerwin $dad.savewin $dad 615 wm title $dad.savewin "save result #$num" 616 textsavewindow $dad.savewin $dad.text 617 } 618 $t.bf.save configure -command "save_b $t $textwnum" 619 bind $t <Alt-s> "$t.bf.save invoke" 620 621 #create text scrollbars 622 scrollbar $t.vscroll -orient vertical \ 623 -command "$t.text yview " 624 scrollbar $t.hscroll -orient horizontal \ 625 -command "$t.text xview " 626 627 text $t.text \ 628 -xscrollcommand "doset $t.hscroll \"-before $t.text -side bottom -fill x\" " \ 629 -yscrollcommand "doset $t.vscroll \"-before $t.text -side right -fill y\" " \ 630 -wrap char 631 pack $t.text -side top -fill both -expand 1 632 $t.text insert 1.0 $errstr 633 $t.text configure -state disabled 634 # Label with the actual query 635 $t.state config -text "Output from '$sexpr'" 636 637 focus $t.text 638 update 639 pack propagate $t 0 640 return 0 641} 642 643# Creates a listbox to given parent frame using hor and ver scrollbars 644proc listb { pwin } { 645 #create scrollbars 646 scrollbar $pwin.vscroll -orient vertical \ 647 -command "$pwin.lb yview " 648 scrollbar $pwin.hscroll -orient horizontal \ 649 -command "$pwin.lb xview " 650 651 #create listbox 652 listbox $pwin.lb \ 653 -xscrollcommand "doset $pwin.hscroll \"-side bottom -fill x -before $pwin.lb\" " \ 654 -yscrollcommand "doset $pwin.vscroll \"-side right -fill y -after $pwin.lb\" " 655 pack $pwin.lb -side left -fill both -expand 1 656 return $pwin.lb 657} 658 659# Fills file chooser window directory and files listboxes with 660# filenames using globbing. 661# Arguments: 662# dir name of global variable containing directory name 663# filter name of global variable containing filter 664# dwin name of directory listbox window 665# fwin name of file listbox window 666proc globber { gl_dir gl_filter dwin fwin } { 667 global $gl_dir 668 global $gl_filter 669 670 set d [ set $gl_dir ] 671 set f [ set $gl_filter ] 672 673 if { [string index $d [string length $d] ] != "/" } { set d $d/ } 674 675 # empty listboxes 676 $dwin delete 0 end 677 $fwin delete 0 end 678 679 # glob returns error for unreadable dirs ( that's wrong IMHO ) 680 if { [catch { glob -nocomplain -- $d$f } files] } { 681 errwin [winfo toplevel $dwin].globerror \ 682 "Glob failed:" "$files" { } 683 return 684 } 685 foreach i [lsort $files] { 686 if { [string first $d $i] == 0 } { 687 set n [string range $i [string length $d] end ] 688 } else { set n $i } 689 if { [file isfile $i] } { 690 $fwin insert end $n 691 } 692 } 693 # Directories need their own glob, so that every directory will 694 # be shown 695 set files [ glob -nocomplain -- $d.* $d* ] 696 foreach i [lsort $files] { 697 if { [string first $d $i] == 0 } { 698 set n [string range $i [string length $d] end ] 699 } else { set n $i } 700 if { [file isdirectory $i] } { 701 $dwin insert end $n 702 } 703 } 704} 705 706# Removes one directory from dir and calls globber 707proc upglobber { gl_dir gl_filter dwin fwin } { 708 global $gl_dir 709 710 # gl_dir one up 711 set $gl_dir [file dirname [set $gl_dir] ] 712 globber $gl_dir $gl_filter $dwin $fwin 713} 714 715proc downglobber { gl_dir gl_filter dwin fwin } { 716 global $gl_dir 717 718 # if there is no selection do nothing 719 if { [$dwin curselection] == "" } { return } 720 721 set p [ set $gl_dir ] 722 # use chosen directory 723 set d [ $dwin get [ $dwin curselection ] ] 724 if { "$d" == ".." } { 725 upglobber $gl_dir $gl_filter $dwin $fwin 726 return 727 } 728 if { "$d" == "." } { 729 globber $gl_dir $gl_filter $dwin $fwin 730 return 731 } 732 if { $p == "/" } { 733 set $gl_dir /$d 734 } else { 735 set $gl_dir [set $gl_dir]/$d 736 } 737 globber $gl_dir $gl_filter $dwin $fwin 738} 739 740# Set filechooser selection 741proc setselection { se_dir se_filter dwin fwin ewin } { 742 global $se_dir $se_filter 743 744 # if there is no selection do nothing 745 if { [$fwin curselection] == "" } { return } 746 747 $ewin delete 0 end 748 $ewin insert 0 [$fwin get [$fwin curselection]] 749} 750 751# Creates file chooser gadget to given frame. Uses fsvar as textvariable 752# for chosen file name. dir contains default directory. 753# Returns name of the entry window containing file name 754proc chooser { parent fsvar dir filter okcommand } { 755 global $dir 756 global $filter 757 758 if { $fsvar != "" } { global $fsvar } 759 760 # Expand directory 761 if { [set $dir] == "." } { 762 set $dir [ pwd ] 763 } 764 765 # Filter line 766 if { [set $filter] == "" } { set $filter * } 767 768 frame $parent.1 769 pack $parent.1 -side top -fill x 770 label $parent.1.l -width 10 -text "Filter:" 771 pack $parent.1.l -side left -anchor e 772 entry $parent.1.e -textvariable $filter 773 pack $parent.1.e -side top -fill x 774 775 # Directory line 776 frame $parent.2 777 pack $parent.2 -side top -fill x 778 label $parent.2.l -width 10 -text "Directory:" 779 pack $parent.2.l -side left -anchor e 780 label $parent.2.e -textvariable "$dir" -relief ridge 781 pack $parent.2.e -side top -fill x 782 783 # Button line 784 frame $parent.3 785 pack $parent.3 -side top 786 button $parent.3.ap -text "rescan" -width 8 787 button $parent.3.up -text "up dir" -width 8 788 button $parent.3.go -text "go dir" -width 8 789 button $parent.3.home -text "home" -width 8 790 pack $parent.3.ap $parent.3.up $parent.3.go $parent.3.home -side left 791 792 # File name line 793 frame $parent.4 794 pack $parent.4 -side bottom -fill x 795 label $parent.4.l -width 10 -text "Selection:" 796 pack $parent.4.l -side left -anchor e 797 pack [ entry $parent.4.e ] -side top -fill x 798 if { $fsvar != "" } { $parent.4.e configure -textvariable "$fsvar" } 799 focus $parent.4.e 800 801 # Directories window 802 frame $parent.dirf 803 pack $parent.dirf -side left -expand 1 -fill both 804 label $parent.dirf.dlabel -text Directories -anchor w 805 pack $parent.dirf.dlabel -side top -fill x 806 set dwin [ listb $parent.dirf ] 807 # Files window 808 frame $parent.filef 809 pack $parent.filef -side left -expand 1 -fill both 810 label $parent.filef.flabel -text Files -anchor w 811 pack $parent.filef.flabel -side top -fill x 812 set fwin [ listb $parent.filef ] 813 814 # Glob the files to windows 815 globber $dir $filter $dwin $fwin 816 817 # set apply button to do globbing 818 $parent.3.ap configure \ 819 -command "globber $dir $filter $dwin $fwin" 820 # bind enter in filter window to do globbind 821 bind $parent.1.e <Return> "globber $dir $filter $dwin $fwin" 822 823 # set updir button to remove one directory and glob 824 $parent.3.up configure -command \ 825 "upglobber $dir $filter $dwin $fwin" 826 # set godir button to go to selected directory 827 $parent.3.go configure -command \ 828 "downglobber $dir $filter $dwin $fwin" 829 # home button to go to hom dir 830 global env 831 set h $env(HOME) 832 $parent.3.home configure \ 833 -command "set $dir $h ; globber $dir $filter $dwin $fwin" 834 # bind double click on dir window to go down hierarchy 835 bind $dwin <Double-Button-1> "downglobber $dir $filter $dwin $fwin" 836 bind $dwin <Return> "downglobber $dir $filter $dwin $fwin" 837 # bindings for selecting file 838 bind $fwin <ButtonRelease-1> "setselection $dir $filter $dwin $fwin $parent.4.e" 839 bind $fwin <Return> "setselection $dir $filter $dwin $fwin $parent.4.e" 840 # Bind double click on file name and enter in selection window 841 # to execute ok command 842 bind $fwin <Double-Button-1> \ 843 "setselection $dir $filter $dwin $fwin $parent.4.e ; $okcommand" 844 bind $parent.4.e <Return> "$okcommand" 845} 846 847# When given dir name and file name, computes a real file name from 848# them using algrithm below 849proc make_name { dir file } { 850 # No null files 851 if { $file == "" } { return } 852 # When dir == pwd, just add file name 853 if { $dir == [pwd] } { 854 return $file 855 } 856 # When filename starts with / just return file name 857 if { [string index "$file" 0] == "/" } { return $file } 858 set r $dir/$file 859 # If dir path starts with pwd, remove it from filename 860 if { [string first [pwd]/ $r] == 0 } { 861 set r [string range $r [string length [pwd]/ ] end ] 862 } 863 return $r 864} 865 866# Sorts a given listbox windows lines 867proc sort_listbox {lbox} { 868 set sl [lsort [$lbox get 0 end] ] 869 $lbox delete 0 end 870 foreach i "$sl" { 871 $lbox insert end $i 872 } 873} 874 875# Removes active entry from listbox 876proc remove_active { lbox } { 877 if { [$lbox curselection] == "" } { return } 878 $lbox delete active 879} 880 881# Window for selecting multiple files 882proc select_files { win text dirvar filesvar filtervar okcommand cancelcommand } { 883 global $dirvar 884 global $filesvar 885 global $filtervar 886 887 # Everything inside this window 888 set w $win 889 890 # Create file selection window 891 frame $w.fsf 892 pack $w.fsf -side left -fill both -expand 1 893 894 # The files 895 frame $w.ifiles 896 pack $w.ifiles -side right -fill both -expand 1 897 label $w.ifiles.l -text $text 898 pack $w.ifiles.l -side top -anchor w 899 set iwin [ listb $w.ifiles ] 900 901 # The buttons 902 frame $w.buttons 903 pack $w.buttons -side left 904 foreach i "add remove clear sort ok cancel" { 905 button $w.buttons.$i -text $i -width 8 906 pack $w.buttons.$i -side top -pady 5 -padx 5 907 } 908 909 # Fill iwin with default input files 910 foreach i [ set $filesvar ] { 911 $iwin insert end $i 912 } 913 914 set apply "set $filesvar \[$iwin get 0 end\] ; $okcommand" 915 916 # ok and cancel bindings 917 $w.buttons.ok configure -command "$apply" 918 $w.buttons.cancel configure -command "$cancelcommand" 919 bind $w <Escape> "$cancelcommand" 920 921 # remove button 922 $w.buttons.remove configure -command "remove_active $iwin" 923 # clear button 924 $w.buttons.clear configure -command "$iwin delete 0 end" 925 # sort button 926 $w.buttons.sort configure -command "sort_listbox $iwin" 927 928 # add button 929 proc add_entry { iwin dirvar ewin} { 930 global $dirvar 931 set f [ $ewin get ] 932 # No null files 933 if { $f == "" } { return } 934 $iwin insert end [make_name [set $dirvar] $f] 935 } 936 set add "add_entry $iwin $dirvar $w.fsf.4.e" 937 $w.buttons.add configure -command "$add" 938 # Create choose gadget 939 chooser $w.fsf "" $dirvar $filtervar "$add" 940 return $iwin 941} 942 943# Creates macro file selection window 944proc macrocreate { } { 945 global macro_editors 946 947 # If there are macro editors around, we won't reselect macrofiles 948 if { $macro_editors > 0 } { 949 errwin .fetcherr "Macro fetching error" \ 950"Close all macro editors before selecting 951new macro files. Otherwise all changes would 952be lost." { } 953 return 954 } 955 956 # If we already have macrofile selection window, we don't start new 957 # one 958 if { [winfo exists .mfiles] } { return } 959 960 global tmp_macros 961 global macrofiles 962 set tmp_macros $macrofiles 963 964 # Create toplevel 965 toplevel .mfiles 966 wm title .mfiles "sgreptool - macrofiles" 967 wm iconname .mfiles "macro files" 968 centerwin .mfiles . 969 970 wm protocol .mfiles WM_DELETE_WINDOW "destroy .mfiles" 971 set selw [ select_files .mfiles "Macro files:" macro_dir tmp_macros filter_macro \ 972 "okeido" "destroy .mfiles" ] 973} 974 975# Checks if macro files selected were okay 976proc okeido { } { 977 global tmp_macros 978 global macrofiles 979 980 set n "" 981 foreach i [lsort $tmp_macros] { 982 if { "$i"=="$n" } { 983 errwin .mfiles.errw "error - macro files" \ 984"You can use one macrofile only once. 985File '$i' was selected twice" "" 986 return 987 } 988 set n $i 989 if { ! [file isfile $i] } { 990 errwin .mfiles.errw "error - macro files" \ 991"Selected file '$i' wasn't a regular file. 992Please use only ordinary files as macro files." "" 993 return 994 } 995 } 996 set macrofiles $tmp_macros 997 destroy .mfiles 998 fetch_macros 999} 1000 1001# Creates the input file window. 1002proc ifcreate { } { 1003 # if input file window already exists do nothing 1004 if { [winfo exists .ifiles] } { return } 1005 1006 # Create input file window 1007 toplevel .ifiles 1008 centerwin .ifiles . 1009 # Baptize window 1010 wm title .ifiles "sgreptool - input files" 1011 wm iconname .ifiles "input files" 1012 1013 set dest "destroy .ifiles" 1014 wm protocol .ifiles WM_DELETE_WINDOW "$dest" 1015 select_files .ifiles "Input files:" input_dir input_files filter_input \ 1016 "$dest" "$dest" 1017} 1018 1019# Destroys the input file window. ok for accept cancel for discard 1020proc destroy_ifwindow { how } { 1021 global input_files 1022 # if parameter was window name, use changes from window 1023 if { "$how" != "cancel" } { 1024 set input_files [$how get 0 end] 1025 } 1026 destroy .ifwindow 1027} 1028 1029# Creates a toplevel window for selecting output style 1030proc select_outstyle { } { 1031 # If output style window already exists do nothing 1032 if { [winfo exist .outstylewin] } { return } 1033 toplevel .outstylewin 1034 centerwin .outstylewin . 1035 wm title .outstylewin "sgreptool - output style" 1036 1037 set o .outstylewin 1038 1039 # buttons 1040 pack [ frame $o.bf ] -side bottom 1041 button $o.bf.ok -text "ok" -width 8 -command { 1042 set ostyle [.outstylewin.st.entry get] 1043 set opt_out "-o" 1044 destroy .outstylewin 1045 } 1046 pack $o.bf.ok -side left -padx 5 1047 button $o.bf.cancel -text "cancel" -width 8 -command " 1048 set opt_out -s 1049 destroy $o" 1050 pack $o.bf.cancel -side left -padx 5 1051 # style 1052 pack [ frame $o.st ] -side top -fill x 1053 pack [ label $o.st.label -text "style:" -anchor e ] -side left 1054 global ostyle 1055 pack [ entry $o.st.entry ] -fill x 1056 $o.st.entry insert insert $ostyle 1057 bind $o.st.entry <Return> "$o.bf.ok invoke" 1058 focus $o.st.entry 1059 # stylebuttons 1060 pack [ frame $o.stbf ] -side top 1061 foreach i { 1062 { filename %f } 1063 { start %s } 1064 { end %e } 1065 { length %l } 1066 { file_start %i } 1067 { file_end %j } 1068 { region %r } 1069 { number %n } 1070 { % %% } } { 1071 set name [ lindex $i 0 ] 1072 set str [ lindex $i 1 ] 1073 pack [ 1074 button $o.stbf.$name -text $name -width 5 \ 1075 -command "$o.st.entry insert insert $str" 1076 ] -side left 1077 } 1078} 1079 1080# Creates a window for selecting preprocessor 1081proc precreate { } { 1082 set w .preprowin 1083 # We do nothing if prepro win already exists 1084 if { [winfo exists .preprowin] } { return } 1085 global newpreprocessor 1086 global preprocessor 1087 set newpreprocessor $preprocessor 1088 # Create error window 1089 toplevel $w 1090 centerwin $w . 1091 wm title $w "sgreptool - select preprocessor" 1092 # This is how this window gets killed 1093 set destroy_c "destroy $w" 1094 # How we look like 1095 pack [ entry $w.entry -textvariable newpreprocessor ] -side top -fill x 1096 focus $w.entry 1097 bind $w.entry <Return> "$w.bf.ok invoke" 1098 # Create buttons 1099 frame $w.bf 1100 pack $w.bf -side bottom 1101 foreach i { ok cancel m4 } { 1102 button $w.bf.$i -width 8 -text $i 1103 pack $w.bf.$i -side left -padx 5 -pady 5 1104 } 1105 $w.bf.ok configure -command { 1106 global preprocessor 1107 set preprocessor $newpreprocessor 1108 destroy .preprowin} 1109 set dest " 1110 destroy .preprowin" 1111 wm protocol .preprowin WM_DELETE_WINDOW "$dest" 1112 $w.bf.cancel configure -command "$dest" 1113 $w.bf.m4 configure -command " 1114 set preprocessor m4 1115 $dest" 1116} 1117 1118# Destroys popupwindows for selecting outputstyle 1119proc del_stylepop {} { 1120 if { [winfo exists .outstylewin ] } { destroy .outstylewin } 1121 if { [winfo exists .outstylefilewin ] } { destroy .outstylefilewin } 1122} 1123 1124# Applys user selected preferences by packing or unpacking main window frames 1125proc apply_preferences { } { 1126 global pref_input 1127 global pref_macros 1128 global pref_macrofiles 1129 global pref_ver 1130 global pref_status 1131 1132 # Focus to expr window, so that it will never disappear 1133 focus .expr 1134 1135 foreach i { .comm .macros .input .macro .up2 .verw .state } { 1136 pack forget $i 1137 } 1138 if { $pref_macros } { 1139 pack .macros -side top -expand 1 -fill both 1140 } 1141 if { $pref_input } { 1142 pack .input -side top -fill x 1143 } 1144 if { $pref_macrofiles } { 1145 pack .macro -side top -fill x 1146 } 1147 if { $pref_ver } { 1148 pack .verw -side top -fill x 1149 } 1150 if { $pref_status } { 1151 pack .state -side top -fill x 1152 } 1153} 1154 1155# Puts the macro highlighted in given listbox to given textwindow 1156# Puts the macro files name to given label window 1157proc body_to_text { mlist t lw } { 1158 global body_array 1159 global macro_edit 1160 global macro_file_array 1161 global macros 1162 1163 set m [$mlist curselection] 1164 if {$m==""} { return } 1165 set i [lsearch "$macros" [$mlist get $m]] 1166 if {$i==-1} { return } 1167 $t configure -state normal 1168 $t delete 1.0 end 1169 $t insert end $body_array($i) 1170 $t configure -state disabled 1171 # If no label window was given use none 1172 if { "$lw"=="" } { return } 1173 1174 set f $macro_file_array([$mlist curselection]) 1175 $lw configure -text $f 1176} 1177 1178# Puts wrapping on or off in given textwindow according to given global variable 1179proc macro_proc_wrap { textw var } { 1180 global $var 1181 set macro_wrap [set $var] 1182 if { $macro_wrap } { 1183 # It was turned on 1184 $textw configure -wrap char 1185 } else { 1186 $textw configure -wrap none 1187 } 1188} 1189 1190# Creates a menu with given name, with all sgrep commands 1191# When item is selected invokes com with text to be inserted and 1192# number indicating cursor movement 1193proc sgrep_menu { m com } { 1194 menu $m 1195 set c "in {not in} containing {not containing} equal {not equal} or extracting .. ._ _. __ quote _quote quote_ _quote_" 1196 foreach i "$c" { 1197 $m add command -label $i -command "$com \{ $i \} 0" 1198 } 1199 $m add separator 1200 set c "outer inner concat join" 1201 foreach i "$c" { 1202 $m add command -label "$i\( \)" -command "$com \{ $i\( \) \} -3" 1203 } 1204 $m add separator 1205 set c "start end chars" 1206 foreach i "$c" { 1207 $m add command -label "$i" -command "$com \{ $i \} 0" 1208 } 1209 $m add separator 1210 $m add command -label "( )" -command "$com {( )} -2" 1211 $m add command -label "\" \"" -command "$com {\"\"} -1" 1212 $m add command -label {[ ]} -command "$com \{\[\]\} -1" 1213} 1214 1215# This command is executed when macro editor is spawned 1216proc macro_editor { winname macrofile } { 1217 global macros 1218 global body_array 1219 global macro_file_array 1220 global macro_editors 1221 1222 if { [winfo exists .mfiles] } { 1223 errwin .editerr "Macro editor error" \ 1224"Close your macrofile selection window 1225Before editing macros." { } 1226 return 1227 } 1228 1229 # If window already exists, bringt it to front 1230 if { [winfo exists $winname] } { 1231 wm withdraw $winname 1232 centerwin $winname . 1233 wm deiconify $winname 1234 return 1235 } 1236 1237 # We have now one macro editor more 1238 incr macro_editors 1239 1240 # Variables of one instance of macro editor 1241 global macros_edited$winname 1242 set macros_edited$winname 0 1243 global macro_file$winname 1244 set macro_file$winname $macrofile 1245 global macro_num$winname 1246 set macro_num$winname -1 1247 1248 # Toplevel window 1249 toplevel $winname 1250 wm title $winname "Macro editor - $macrofile" 1251 centerwin $winname . 1252 1253 # Menubar 1254 pack [ 1255 frame $winname.menu -relief raised -borderwidth 2p 1256 ] -side top -fill x 1257 menubutton $winname.menu.file -menu $winname.menu.file.m -text "File" \ 1258 -underline 0 1259 menubutton $winname.menu.macros -menu $winname.menu.macros.m -text "Macros" \ 1260 -underline 0 1261 menubutton $winname.menu.sgrep -menu $winname.menu.sgrep.m -text "Operators" \ 1262 -underline 3 -state disabled 1263 1264 pack $winname.menu.file -side left 1265 menu $winname.menu.file.m 1266 $winname.menu.file.m add command -label "Save" \ 1267 -command "me_save $winname" 1268 $winname.menu.file.m add command -label "Save as.." \ 1269 -command "me_save_as $winname" 1270 $winname.menu.file.m add separator 1271 $winname.menu.file.m add command -label "Close" -accelerator "Esc" \ 1272 -command "me_cancel $winname" 1273 1274 pack $winname.menu.macros -side left 1275 menu $winname.menu.macros.m 1276 $winname.menu.macros.m add command -label "Rename" \ 1277 -command "me_rename_macro $winname" 1278 $winname.menu.macros.m add command -label "Insert" \ 1279 -command "me_insert_macro $winname" 1280 $winname.menu.macros.m add command -label "Remove" \ 1281 -command "me_remove_macro $winname" 1282 $winname.menu.macros.m add separator 1283 $winname.menu.macros.m add command -label "Execute" \ 1284 -command "me_execute_macro $winname" 1285 pack $winname.menu.sgrep -side left 1286 sgrep_menu $winname.menu.sgrep.m "me_insertsgrep $winname" 1287 1288 #Macro list 1289 pack [ frame $winname.ml ] -side left -fill y 1290 pack [ 1291 label $winname.ml.label -text "Macro names" -anchor w 1292 ] -side top -fill x 1293 set ml [listb $winname.ml] 1294 $ml configure -height 25 1295 set i [llength $macros] 1296 while { $i>0 } { 1297 incr i -1 1298 if { "$macro_file_array($i)"=="$macrofile" } { 1299 $ml insert 0 [lindex $macros $i] 1300 } 1301 } 1302 $ml activate 0 1303 1304 #Editor window 1305 pack [frame $winname.edit] -side right -fill both -expand 1 1306 pack [ frame $winname.edit.df ] -side top -fill x 1307 pack [ 1308 label $winname.edit.df.label -text "Macro Editor - macro:" -anchor w 1309 ] -side left 1310 pack [ 1311 entry $winname.edit.df.macro -relief sunken 1312 ] -side top -fill x 1313 set t $winname.edit 1314 1315 #Editor buttons 1316 pack [ frame $t.bf ] -side bottom -fill x 1317 foreach i "apply cancel" { 1318 pack [ 1319 button $t.bf.$i -text "$i" -width 6 -state disabled \ 1320 -command "me_ebutton_$i $winname" \ 1321 -underline 0 1322 ] -side left 1323 } 1324 # Editor checkbuttons 1325 foreach i "edit wrap" { 1326 pack [ 1327 checkbutton $t.bf.$i -text "$i" -width 6 \ 1328 -command "me_ebutton_$i $winname" \ 1329 -variable "$i$winname" -underline 0 1330 ] -side right 1331 global $i$winname 1332 } 1333 $t.bf.wrap configure -command "macro_proc_wrap $t.text wrap$winname" 1334 set wrap$winname 1 1335 set edit$winname 0 1336 1337 # Textwindow 1338 pack [ text $t.text -width 50 -state disabled \ 1339 -xscrollcommand "doset $t.hscroll \"-before $t.text -side bottom -fill x\" " \ 1340 -yscrollcommand "doset $t.vscroll \"-before $t.text -side right -fill y\" " \ 1341 -wrap char ] -side right -fill both -expand 1 1342 scrollbar $t.vscroll -orient vertical \ 1343 -command "$t.text yview " 1344 scrollbar $t.hscroll -orient horizontal \ 1345 -command "$t.text xview " 1346 1347 # Bindings 1348 set bt "me_body_to_text $winname" 1349 bind $ml "<Double-Button-1>" "$bt" 1350 bind $ml "<ButtonRelease-1>" "me_listbutton1 $winname" 1351 bind $ml "<space>" "$bt" 1352 bind $ml "<Return>" "$bt" 1353 1354 bind $winname "<Alt-e>" "$winname.edit.bf.edit invoke" 1355 bind $winname "<Alt-w>" "$winname.edit.bf.wrap invoke" 1356 bind $winname "<Alt-c>" "$winname.edit.bf.cancel invoke" 1357 bind $winname "<Alt-a>" "$winname.edit.bf.apply invoke" 1358 bind $winname "<Escape>" "me_cancel $winname" 1359 bind $winname.edit.df.macro "<Return>" "me_macro_enter $winname" 1360 bind $winname.edit.text "<Button-3>" "me_postmenu $winname" 1361 1362 wm protocol $winname WM_DELETE_WINDOW "me_cancel $winname" 1363 1364 # Focus to macro list 1365 focus $ml 1366 # No spontaneous resizing 1367 update 1368 pack propagate $winname 0 1369} 1370 1371# Procedures starting with me_ are macro editor procedures, which are given 1372# macro editor window name as first parameter 1373 1374# Close macro editor 1375proc me_cancel { winname } { 1376 global macros_edited$winname 1377 global macro_file$winname 1378 global macro_editors 1379 1380 if { [set macros_edited$winname] } { 1381 yesno $winname.close \ 1382 "Are you sure you want to close editor \nwithout saving changes ?" \ 1383 "global macros_edited$winname 1384 set macros_edited$winname false 1385 me_cancel $winname" { } 1386 return 1387 } 1388 unset macros_edited$winname 1389 unset macro_file$winname 1390 destroy $winname 1391 incr macro_editors -1 1392} 1393 1394# Saves macro names to default macro file 1395proc me_save { winname } { 1396 global macro_file$winname 1397 global macros_edited$winname 1398 1399 set smacros [$winname.ml.lb get 0 end] 1400 set file [set macro_file$winname] 1401 1402 set result [do_save_macros "$smacros" "$file" "$winname.saveerr"] 1403 set macros_edited$winname $result 1404 return $result 1405} 1406 1407# Asks for new macro file name, then invokes do_save_as 1408proc me_save_as { winname } { 1409 global macro_file$winname 1410 1411 if { [winfo exists $winname.saveas] } { return } 1412 toplevel $winname.saveas 1413 wm title $winname.saveas "Save macrofile [set macro_file$winname] as" 1414 savefile $winname.saveas "me_do_save_as $winname" filter_macro 1415} 1416 1417# Saves macros to new file 1418proc me_do_save_as { winname newfile } { 1419 global macro_file$winname 1420 global macrofiles 1421 global macros 1422 global macro_file_array 1423 1424 if { [lsearch -exact "$macrofiles" $newfile]!=-1 } { 1425 errwin $winname.saverr "Macrofile saving error" \ 1426"macro file with name \"$newfile\"\n is already in use. Choose another name" \ 1427 "me_save_as $winname" 1428 return 1429 } 1430 set oldfile [set macro_file$winname] 1431 set macro_file$winname $newfile 1432 1433 if { ![me_save $winname] } { 1434 #Saving was ok 1435 wm title $winname "Macro editor - $newfile" 1436 set i [lsearch -exact "$macrofiles" $oldfile] 1437 set macrofiles [lreplace "$macrofiles" $i $i $newfile] 1438 set j [llength "$macros"] 1439 while { "$j">0 } { 1440 incr j -1 1441 if { "$macro_file_array($j)"=="$oldfile" } { 1442 set macro_file_array($j) $newfile 1443 } 1444 } 1445 } else { 1446 #Saving failed 1447 set macro_file$winname $oldfile 1448 } 1449} 1450 1451 1452#Macro editor edit checkbutton 1453proc me_ebutton_edit { winname } { 1454 global edit$winname 1455 global macros_edited$winname 1456 1457 if { [set edit$winname] } { 1458 $winname.edit.text configure -state normal 1459 $winname.edit.bf.apply configure -state normal 1460 $winname.edit.bf.cancel configure -state normal 1461 $winname.menu.sgrep configure -state normal 1462 $winname.menu.macros configure -state disabled 1463 focus $winname.edit.text 1464 } else { 1465 $winname.edit.text configure -state disabled 1466 $winname.edit.bf.apply configure -state disabled 1467 $winname.edit.bf.cancel configure -state disabled 1468 $winname.menu.sgrep configure -state disabled 1469 $winname.menu.macros configure -state normal 1470 focus $winname.ml.lb 1471 } 1472} 1473 1474# Macro editor apply button 1475proc me_ebutton_apply { winname } { 1476 global macro_num$winname 1477 global macro_file$winname 1478 global macros_edited$winname 1479 global edit$winname 1480 global body_array 1481 global macro_file_array 1482 global macros 1483 1484 # If for some reason this proc is invoked when not editing 1485 if { ! [set edit$winname] } { return } 1486 1487 set num [set macro_num$winname] 1488 set m [$winname.edit.df.macro get] 1489 set l [$winname.ml.lb get 0 end] 1490 set i [ lsearch -glob "$l" $m] 1491 set m [$winname.ml.lb get $i] 1492 if { $i!=$num || $num==-1 } { 1493 if {$i==-1} { 1494 # We had new macro name to be saved 1495 set last [ lsearch -exact "$macros" [lindex "$l" 0]] 1496 set last [expr $last + [llength "$l"]] 1497 macro_space $last 1498 1499 # insert macro to global macro arrays & lists 1500 set body_array($last) [$winname.edit.text get 0.0 end] 1501 set macro_file_array($last) [set macro_file$winname] 1502 set macros [linsert "$macros" $last [$winname.edit.df.macro get]] 1503 # insert macro to macro listbox 1504 $winname.ml.lb insert end [$winname.edit.df.macro get] 1505 1506 me_changes $winname 1507 $winname.edit.bf.edit invoke 1508 return 1509 } 1510 # We overwrite old macro 1511 set i [ lsearch -exact "$macros" $m] 1512 yesno $winname.replace "Overwrite old macro $m" " 1513 set body_array($i) \{[$winname.edit.text get 0.0 end]\} 1514 me_changes $winname 1515 $winname.edit.bf.edit invoke" "" 1516 return 1517 } 1518 # Replace old macro with newly edited 1519 set i [lsearch -exact "$macros" $m] 1520 set body_array($i) [$winname.edit.text get 0.0 end] 1521 1522 me_changes $winname 1523 #Turn of editing 1524 $winname.edit.bf.edit invoke 1525} 1526 1527# Macro editor cancel editing button 1528proc me_ebutton_cancel { winname } { 1529 global edit$winname 1530 global macro_num$winname 1531 1532 # If for some reason this proc is invoked when not editing 1533 if { ! [set edit$winname] } { return } 1534 1535 $winname.edit.text delete 0.0 end 1536 set macro_num$winname -1 1537 1538 # Turn off editing 1539 $winname.edit.bf.edit invoke 1540} 1541 1542# Macro body to text window button 1543proc me_body_to_text { winname } { 1544 global edit$winname 1545 global macro_num$winname 1546 1547 #If invoked when not editing we fetch macro body to window 1548 if { ! [set edit$winname] } { 1549 set macro_num$winname [$winname.ml.lb curselection] 1550 if { [set macro_num$winname]=="" } { 1551 set macro_num$winname 0 1552 } 1553 # set macro name entry 1554 $winname.edit.df.macro delete 0 end 1555 $winname.edit.df.macro insert 0 [$winname.ml.lb get [set macro_num$winname]] 1556 body_to_text $winname.ml.lb $winname.edit.text {} 1557 return 1558 } 1559 1560 #If invoked when editing insert macro name from listbox 1561 set mn [$winname.ml.lb get active] 1562 $winname.edit.text insert insert " $mn " 1563} 1564 1565# Post command menu to mouse position 1566proc me_postmenu { winname } { 1567 global edit$winname 1568 1569 # If for some reason this proc is invoked when not editing 1570 if { ! [set edit$winname] } { return } 1571 1572 set y [winfo pointery $winname] 1573 set x [winfo pointerx $winname] 1574 set y [expr $y - 20] 1575 set x [expr $x - 40] 1576 1577 if { "$y"<0 } { set y 0 } 1578 if { "$x"<0 } { set x 0 } 1579 $winname.menu.sgrep.m post $x $y 1580 focus $winname.menu.sgrep.m 1581} 1582 1583# Inserts a given text to textwindow of given macroeditor and moves cursor 1584proc me_insertsgrep { winname t cinc } { 1585 $winname.edit.text insert insert "$t" 1586 set s [$winname.edit.text index insert] 1587 # File command isn't made for this purpose, but it works well 1588 set r [file rootname $s] 1589 set c [expr [string trim [file extension $s] .] + $cinc ] 1590 $winname.edit.text mark set insert $r.$c 1591} 1592 1593# When not editing button 1 in listbox fetches macros text 1594proc me_listbutton1 { winname } { 1595 global edit$winname 1596 if { [set edit$winname] } { return } 1597 me_body_to_text $winname 1598} 1599 1600# Procedure which is invoked when enter is pressed in macro name entry 1601proc me_macro_enter { winname } { 1602 global edit$winname 1603 global macro_num$winname 1604 1605 # if not editing macro file, fetch the macro text 1606 if { ! [set edit$winname] } { 1607 set m [$winname.edit.df.macro get] 1608 set l [$winname.ml.lb get 0 end] 1609 set i [ lsearch -glob "$l" $m] 1610 if { $i==-1 } { 1611 $winname.edit.text delete 0 end 1612 set macro_num$winname -1 1613 return 1614 } 1615 $winname.ml.lb see $i 1616 $winname.ml.lb selection clear 0 end 1617 $winname.ml.lb selection set $i 1618 $winname.ml.lb activate $i 1619 set macro_num$winname $i 1620 me_body_to_text $winname 1621 } 1622 # Macro has new name, switch focus to edit window 1623 focus $winname.edit.text 1624} 1625 1626# Macro editor execute macro 1627proc me_execute_macro { winname } { 1628 set i [$winname.ml.lb curselection] 1629 if { "$i"=="" } { set i 0 } 1630 set m [$winname.ml.lb get $i] 1631 if { "$m"=="" } {return } 1632 execsgrep "$m" 1633} 1634 1635# Macro editor insert button 1636proc me_remove_macro { winname } { 1637 global edit$winname 1638 1639 if { [set edit$winname] } { return } 1640 if { [ winfo exists $winname.insert] } { return } 1641 1642 set i [$winname.ml.lb curselection] 1643 if { "$i"==""} { set i 0 } 1644 set m [$winname.ml.lb get $i] 1645 if { "$m"==""} { return } 1646 1647 yesno $winname.remove \ 1648"Are you sure you want to remove macro $m" "me_do_remove $winname" { } 1649} 1650 1651proc me_do_remove { winname } { 1652 global macros 1653 1654 set r $winname.remove 1655 1656 set i [$winname.ml.lb curselection] 1657 if { "$i"==""} { set i 0 } 1658 set m [$winname.ml.lb get $i] 1659 if { "$m"==""} { return } 1660 1661 macro_remove $i 1662 me_changes $winname 1663 $winname.ml.lb delete $i 1664} 1665 1666# Macro editor insert button 1667proc me_insert_macro { winname } { 1668 global edit$winname 1669 1670 if { [set edit$winname] } { return } 1671 if { [ winfo exists $winname.insert] } { return } 1672 1673 set i [$winname.ml.lb curselection] 1674 if { "$i"==""} { set i 0 } 1675 set m [$winname.ml.lb get $i] 1676 if { "$m"==""} { return } 1677 1678 set r [toplevel $winname.insert] 1679 wm transient $r $winname 1680 1681 pack [ frame $r.bottom ] -side bottom 1682 pack [ frame $r.left ] -side left 1683 pack [ frame $r.right] -side right 1684 1685 # buttons 1686 button $r.bottom.cancel -text "Cancel" -command "destroy $r" -width 8 1687 button $r.bottom.ok -text "Insert" -command "me_do_insert $winname" \ 1688 -width 8 1689 pack $r.bottom.cancel $r.bottom.ok -side left 1690 1691 # Left labels 1692 label $r.left.from -text "Insert before:" -anchor e 1693 pack $r.left.from -fill x -side top 1694 label $r.left.to -text "macro name:" -anchor e 1695 pack $r.left.to -fill x -side top 1696 # Right label & entry 1697 pack [ label $r.right.from -text "$m" -relief ridge -anchor w] -side top -fill x 1698 pack [ entry $r.right.entry -width 12 -relief sunken ] -side top -fill x 1699 1700 bind $r "<Escape>" "destroy $r" 1701 bind $r.right.entry "<Return>" "me_do_insert $winname" 1702 1703 centerwin $r $winname 1704 grab $r 1705 focus $r.right.entry 1706} 1707 1708proc me_do_insert { winname } { 1709 global macros 1710 global body_array 1711 1712 set r $winname.insert 1713 1714 set new_name [$r.right.entry get] 1715 if { "$new_name"=="" } { 1716 # Empty macro name, just destroy window 1717 destroy $r 1718 return 1719 } 1720 set i [lsearch -exact "$macros" $new_name] 1721 if { "$i"!="-1" } { 1722 # Macro with given name already exists, we give error message 1723 errwin $r.renerror "Macro insert error:" \ 1724"Macro with given name already existed. 1725Use some other name." "grab $r;focus $r.right.entry" 1726 return 1727 } 1728 set i [lsearch -exact "$macros" [$r.right.from cget -text]] 1729 1730 # Now we do inserting 1731 macro_space $i 1732 # Whatever is in the text box is used as macro body 1733 set body_array($i) [$winname.edit.text get 0.0 end] 1734 set macros [linsert "$macros" $i $new_name] 1735 set j [$winname.ml.lb curselection] 1736 if { "$j"=="" } { set j 0 } 1737 $winname.ml.lb insert $j $new_name 1738 $winname.ml.lb activate $j 1739 $winname.ml.lb selection clear 0 end 1740 $winname.ml.lb selection set $j 1741 $winname.edit.df.macro delete 0 end 1742 $winname.edit.df.macro insert 0 $new_name 1743 destroy $r 1744 me_changes $winname 1745} 1746 1747# Macro editor rename button 1748proc me_rename_macro { winname } { 1749 global edit$winname 1750 1751 if { [set edit$winname] } { return } 1752 if { [ winfo exists $winname.rename] } { return } 1753 1754 set i [$winname.ml.lb curselection] 1755 if { "$i"==""} { set i 0 } 1756 set m [$winname.ml.lb get $i] 1757 if { "$m"==""} { return } 1758 1759 set r [toplevel $winname.rename] 1760 wm transient $r $winname 1761 1762 pack [ frame $r.bottom ] -side bottom 1763 pack [ frame $r.left ] -side left 1764 pack [ frame $r.right] -side right 1765 1766 # buttons 1767 button $r.bottom.cancel -text "Cancel" -command "destroy $r" -width 8 1768 button $r.bottom.ok -text "Rename" -command "me_do_rename $winname" \ 1769 -width 8 1770 pack $r.bottom.cancel $r.bottom.ok -side left 1771 1772 # Left labels 1773 label $r.left.from -text "Rename macro:" -anchor e 1774 pack $r.left.from -fill x -side top 1775 label $r.left.to -text "to macro:" -anchor e 1776 pack $r.left.to -fill x -side top 1777 # Right label & entry 1778 pack [ label $r.right.from -text "$m" -relief ridge -anchor w] -side top -fill x 1779 pack [ entry $r.right.entry -width 12 -relief sunken ] -side top -fill x 1780 1781 bind $r "<Escape>" "destroy $r" 1782 bind $r.right.entry "<Return>" "me_do_rename $winname" 1783 1784 centerwin $r $winname 1785 grab $r 1786 focus $r.right.entry 1787} 1788 1789proc me_do_rename { winname } { 1790 global macros 1791 1792 set r $winname.rename 1793 1794 set new_name [$r.right.entry get] 1795 if { "$new_name"=="" } { 1796 # Empty macro name, just destroy window 1797 destroy $r 1798 return 1799 } 1800 set i [lsearch -exact "$macros" $new_name] 1801 if { "$i"!="-1" } { 1802 # Macro with given name already exists, we give error message 1803 errwin $r.renerror "Macro renaming error:" \ 1804"Macro with given name already existed. 1805Use some other name." "grab $r;focus $r.right.entry" 1806 return 1807 } 1808 set i [lsearch -exact "$macros" [$r.right.from cget -text]] 1809 # Now we do renaming 1810 set macros [lreplace "$macros" $i $i $new_name] 1811 set j [$winname.ml.lb curselection] 1812 if { "$j"=="" } { set j 0 } 1813 $winname.ml.lb delete $j 1814 $winname.ml.lb insert $j $new_name 1815 $winname.ml.lb activate $j 1816 $winname.ml.lb selection set $j 1817 destroy $r 1818 me_changes $winname 1819} 1820 1821# Changes have been done to macros. 1822proc me_changes { winname } { 1823 global macros_edited$winname 1824 global mlist 1825 1826 # Macros of this window have now been edited 1827 set macros_edited$winname 1 1828 # We update main windows macro list 1829 update_macro_list 1830 # We do body_to_text in main window 1831 body_to_text $mlist .macros.text .macros.tbf.filename 1832} 1833 1834# Makes space in macro array for one macro 1835proc macro_space { ind } { 1836 global macros 1837 global body_array 1838 global macro_file_array 1839 1840 set l [llength $macros] 1841 set p [expr $l - 1] 1842 while { "$ind" < "$l" } { 1843 set body_array($l) $body_array($p) 1844 set macro_file_array($l) $macro_file_array($p) 1845 incr p -1 1846 incr l -1 1847 } 1848} 1849 1850# Removes one macro from macro array 1851proc macro_remove { ind } { 1852 global macros 1853 global body_array 1854 global macro_file_array 1855 1856 set l [llength $macros] 1857 set macros [lreplace "$macros" $ind $ind] 1858 set next [expr $ind + 1] 1859 while { $next < $l } { 1860 set body_array($ind) $body_array($next) 1861 set macro_file_array($ind) $macro_file_array($ind) 1862 incr ind 1863 incr next 1864 } 1865} 1866 1867# This command is executed when macro editing is asked 1868# It asks for macro file to be edited. If only one macrofile is used it 1869# spawns editor immediately 1870proc edit_macros { } { 1871 global macrofiles 1872 # No macrofiles, no editing 1873 if { [llength $macrofiles] == 0 } return 1874 if { [llength $macrofiles] > 1 } { 1875 # Here will be macro file chooser system some day 1876 if { [winfo exists .editch] } { 1877 return 1878 } 1879 1880 toplevel .editch 1881 wm title .editch "Choose macrofile" 1882 wm transient .editch . 1883 centerwin .editch . 1884 1885 pack [ label .editch.label -relief raised -text "Which macrofile you wish to edit ?" 1886 ] -side top -fill x 1887 pack [ frame .editch.bf ] -side bottom 1888 foreach i "edit cancel" { 1889 pack [ 1890 button .editch.bf.$i -text $i -width 6 1891 ] -side left -pady 5 1892 } 1893 1894 set lb [listb .editch] 1895 eval $lb insert end $macrofiles 1896 set i [llength $macrofiles] 1897 1898 set edit_me { 1899 macro_editor .macroedit[.editch.lb curselection] \ 1900 [lindex $macrofiles [.editch.lb curselection]] 1901 destroy .editch 1902 } 1903 .editch.bf.cancel configure -command "destroy .editch" 1904 .editch.bf.edit configure -command "$edit_me" 1905 focus $lb 1906 bind .editch "<Escape>" "destroy .editch" 1907 bind .editch "<Return>" "$edit_me" 1908 bind .editch "<space>" "$edit_me" 1909 bind .editch "<Double-Button-1>" "$edit_me" 1910 grab .editch 1911 } else { 1912 macro_editor .macroedit0 [lindex $macrofiles 0 ] 1913 } 1914} 1915 1916# Inserts sgrep command to entry 1917proc insert_entry { cmd move } { 1918 .expr insert insert "$cmd" 1919 set t [.expr index insert] 1920 set t [ expr $t + $move] 1921 .expr icursor $t 1922} 1923 1924# Post sgrep command menu to cursor 1925# position 1926proc postsgrepmenu { } { 1927 set y [winfo pointery .] 1928 set x [winfo pointerx .] 1929 set y [expr $y - 20] 1930 set x [expr $x - 40] 1931 1932 if { "$y"<0 } { set y 0 } 1933 if { "$x"<0 } { set x 0 } 1934 .menu.sgrep.m post $x $y 1935 focus .menu.sgrep.m 1936} 1937 1938proc do_exit { } { 1939 global macro_editors 1940 1941 if { $macro_editors>0 } { 1942 yesno .dying "There are still macro editors open\nExit anyway ?" \ 1943 { exit } { } 1944 return 1945 } 1946 exit 1947} 1948 1949# Window for ascing file name for all macros 1950proc save_all_macros { } { 1951 if { [winfo exists .saveall] } { return } 1952 toplevel .saveall 1953 wm title .saveall "Save all macros as" 1954 centerwin .saveall . 1955 savefile .saveall "do_save_all" filter_macro 1956} 1957 1958# Saves all macros to given file 1959proc do_save_all { file } { 1960 global macros 1961 1962 if { [llength "$macros"]==0 } { 1963 # No macros, nothing to save 1964 errwin .saveall "Macro saving error" "No macros to save!" { } 1965 return 1966 } 1967 do_save_macros "$macros" $file .saveerr 1968} 1969 1970# Saves given macros to given file using given errorwindow 1971# Returns immediately returning 1 on error 1972proc do_save_macros { smacros file errtop } { 1973 set f [generate_macro_file "$smacros"] 1974 .state configure -text "Saving macrofile.." 1975 update 1976 if { [catch { set fd [open $file w] } err] } { 1977 errwin $errtop "Macro saving error" \ 1978"Could not open macro file for saving. 1979Reason given:\n$err" { } 1980 return 1 1981 } 1982 if { [catch { puts -nonewline $fd "$f" } err] } { 1983 errwin $errtop "Macro saving error" \ 1984"Writing macro file failed. 1985Data may have corrupt. 1986Reason given:\n$err" { } 1987 close $fd 1988 return 1 1989 } 1990 close $fd 1991 .state configure -text "Ready" 1992 return 0 1993} 1994 1995# 1996# Creates an about toplevel window 1997proc aboutcreate { } { 1998 global sgtversion 1999 if { [winfo exists .about] } { 2000 wm withdraw .about 2001 wm deiconify .about 2002 centerwin .about . 2003 return 2004 } 2005 toplevel .about 2006 wm title .about "sgreptool -about" 2007 pack [ button .about.ok -text "ok" -command "destroy .about" -width 10] -side bottom 2008 message .about.msg -font -Adobe-times-medium-r-normal--*-180-*-*-*-*-*-* \ 2009 -relief raised -width 500 \ 2010 -borderwidth 1 -justify center \ 2011 -text " 2012Sgreptool $sgtversion - A frontend to structured text retrieval tool sgrep 2013 2014Sgreptool and sgrep were made by: 2015Jani Jaakkola, Jani.Jaakkola@cc.helsinki.fi 2016Pekka Kilpel�inen, Pekka.Kilpelainen@cc.helsinki.fi 2017 2018Copyright University of Helsinki, Dept. of Computer Science 2019Distributed under GNU General Public Lisence 2020See file COPYING for details 2021" 2022 pack .about.msg -fill x 2023 focus .about.ok 2024 centerwin .about . 2025} 2026 2027# Our name is sgreptool 2028wm title . "sgreptool" 2029 2030# Pull down menus 2031frame .menu -relief raised -borderwidth 2p 2032pack .menu -side top -fill x 2033 2034menubutton .menu.file -menu .menu.file.m -text File -underline 0 2035menu .menu.file.m 2036.menu.file.m add command -label "Execute query" -command {execsgrep $sgrepexpr} 2037.menu.file.m add separator 2038.menu.file.m add command -label "Input files .." -command "ifcreate" 2039.menu.file.m add command -label "Macrofiles .." -command "macrocreate" 2040.menu.file.m add command -label "Preprocessor .." -command "precreate" 2041.menu.file.m add separator 2042.menu.file.m add command -label "Rescan macrofiles" -command "fetch_macros" 2043.menu.file.m add command -label "Edit macrofile.." -command "edit_macros" 2044.menu.file.m add command -label "Save all macros as.." \ 2045 -command "save_all_macros" 2046.menu.file.m add separator 2047.menu.file.m add command -label "About .." -command "aboutcreate" 2048.menu.file.m add separator 2049.menu.file.m add command -label "Exit" -command "do_exit" -underline 1 2050 2051menubutton .menu.options -menu .menu.options.m -text Options -underline 0 2052menu .menu.options.m 2053.menu.options.m add checkbutton -label "Filter mode" -variable opt_filter 2054.menu.options.m add checkbutton -label "Only count regions" -variable opt_count 2055.menu.options.m add checkbutton -label "No concat" -variable opt_concat 2056.menu.options.m add checkbutton -label "No trailing newline" -variable opt_nl 2057.menu.options.m add checkbutton -label "Show preprocessed expression" -variable opt_preproexpr 2058.menu.options.m add checkbutton -label "Stream mode" -variable opt_stream 2059.menu.options.m add separator 2060.menu.options.m add radiobutton -label "Short output style" \ 2061 -variable opt_out -value "-s" -command "del_stylepop" 2062.menu.options.m add radiobutton -label "Long output style" \ 2063 -variable opt_out -value "-l" -command "del_stylepop" 2064.menu.options.m add radiobutton -label "Custom output style .." \ 2065 -variable opt_out -value "-o" -command "del_stylepop;select_outstyle" 2066.menu.options.m add radiobutton -label "Output style file .." \ 2067 -variable opt_out -value "-O" -command "del_stylepop;select_outfile" 2068 2069.menu.options.m add separator 2070.menu.options.m add checkbutton -label "Job statistics" -variable opt_job 2071.menu.options.m add checkbutton -label "Time statistics" -variable opt_time 2072 2073menubutton .menu.pref -menu .menu.pref.m -text Preferences -underline 0 2074menu .menu.pref.m 2075.menu.pref.m add checkbutton -label "Show macros" -variable pref_macros -command apply_preferences 2076.menu.pref.m add checkbutton -label "Show input files" -variable pref_input -command apply_preferences 2077.menu.pref.m add checkbutton -label "Show macro files" -variable pref_macrofiles -command apply_preferences 2078.menu.pref.m add checkbutton -label "Show sgrep version" -variable pref_ver -command apply_preferences 2079.menu.pref.m add checkbutton -label "Show status line" -variable pref_status -command apply_preferences 2080 2081menubutton .menu.sgrep -menu .menu.sgrep.m -text Operators -underline 3 2082sgrep_menu .menu.sgrep.m insert_entry 2083 2084pack .menu.file .menu.options .menu.pref .menu.sgrep -side left 2085 2086# These frames unpacked and packed when user selects preferences 2087 # Frame for expression related widgets 2088 frame .up1 -relief ridge 2089 pack .up1 -side top -fill x 2090 2091 # Frame for sgrep macros 2092 frame .macros 2093 # Frame for input files 2094 frame .input 2095 # Frame for macro files 2096 frame .macro 2097 # Window containing version text 2098 label .verw -relief ridge -text "using $sgrepver" 2099 # Window containing state 2100 label .state -relief ridge -text "Ready" -width 15 2101 2102# Expression label & nearby buttons 2103pack [frame .exprstuff] -in .up1 -side left -fill y 2104pack [label .exprstuff.label -text expression: -width 10 ] -side top -anchor ne -pady 2 2105pack [ 2106 button .exprstuff.clear -text "Clear" -command { set sgrepexpr "" } 2107 ] -side top -fill x 2108# Expression entry. Switch focus by default to this. 2109entry .expr -textvariable sgrepexpr -width 50 \ 2110 -xscrollcommand { .exprscroll set } 2111pack .expr -side top -in .up1 -fill x -ipadx 10p -ipady 2p 2112focus .expr 2113# Enter executes query 2114bind .expr <Return> {execsgrep $sgrepexpr} 2115# Button 3 gives sgrep commands menu 2116bind .expr <Button-3> "postsgrepmenu" 2117 2118# Expression scrollbar 2119scrollbar .exprscroll -orient horizontal -command { .expr xview } 2120pack .exprscroll -side bottom -in .up1 -fill x 2121 2122# label for input files 2123label .input.label -text "Input files:" -width 10 -anchor ne 2124pack .input.label -side left 2125label .input.text -textvariable input_files -relief ridge -anchor w 2126pack .input.text -fill x 2127 2128# label for macro files 2129pack [label .macro.label -text "Macro files:" -width 10 -anchor ne] -side left 2130pack [label .macro.text -textvariable macrofiles -relief ridge -anchor w ] -fill x 2131# Button frame 2132frame .bf 2133pack .bf -side bottom 2134 2135# Macro window 2136pack [frame .macros.l] -side left -fill y 2137pack [label .macros.l.label -text Macros -anchor w] -side top -fill x 2138set mlist [listb .macros.l] 2139 2140set bt "body_to_text $mlist .macros.text .macros.tbf.filename" 2141bind $mlist <space> "$bt" 2142bind $mlist <ButtonRelease-1> "$bt" 2143bind $mlist <Double-Button-1> {.expr insert insert " [$mlist get active] "} 2144bind $mlist <Return> {.expr insert insert " [$mlist get active] "} 2145$mlist configure -height 6 -width 20 2146pack [ frame .macros.tbf ] -side top -fill x 2147pack [ label .macros.tbf.tlabel -text "Macro text - From file:" -anchor w ] -side left 2148pack [ checkbutton .macros.tbf.wrap -text wrap -variable macro_wrap \ 2149 -command "macro_proc_wrap .macros.text macro_wrap" ] -side right 2150 2151set macro_wrap 1 2152pack [ label .macros.tbf.filename -relief ridge -width 25 -anchor w 2153 ] -side left -fill x -expand 1 2154# create macro text scrollbars 2155scrollbar .macros.vscroll -orient vertical \ 2156 -command ".macros.text yview " 2157scrollbar .macros.hscroll -orient horizontal \ 2158 -command ".macros.text xview " 2159# Create macro text 2160text .macros.text \ 2161 -xscrollcommand "doset .macros.hscroll { -after .macros.text -side bottom -fill x } " \ 2162 -yscrollcommand "doset .macros.vscroll { -before .macros.text -side right -fill y } " \ 2163 -wrap char -height 2 -width 10 2164pack .macros.text -fill both -expand 1 2165.macros.text configure -state disabled 2166 2167bind . "<Alt-x>" "do_exit" 2168bind . "<Alt-e>" {execsgrep $sgrepexpr} 2169wm protocol . WM_DELETE_WINDOW "do_exit" 2170 2171apply_preferences 2172 2173fetch_macros 2174 2175# The bitmap 2176#image create bitmap icon_bmp -file sgtool.xbm 2177#wm iconbitmap . @./sgtool.xbm 2178 2179# I don't like the main window resizing itself 2180update 2181pack propagate . 0 2182$mlist configure -height 2 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200