visual_regexp.tcl

tcl/tk正则表达式工具的源代码

#!/bin/sh  
#-*-tcl-*-  
# the next line restarts using wish \
exec wish8.3 "$0" -- ${1+"$@"}


set version 3.0

###############################################################################################
#
# VisualREGEXP -- A graphical front-end to wirte/debug regular expression
# (c) 2000-2002 Laurent Riesterer
#
# VisualREGEXP Home Page: http://laurent.riesterer.free.fr/regexp
#
#----------------------------------------------------------------------------------------------
#
# Usage: tkregexp <sampleFile>
#
#----------------------------------------------------------------------------------------------
#
# This program is free software; you can redistribute it and/or modify  
# it under the terms of the GNU General Public License as published by  
# the Free Software Foundation; either version 2 of the License, or  
# (at your option) any later version.  
#  
# This program is distributed in the hope that it will be useful,  
# but WITHOUT ANY WARRANTY; without even the implied warranty of  
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  
# GNU General Public License for more details.  
#  
# You should have received a copy of the GNU General Public License  
# along with this program; if not, write to the Free Software  
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA  
#
###############################################################################################



#----------------------------------------------------------------------------------------------
# SOME CUSTOMIZATION CAN BE DONE BY MODIFYING VARIABLES BELOW
#----------------------------------------------------------------------------------------------

# default geometry
set geometry            800x600+0+0
# main font used to display the text
if {$tcl_platform(platform) == "windows"} {
	set font_regexp     {Courier 10}
	set font_replace    {Courier 10}
	set font_sample     {Courier 10}
} else {
	set font_regexp		9x15
	set font_replace	9x15
	set font_sample		9x15
}
# the font used in the popup menu (use ---- to get a separator, else format is {font size ?bold?}
set fonts 				{{Courier 8} {Courier 9} {Courier 10} {Courier 11} {Courier 12}
						 ----
					     {Arial 8} {Arial 9} {Arial 10} {Arial 11} {Arial 12}
					     ----
					     8x13 8x13bold 9x15 9x15bold 10x20}
