software/tcl/textprops.tcl

   1
   2 package require Tk
   3
   4 namespace eval textprops {
   5
   6 proc fillMenus {} {
   7         if {![winfo exists .entrymenu]} {
   8         menu .entrymenu -tearoff 0
   9         foreach {event shortcut} {Cut Ctrl-X  Copy Ctrl-C  Paste Ctrl-V} {
  10                 .entrymenu add command -label $event -command "event generate \$::textprops::currentEntry <<$event>>" -accelerator $shortcut
  11         }
  12         .entrymenu add command -label Delete -command "event generate \$::textprops::currentEntry <Key-Delete>" -accelerator Del
  13         }
  14         if {![winfo exists .textmenu]} {
  15                 menu .textmenu -tearoff 0
  16                 foreach {event shortcut} {Undo Ctrl-Z Redo Ctrl-Shift-Z Cut
  17                         Ctrl-X Copy Ctrl-C Paste Ctrl-V} {
  18                         .textmenu add command -label $event -command "event generate \$textprops::currentText <<$event>>" -accelerator $shortcut
  19                 }
  20                 .textmenu insert Redo separator
  21                 .textmenu add command -label Delete -command "event generate \$::textprops::currentText <Key-Delete>" -accelerator Del
  22                 .textmenu add separator
  23                 .textmenu add command -label "Insert file..." -command [namespace code insertFile ]
  24         }
  25 }
  26
  27 proc insertFile {} {
  28         variable currentText
  29         set w $currentText
  30         set filename [tk_getOpenFile -title "Insert a file" -filetypes\
  31                         {{"Text files" {txt}} {"All files" {*}}}]
  32         if {![string length $filename]} return
  33         set f [open $filename]
  34     set oldSeparator [$w cget -autoseparators]
  35         if { $oldSeparator } {
  36              $w configure -autoseparators 0
  37              $w edit separator
  38         }
  39         $w insert insert [read $f]
  40         if { $oldSeparator } {
  41              $w edit separator
  42              $w configure -autoseparators 1
  43         }
  44         close $f
  45 }
  46
  47 proc textRightButton {widget x y} {
  48         variable currentText
  49         set hasSelection [llength [$widget tag ranges sel]]
  50         if {$hasSelection} {
  51                 .textmenu entryconfigure Copy -state normal
  52         } else {
  53                 .textmenu entryconfigure Copy -state disabled
  54         }
  55         if {[$widget cget -state] eq "disabled"} {
  56                 foreach entry {Undo Redo Paste "Insert file..." Cut Delte} {
  57                         .textmenu entryconfigure $entry -state disabled
  58             }
  59         } else {
  60                 .textmenu entryconfigure "Insert file..." -state normal
  61                 if {[catch {clipboard get}]} {
  62                         .textmenu entryconfigure Paste -state disabled
  63                 } else {
  64                         .textmenu entryconfigure Paste -state normal
  65                 }
  66                 if {$hasSelection} {
  67                         .textmenu entryconfigure Cut -state normal
  68                         .textmenu entryconfigure Delete -state normal
  69                 } else {
  70                         .textmenu entryconfigure Cut -state disabled
  71                         .textmenu entryconfigure Delete -state disabled
  72                 }
  73                 if {[$widget cget -undo]} {
  74                         if {[$widget edit modified]} {
  75                                 .textmenu entryconfigure Undo -state normal
  76                         } else {
  77                                 .textmenu entryconfigure Undo -state disabled
  78                         }
  79                         .textmenu entryconfigure Redo -state normal
  80                 } else {
  81                         .textmenu entryconfigure Undo -state disabled
  82                         .textmenu entryconfigure Redo -state disabled
  83                 }
  84
  85         }
  86         set currentText $widget
  87         tk_popup .textmenu $x $y
  88 }
  89 proc entryRightButton {widget x y} {
  90         variable currentEntry
  91         if {[$widget cget -state] eq "disabled"||[catch {clipboard get}]} {
  92                 .entrymenu entryconfigure Paste -state disabled
  93         } else {
  94                 .entrymenu entryconfigure Paste -state normal
  95         }
  96         if {[$widget selection present]} {
  97                 .entrymenu entryconfigure Copy -state normal
  98                 if {[$widget cget -state] ne "disabled"} {
  99                         .entrymenu entryconfigure Cut -state normal
 100                         .entrymenu entryconfigure Delete -state normal
 101                 } else {
 102                         .entrymenu entryconfigure Cut -state disabled
 103                         .entrymenu entryconfigure Delete -state disabled
 104                 }
 105         } else {
 106                 .entrymenu entryconfigure Cut -state disabled
 107                 .entrymenu entryconfigure Delete -state disabled
 108                 .entrymenu entryconfigure Copy -state disabled
 109         }
 110         set currentEntry $widget
 111         tk_popup .entrymenu $x $y
 112 }
 113
 114 bind Entry <Button-3> [namespace code {entryRightButton %W %X %Y}]
 115 bind Text <Button-3> [namespace code {textRightButton %W %X %Y}]
 116 fillMenus
 117 }
 118 package provide textprops