lib/tcl/text.tcl

   1 #---------------------------------------------------------------
   2 # Text regexp manipulation and text file import
   3 #
   4 # The core routine text_regexp takes either the selected
   5 # items or all items, searches them for text labels, and
   6 # makes the text replacement according to the regular
   7 # expression "searchstr" and the replacement text "replacestr".
   8 #
   9 #---------------------------------------------------------------
  10
  11 # Declare the package by setting variable XCOps(module,text)
  12 set XCOps(module,text) 1
  13
  14 proc text_regexp {searchstr replacestr {mode all}} {
  15    switch -glob -- $mode {
  16       select* {set partlist [select get]; set resel 1}
  17       default {deselect selected; set partlist [object parts]; set resel 0}
  18    }
  19    config suspend true
  20    undo series start
  21    foreach j $partlist {
  22       if {[element $j type] == "Label"} {
  23          set labelparts [lindex [label $j list] 0]
  24          set newparts {}
  25          set modified 0
  26          foreach k $labelparts {
  27             if {[lindex $k 0] == "Text"} {
  28                set tstring [lindex $k 1]
  29                set newt [regsub [list $searchstr] $tstring $replacestr]
  30                set newk [lreplace $k 1 1 $newt]
  31                lappend newparts $newk
  32                if {"$newt" != "$tstring"} {set modified 1}
  33             } else {
  34                lappend newparts $k
  35             }
  36          }
  37          if {$modified == 1} {
  38             label $j replace $newparts
  39          }
  40       }
  41    }
  42    if {$resel == 1} {catch {select $partlist}}
  43    undo series end
  44    refresh
  45    config suspend false
  46 }
  47
  48 #-----------------------------------------------------------------
  49 # Procedures to help with label generation (label autoincrement)
  50 #-----------------------------------------------------------------
  51
  52 # autoincrement the first number found in the text of the indicated
  53 # label(s).  Use argument "amount" to decrement, or increment by 10,
  54 # etc.
  55 #
  56 # example:   xcircuit::textincrement selected
  57
  58 proc xcircuit::textincrement {mode {amount 1} {position first}} {
  59    switch -glob -- $mode {
  60       select* {set handle [select get]; set resel 1}
  61       default {deselect selected; set handle [object parts]; set resel 0}
  62    }
  63    config suspend true
  64    undo series start
  65
  66    foreach h $handle {
  67       if {[element $h type] == "Label"} {
  68          set tlist [join [label $h list]]
  69          set tlen [llength $tlist]
  70          for {set i 0} {$i < $tlen} {incr i} {
  71             set t [lindex $tlist $i]
  72             set esc [lindex $t 0]
  73             if {$esc == "Text"} {
  74                set ltext [lindex $t 1]
  75                set idx 0
  76                if {"$position" == "last"} {
  77                   set result [regexp -indices -all {([+-]?)[0]*[[:digit:]]+} \
  78                                 $ltext lmatch bounds]
  79                   set idx [lindex $bounds 0]
  80                   if {$result > 0} {
  81                      regexp -start $idx {([+-]?)([0]*)([[:digit:]]+)} $ltext \
  82                                 lmatch pre zer num
  83                   }
  84                } else {
  85                   set result [regexp {([+-]?)([0]*)([[:digit:]]+)} $ltext \
  86                                 lmatch pre zer num]
  87                }
  88
  89                if {$result > 0 && $num != ""} {
  90                   set num $pre$num
  91                   incr num $amount
  92                   if {$num < 0} {
  93                      set num [expr abs($num)]
  94                      set pre "-"
  95                   }
  96                   if {$num == 0 && "$pre" == "-"} {set pre ""}
  97                   if {"$position" == "last"} {
  98                      regsub -start $idx {[+-]?[0]*[[:digit:]]+} $ltext $pre$zer$num ltext
  99                   } else {
 100                      regsub {[+-]?[0]*[[:digit:]]+} $ltext $pre$zer$num ltext
 101                   }
 102                   set t [lreplace $t 1 1 $ltext]
 103                   set tlist [lreplace $tlist $i $i $t]
 104                   label $h replace $tlist
 105                   break
 106                }
 107             }
 108          }
 109       }
 110    }
 111    if {$resel == 1} {catch {select $handle}}
 112    undo series end
 113    refresh
 114    config suspend false
 115 }
 116
 117 proc xcircuit::autoincr {{value 1} {position first}} {
 118    set e [eventmode]
 119    set nopreselect 0
 120    if {$e != "text" && $e != "etext" && $e != "epoly"} {
 121       if {[select] == 0} {
 122          set nopreselect 1
 123          undo series start
 124          select here
 125       }
 126       if {[select] > 0} {
 127          xcircuit::textincrement selected $value $position
 128          if {$nopreselect} {
 129             deselect
 130             undo series end
 131             refresh
 132          }
 133       } else {
 134          if {$nopreselect} {
 135             undo series end
 136          }
 137          error "no selection"
 138       }
 139    } else {
 140       error "no auto-incr in text mode"
 141    }
 142 }
 143
 144 #-----------------------------------------------------------------
 145 # Create a popup window for text modification
 146 #-----------------------------------------------------------------
 147
 148 proc xcircuit::maketextmod {} {
 149    toplevel .textmod -bg beige
 150    wm withdraw .textmod
 151
 152    frame .textmod.title -bg beige
 153    label .textmod.title.field -text "Label text modification for:" -bg beige
 154    menubutton .textmod.title.type -text "selected text" -bg beige \
 155         -menu .textmod.title.type.seltype
 156    button .textmod.title.dbut -text "Dismiss" -bg beige -command \
 157         {wm withdraw .textmod}
 158
 159    menu .textmod.title.type.seltype -tearoff 0
 160    .textmod.title.type.seltype add command -label "selected text" -command \
 161         {.textmod.title.type configure -text "selected text"}
 162    .textmod.title.type.seltype add command -label "all text in page" -command \
 163         {.textmod.title.type configure -text "all text in page"}
 164
 165
 166    pack .textmod.title -side top -fill x
 167    pack .textmod.title.field -side left -padx 10
 168    pack .textmod.title.type -side left -padx 10
 169    pack .textmod.title.dbut -side right -ipadx 10
 170
 171    labelframe .textmod.replace -text "Search and Replace" -bg beige
 172    pack .textmod.replace -side top -fill x -expand true -pady 10
 173
 174    label .textmod.replace.title1 -text "Search for:" -bg beige
 175    entry .textmod.replace.original -bg white
 176    label .textmod.replace.title2 -text "Replace with:" -bg beige
 177    entry .textmod.replace.new -bg white
 178    button .textmod.replace.apply -text "Apply" -bg beige -command \
 179         {text_regexp [.textmod.replace.original get] \
 180         [.textmod.replace.new get] [.textmod.title.type cget -text]}
 181
 182    pack .textmod.replace.title1 -side left
 183    pack .textmod.replace.original -side left
 184    pack .textmod.replace.title2 -side left
 185    pack .textmod.replace.new -side left
 186    pack .textmod.replace.apply -side right -ipadx 10 -padx 10
 187
 188    # Numeric Increment/Decrement
 189
 190    labelframe .textmod.numeric -text "Embedded Numbers" -bg beige
 191    pack .textmod.numeric -side top -fill x -expand true
 192
 193    button .textmod.numeric.incr -text "Increment" -bg beige -command \
 194         {xcircuit::textincrement [.textmod.title.type cget -text] \
 195         [.textmod.numeric.amount get] [.textmod.numeric.pos cget -text]}
 196    button .textmod.numeric.decr -text "Decrement" -bg beige -command \
 197         {xcircuit::textincrement [.textmod.title.type cget -text] \
 198         [expr -[.textmod.numeric.amount get]] [.textmod.numeric.pos cget -text]}
 199    label .textmod.numeric.title1 -text "Amount: " -bg beige
 200    entry .textmod.numeric.amount -bg white
 201
 202    menubutton .textmod.numeric.pos -text "first" -bg beige \
 203         -menu .textmod.numeric.pos.posmenu
 204    menu .textmod.numeric.pos.posmenu -tearoff 0
 205    .textmod.numeric.pos.posmenu add command -label "first" -command \
 206         {.textmod.numeric.pos configure -text "first"}
 207    .textmod.numeric.pos.posmenu add command -label "last" -command \
 208         {.textmod.numeric.pos configure -text "last"}
 209
 210    .textmod.numeric.amount insert 0 "1"
 211
 212    pack .textmod.numeric.incr -side left -ipadx 10 -padx 10
 213    pack .textmod.numeric.decr -side left -ipadx 10 -padx 10
 214    pack .textmod.numeric.title1 -side left
 215    pack .textmod.numeric.amount -side left
 216    pack .textmod.numeric.pos -side left
 217 }
 218
 219 proc xcircuit::textmod {} {
 220
 221    if {[catch {wm state .textmod}]} {
 222       xcircuit::maketextmod
 223    }
 224    set wstate [xcircuit::getinitstate .textmod]
 225
 226    # setup goes here
 227
 228    if {"$wstate" != "normal"} {
 229       wm deiconify .textmod
 230       xcircuit::centerwin .textmod
 231    }
 232    raise .textmod
 233 }
 234
 235 #--------------------------------------------------------------
 236 # This procedure reads an entire file into an xcircuit string.
 237 #--------------------------------------------------------------
 238
 239 proc xcircuit::importtext {filename} {
 240    set ffile [open $filename]
 241    set tlist {}
 242    if {[gets $ffile line] >= 0} {
 243       set line [string map {\t "        "} $line]
 244       lappend tlist [list Text $line]
 245       while {[gets $ffile line] >= 0} {
 246          set line [string map {\t "        "} $line]
 247          lappend tlist Return
 248          lappend tlist [list Text $line]
 249       }
 250    }
 251    label make normal $tlist "0 0"
 252    close $ffile
 253    refresh
 254 }
 255
 256 #-----------------------------------------------------------------
 257
 258 proc xcircuit::promptimporttext {} {
 259    .filelist.bbar.okay configure -command \
 260         {xcircuit::importtext [.filelist.textent.txt get]; \
 261         wm withdraw .filelist}
 262    .filelist.listwin.win configure -data ""
 263    .filelist.textent.title.field configure -text "Select text file:"
 264    .filelist.textent.txt delete 0 end
 265    xcircuit::popupfilelist
 266 }
 267
 268 #-----------------------------------------------------------------