# the colors for the different matching groups
set colors              {#ff0000 #0000ff darkgreen violetred #ff9000 #537db9 #e4c500     firebrick darkgoldenrod hotpink}
set bgcolors            {#ffe6e6 #e6e6ff #e6ffe6   #efd5e1   #fef3e5 #d6dce5 lightyellow white    white        white}
# use background color in sample by default ? (1 use, 0 do not use)
set background			0
# background color to visualize the non-reporting group (?:...)
set color_noreport      #fffdc4
# background color to visualize the lookhead group (?=...) and (?!...)
set color_lookahead     wheat
# show/hide help about control characters in regexp
set show_help			0
# show/hide history windows on startup
set history				0
# mode to use on startup (select/concat = raw, select/insert new lines = nl, replace = replace)
set mode				replace
# database of some regexp to appear in the "Insert regexp" menu
set regexp_db {
	"URL"			{(?:^|")(http|ftp|mailto):(?://)?(\w+(?:[\.:@]\w+)*?)(?:/|@)([^"\?]*?)(?:\?([^\?"]*?))?(?:$|")}
	"IP numbers" 	{[12]?[0-9]?[0-9](\.[12]?[0-9]?[0-9]){3}}
	"HTML tags"		{<[^<>]+>}
	"HTML tag content" {<(\w+)[^>]*?>(.*?)</\1>}
	"vars and arrays (PHP)" {\$[^0-9 ]{1}[a-zA-Z0-9_]*((?:\[[a-zA-Z0-9_'\"]+\])*)}
	"dd/mm/yyyy"	{(0[1-9]|[12][0-9]|3[01])(/|-)(0[1-9]|1[12])(/|-)[12][0-9]{3}}
	"mm/dd/yyyy"	{(0[1-9]|1[12])(/|-)(0[1-9]|[12][0-9]|3[01])(/|-)[12][0-9]{3}}
	"hh:mm"			{([01][0-9]|2[0-3]):[0-5][0-9]}
	"[e-mail]" {[A-Za-z0-9_.-]+@([A-Za-z0-9_]+\.)+[A-Za-z]{2,4}}
}


#----------------------------------------------------------------------------------------------
# DO NOT MODIFY BELOW THIS POINT
#----------------------------------------------------------------------------------------------

namespace eval regexp {} {
	set data(v:undo:index) 0
	set data(v:undo:sample) ""
	set data(v:dir) "."
	set data(v:file) "untitled.txt"
}

#----------------------------------------------------------------------------------------------
#	Main GUI
#----------------------------------------------------------------------------------------------

proc regexp::gui {} {
variable data
global colors bgcolors color_noreport color_lookahead geometry show_help regexp_db history
global tcl_platform


	set top ""

	# frame for regexp
	set w [frame $top.regexp -bd 2 -relief groove]
		# options
		set fo [frame $w.options]
		set sep 0
		foreach option {nocase all - line lineanchor linestop - inline} \
				label {nocase all - line "lineanchor (k)" "linestop (m)" - inline} \
				underline {0 0 - 0 12 10 - 0} {
			if {$option != "-"} {
				checkbutton $fo.$option -text $label -bd 1 -underline $underline \
							-variable regexp::data(v:$option) \
							-offvalue "" -onvalue "-$option"
				set data(v:$option) ""
				pack $fo.$option -side left
			} else {
				pack [frame $fo.[incr sep] -width 40] -side left
			}
		}
		# text for regexp entry
		set data(w:regexp) [text $w.regexp -wrap char -bg white -font $::font_regexp \
									-selectbackground lightblue -selectborderwidth 0 \
									-width 1 -height 3 -bd 1]
		if {$tcl_platform(platform) == "windows"} {
			set sfont {Courier 8}
			set sbfont {Courier 8 bold}
		} else {
			set sfont 6x13
			set sbfont 6x13bold
		}
		set data(w:help) [text $w.help -font $sfont -bd 0 -height 9 -wrap none -bg [$w cget -bg]]
		$w.help insert 1.0 "\n\n\n\n\n\n\n\n"
		$w.help insert 1.0 {\a  alert              \n     newline     \0    char 0       \d [[:digit:]]    \A beginning of the string }
		$w.help insert 2.0 {\b  backspace          \r     carriage    \xyz  octal code   \D [^[:digit:]]   \Z end of string }
		$w.help insert 3.0 {\B  synomyn for \      \t     tab                            \s [[:space:]]    \m beginning of a word}
		$w.help insert 4.0 {\cX same as X & 0x1F   \uwxyz unicode     \x    backref      \S [^[:space:]]   \M end of a word}
		$w.help insert 5.0 {\e  ESC                \v     vert tab                       \w [[:alnum:]_]   \y beginning or end of a word}
		$w.help insert 6.0 {\f  form feed          \xhhh  hexa code                      \W [^[:alnum:]_]  \Y not beginning or end of a word}
		$w.help insert 7.0 {----------------------------------------------------------------------------------------------------------------}
		$w.help insert 8.0 {    ungreedy:          ?? single optional *? zero-many       +? at least one   {n,m}? ungreedy quantifiers}
		$w.help insert 9.0 {(?:) ghost group       (?=) lookahead     (?!) neg. lookahead}
		$w.help tag configure bold -font $sbfont
		foreach line {1 2 3 4 5 6} {
			foreach {min max} {0 2 23 25 42 44 61 63 79 82} {
				$w.help tag add bold $line.$min $line.$max
			}
		}
		$w.help tag remove bold 2.43 2.44 4.43 4.44
		# buttons & selection of match
		set fb [frame $w.b]
		button $fb.go -text "Go" -underline 0 -command "regexp::go" -bd 1 -width 5
		button $fb.clear -text "Clear (z)" -underline 7 -command "regexp::clear" -bd 1 -width 5
		pack $fb.go [frame $fb.00 -width 10] $fb.clear -side left -pady 5

		# selection - buttons for match level
		label $fb.sep
		label $fb.l -text "Select:"
		pack $fb.sep -side left -fill x -expand true
		pack $fb.l -side left -padx 5 -pady 5
		set i 0
		foreach c $colors t {match 1 2 3 4 5 6 7 8 9} {
			button $fb.$i -text $t -fg $c -bd 1 -padx 0 -width 6 -command "regexp::select $i"
			pack $fb.$i -side left -fill y -pady 5
			incr i
		}
		# text for replace
		set f [frame $w.replace]
			set data(w:replace) [text $f.replace -wrap char -bg white -font $::font_replace \
										-selectbackground lightblue -selectborderwidth 0 \
										-width 1 -height 2 -bd 1]
			button $f.do -text "Replace" -underline 0 -bd 1 -width 9 -command "regexp::replace"
			label $f.nb -textvariable regexp::data(v:nbreplace) -width 12 -anchor e
			pack $data(w:replace) -side left -expand true -fill both -pady 5 -padx 5
			pack $f.do -side left -pady 5
			pack $f.nb -side left -pady 5 -padx 5
		# layout
		pack [frame $w.0 -height 5] $data(w:regexp) -side top -anchor w -padx 5 -expand true -fill both
		pack $fo $fb -side top -anchor w -padx 5 -expand true -fill both
		pack $fb -side top -anchor w -padx 5 -expand true -fill both
		set data(w:allreplace) $f

	# frame for sample
	set w [frame $top.sample -bd 2 -relief groove]
		set w [frame $w.inner]
		pack $top.sample.inner -padx 5 -pady 5 -fill both -expand true
		# text for sample highlighting
		set data(w:sample) [text $w.sample  -bg white -font $::font_sample -bd 1 -width 1 -height 1 \
									-selectbackground lightblue -selectborderwidth 0 \
									-yscrollcommand "$w.sy set" -xscrollcommand "$w.sx set"]
		scrollbar $w.sy -command "$w.sample yview" -orient vertical -bd 1
		scrollbar $w.sx -command "$w.sample xview" -orient horizontal -bd 1
		# set tags for colors & special
		set data(v:levels) {e0 e1 e2 e3 e4 e5 e6 e7 e8 e9}
		foreach level $data(v:levels) \
				color $colors {
			$data(w:regexp) tag configure $level -foreground $color
			$data(w:history) tag configure $level -foreground $color
			$data(w:sample) tag configure $level -foreground $color
		}
		$data(w:regexp) tag configure lookahead -background $color_lookahead
		$data(w:regexp) tag configure noreport -background $color_noreport
		$data(w:history) tag configure lookahead -background $color_lookahead
		$data(w:history) tag configure noreport -background $color_noreport
		# options
		set f [frame $w.matches]
			label $f.nb -textvariable regexp::data(v:nbmatches) -anchor w
			set regexp::data(v:nbmatches) "0 matches"
			# button for navigation
			button $f.p -text "Previous" -bd 1 -pady 2 -width 8 -command "regexp::sample:move -1"
			button $f.n -text "Next" -bd 1 -pady 2 -width 8 -command "regexp::sample:move +1"
			set data(v:positions) [list ]
			set data(v:position) 0
			# layout
			pack $f.nb [frame $f.0 -width 15] $f.p $f.n -padx 5 -side left
		
		# layout
		grid $w.sample	$w.sy	-sticky news
		grid $w.sx		x		-sticky news
		grid $w.matches	-		-sticky news
		grid rowconfigure $w {0} -weight 1
		grid columnconfigure $w {0} -weight 1

	# main layout
	pack $top.regexp -side top -anchor w -padx 5 -pady 5 -fill x
	pack $top.sample -side top -anchor w -padx 5 -pady 5 -expand true -fill both
	wm geometry . $geometry
	wm title . "Visual REGEXP $::version"
	focus $data(w:regexp)

	# main menu
	. configure -menu .menubar
	set m [menu .menubar -tearoff 0 -bd 1 -activeborderwidth 1]
	  # file
	  $m add cascade -menu $m.file -label "File" -underline 0
	  set mm [menu $m.file -tearoff 0 -bd 1 -activeborderwidth 1]
		$mm add command -label "Load regexp ..." -command "regexp::regexp:load"
		$mm add command -label "Load sample ..." -command "regexp::sample:load" -accelerator "Alt-O"
		$mm add separator
		$mm add command -label "Save sample (auto) ..." -command "regexp::sample:save auto" -accelerator "Alt-S"
		$mm add command -label "Save sample Unix (lf) ..." -command "regexp::sample:save lf"
		$mm add command -label "Save sample Windows (crlf) ..." -command "regexp::sample:save crlf"
		$mm add command -label "Save sample Mac (cr) ..." -command "regexp::sample:save cr"
		$mm add separator
		$mm add command -label "Quit" -underline 0 -command "exit" -accelerator "Alt-Q"
	  # edit
	  $m add cascade -menu $m.edit -label "Edit" -underline 0
	  set mm [menu $m.edit -tearoff 0 -bd 1 -activeborderwidth 1]
		$mm add command -label "Copy regexp to clipboard" -command "regexp::dump" -accelerator "Alt-C"
		$mm add separator
		$mm add command -label "Undo" -command "regexp::unredo:regexp -1" -accelerator "Control-Z"
		$mm add command -label "Redo" -command "regexp::unredo:regexp +1" -accelerator "Control-R"
	  # view
	  $m add cascade -menu $m.view -label "View" -underline 0
	  set mm [menu $m.view -tearoff 0 -bd 1 -activeborderwidth 1]
		set regexp::data(v:background) $::background
		regexp::sample:background
		$mm add checkbutton -label "Show background for matches" -command "regexp::sample:background" \
				-variable regexp::data(v:background)
		$mm add checkbutton -label "Show regexp help" -command "regexp::regexp:help:toggle" \
				-variable regexp::data(v:help)
		set regexp::data(v:help) $show_help
		$mm add checkbutton -label "Wrap lines in sample" -variable regexp::data(v:wrap) \
						-command "$data(w:sample) configure -wrap \$regexp::data(v:wrap)" \
						-offvalue "none" -onvalue "char"
		set regexp::data(v:history) $history
		$mm add checkbutton -label "History of Regexp" -variable regexp::data(v:history) \
						-command "if {\$regexp::data(v:history)} {wm deiconify .history} else {wm iconify .history}"
	  # select mode
	  $m add cascade -menu $m.select -label "Select mode" -underline 5
	  set mm [menu $m.select -tearoff 0 -bd 1 -activeborderwidth 1]
		$mm add radiobutton -label "select / concat raw matches" \
				-variable regexp::data(v:mode) -value "raw" -command regexp::replace:toggle
		$mm add radiobutton -label "select / insert new line between matches" \
				-variable regexp::data(v:mode) -value "nl" -command regexp::replace:toggle
		$mm add radiobutton -label "replace widget" \
				-variable regexp::data(v:mode) -value "replace" -command regexp::replace:toggle
	  # insert well know regexp
	  $m add cascade -menu $m.insert -label "Insert regexp" -underline 11
	  set mm [menu $m.insert -tearoff 0 -bd 1 -activeborderwidth 1]
		$mm add command -label "Make regexp ..." -command "regexp::make-regexp"
		$mm add separator
		$mm add command -label "Load patterns ..." -command "regexp::pattern:load"
		$mm add separator
		foreach {n e} $regexp_db {
			$mm add command -label "$n" -command "regexp::regexp:insert [list $e]"
		}
		set data(w:menu) $mm
	  # help
	  $m add cascade -menu $m.help -label "Help" -underline 0
	  set mm [menu $m.help -tearoff 0 -bd 1 -activeborderwidth 1]
		$mm add command -label "Help" -command "regexp::help"


	# key binding
	bind all <Alt-q> "exit"
	bind all <Alt-g> "regexp::go"
	bind $data(w:regexp) <Return> "regexp::go; break"
	bind all <Alt-c> "regexp::dump"
	bind all <Alt-r> "regexp::replace"
	bind all <Alt-o> "regexp::sample:load"
	bind all <Alt-s> "regexp::sample:save auto"

	bind $data(w:regexp) <Control-z> "regexp::unredo:regexp -1"
	bind $data(w:regexp) <Control-r> "regexp::unredo:regexp +1"

	bind $data(w:replace) <Control-z> "regexp::undo:sample"
	bind $data(w:sample) <Control-z> "regexp::undo:sample"

	bind all <Alt-a> "$fo.all toggle"
	bind all <Alt-n> "$fo.nocase toggle"
	bind all <Alt-l> "$fo.line toggle"
	bind all <Alt-k> "$fo.lineanchor toggle"
	bind all <Alt-m> "$fo.linestop toggle"
	bind all <Alt-i> "$fo.inline toggle"
	bind all <Alt-z> "regexp::clear"

	bind $data(w:regexp) <Control-Key> { # nothing }
	bind $data(w:regexp) <Alt-Key> { # nothing }
	bind $data(w:regexp) <Meta-Key> { # nothing }
	bind $data(w:regexp) <Mod1-Key> { # nothing }
	bind $data(w:regexp) <Key> "regexp::undo:regexp:compute %W %K %A"

	bind $data(w:replace) <Control-Tab> "$data(w:replace) insert insert {\\t}; break;"
	bind $data(w:sample) <Control-Tab> "$data(w:sample) insert insert {\t}; break;"
	# special for regexp Ctrl+letter = \<letter>
	bind $data(w:regexp) <Control-Tab> "$data(w:regexp) insert insert {\\t}; break;"
	foreach key {a b B e f n r t u x 0 d D s S w W A Z m M y Y} {
		bind $data(w:regexp) <Control-$key> "$data(w:regexp) insert insert {\\$key}; break;"
	}
	foreach key {a b B e f n r t v u x 0} {