]> wagner.pp.ru Git - sites/home_page.git/blob - software/tcl/textprops.tcl
grandpa picture
[sites/home_page.git] / 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