File: example.tcl

package info (click to toggle)
r-cran-tcltk2 1.2-10-1
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 5,356 kB
  • ctags: 1,386
  • sloc: tcl: 37,888; ansic: 792; python: 324; sh: 68; sed: 16; makefile: 1
file content (82 lines) | stat: -rwxr-xr-x 3,534 bytes parent folder | download | duplicates (12)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
#!/bin/sh 
# the next line restarts using wish \
exec wish "$0" ${1+"$@"} 

#set tcl_traceExec 1

proc main {} {
	source ./ctext.tcl

	pack [frame .f] -fill both -expand 1
	#Of course this could be cscrollbar instead, but it's not as common.
	pack [scrollbar .f.s -command {.f.t yview}] -side right -fill y

	#Dark colors
	pack [ctext .f.t -linemap 1 -bg black -fg white -insertbackground yellow \
		-yscrollcommand {.f.s set}] -fill both -expand 1

	ctext::addHighlightClass .f.t widgets purple [list obutton button label text frame toplevel \
		cscrollbar scrollbar checkbutton canvas listbox menu menubar menubutton \
		radiobutton scale entry message tk_chooseDir tk_getSaveFile \
		tk_getOpenFile tk_chooseColor tk_optionMenu]

	ctext::addHighlightClass .f.t flags orange [list -text -command -yscrollcommand \
		-xscrollcommand -background -foreground -fg -bg \
		-highlightbackground -y -x -highlightcolor -relief -width \
		-height -wrap -font -fill -side -outline -style -insertwidth \
		-textvariable -activebackground -activeforeground -insertbackground \
		-anchor -orient -troughcolor -nonewline -expand -type -message \
		-title -offset -in -after -yscroll -xscroll -forward -regexp -count \
		-exact -padx -ipadx -filetypes -all -from -to -label -value -variable \
		-regexp -backwards -forwards -bd -pady -ipady -state -row -column \
		-cursor -highlightcolors -linemap -menu -tearoff -displayof -cursor \
		-underline -tags -tag]

	ctext::addHighlightClass .f.t stackControl red {proc uplevel namespace while for foreach if else}
	ctext::addHighlightClassWithOnlyCharStart .f.t vars mediumspringgreen "\$"
	ctext::addHighlightClass .f.t htmlText yellow "<b> </b> <i> </i>"
	ctext::addHighlightClass .f.t variable_funcs gold {set global variable unset}
	ctext::addHighlightClassForSpecialChars .f.t brackets green {[]{}}
	ctext::addHighlightClassForRegexp .f.t paths lightblue {\.[a-zA-Z0-9\_\-]+}
	ctext::addHighlightClassForRegexp .f.t comments khaki {#[^\n\r]*}
	#After overloading, insertion is a little slower with the 
	#regular insert, so use fastinsert.
	#set fi [open Ctext_Bug_Crasher.tcl r]
	set fi [open long_test_script r]
	.f.t fastinsert end [read $fi]
	close $fi
	
	pack [frame .f1] -fill x

	pack [button .f1.append -text Append -command {.f.t append}] -side left
	pack [button .f1.cut -text Cut -command {.f.t cut}] -side left
	pack [button .f1.copy -text Copy -command {.f.t copy}] -side left
	pack [button .f1.paste -text Paste -command {.f.t paste}] -side left
	.f.t highlight 1.0 end
	pack [button .f1.test -text {Remove all Tags and Highlight} \
		-command {puts [time {
			foreach tag [.f.t tag names] {
				.f.t tag remove $tag 1.0 end
			}
			update idletasks
			.f.t highlight 1.0 end
			}]
		}
	] -side left
	pack [button .f1.fastdel -text {Fast Delete} -command {.f.t fastdelete 1.0 end}] -side left

	pack [frame .f2] -fill x
	pack [button .f2.test2 -text {Scrollbar Command {}} -command {.f.t config -yscrollcommand {}}] -side left
	pack [button .f2.cl -text {Clear Classes} -command {ctext::clearHighlightClasses .f.t}] -side left
	pack [button .f2.des -text Destroy -command {destroy .f.t}] -side left
	pack [button .f2.editModSet0 -text "Set Modified 0" -command {puts [.f.t edit modified 0]}] -side left
	pack [button .f2.editModGet -text "Print Modified" -command {puts [.f.t edit modified]}] -side left
	
	pack [button .f2.exit -text Exit -command exit] -side left
	
	puts [.f.t cget -linemap]
	puts [.f.t cget -linemapfg]
	puts [.f.t cget -linemapbg]
	puts [.f.t cget -bg]
}
main