#!/usr/bin/wish -f ## ########################################################################## ## NOTE: ## If 'wish' is in /usr/local/bin, for example, instead of /usr/bin, then ## the (root) user could make a soft-link named /usr/bin/wish that ## points to /usr/local/bin/wish. Example command: ## ln -s /usr/local/bin/wish /usr/bin/wish ## Then all the Tk scripts that start with /usr/bin/wish on the top line ## of the script will work. ########################################################################## ## Tk SCRIPT NAME: shofil.tk ########################################################################## ## PURPOSE: Provides a GUI FOR SCROLLING/SEARCHING/PRINTING contents of ## a text file --- or even binary files, although most characters ## in binary files will show as a space or null --- and as ## 'garbage' characters. ## ## UNIQUE-INNOVATIVE FEATURE: ## Includes a 'Show-All-Matches' (plus or minus N lines around the matches) ## EXTRACT option. Quite handy in searching large log and list and ## source code files. ## ## This is an especially handy tool for system administrators and application ## supporters/developers. ## ## ---------------------------------------------------------------------- ## ## Note: 'shofil.tk' is A REPLACEMENT FOR OLD TEXT-TERMINAL VIEWERS. ## ## This 'shofil' utility functions as an X-windows version of ## the show-text-in-shell-window Unix utility 'pg' -- or its ## more-or-less-capable cousins 'more', 'less', and 'cat'. ## ## In other words, 'shofil.tk' is meant to provide a more modern, ## GUI-interface method of presenting a text file to a user for ## browsing -- more modern than the old utilities like 'pg' or 'less' ## or a "teletype" editor like 'view' ('vi' with the readonly flag set). ## ## This is a view-only (i.e. read-only) utility, which can be helpful ## when you are looking at large/important files and you do not want ## to accidentally change their contents. ## ## Even GUI-style editors like 'nedit', have the disadvantage that the ## user can turn the read-only switch off. And many GUI editors, ## like 'gedit' or 'kwrite' or 'kate' do not even offer a read-only ## switch. ## ## Furthermore NONE of these editors --- 'nedit', 'gedit', 'kwrite', ## 'kate' --- have the 'Show-All-Matches' EXTRACT capability. ## ## This GUI is nicer than 'pg' or 'less' for paging & searching. ## 'shofil.tk' allows the user to use a scrollbar for paging. ## And, it has a 'Search(again)' button and entry field to support ## quick searches for strings in the file. ## ## The user can reset the starting line of the search-forward ## feature at any time by scrolling to a text area and clicking ## mouse-button1 on the character location to re-start the search ## from there. ## ## Regular-expression-search has been implemented. --- for the ## 'Search (again)' function, but not for the 'ShowAllMatches' function. ## ## This utility can be used in shell scripts and in Tcl-Tk scripts ## --- either by calling 'shofil.tk' directly, or by calling a ## 'wrapper' script named 'xpg'. ## ######################################################################## ## CALLED BY: ## ## This 'shofil.tk' Tcl-Tk script is called by the 'xpg' wrapper script ## OR ## 'shofil.tk' can be called in shell and Tk scripts. ## ## For example, the 'shofil.tk' utility may be used to show a help-text ## file --- from within a shell script or a Tk script. ######################################################################## ## INPUTS: SHOFILENAME environment variable or a (fully-qualified) ## text-file name as an argument to the shofil.tk command. ## ## OUTPUT: 1) scrollable/pageable text-in-a-GUI display, AND ## 2) optional popups of ShowAllMatches EXTRACT lines ## in a separate 'shofil.tk' spawned-off window, AND ## 3) optional printout via a print command or script. ## ######################################################################## ## CALL FORMAT: ## SHOFILENAME="a-file-name", like "$DIRapp/help/myApp.hlp" ## export SHOFILENAME ## $DIRxpg/shofil.tk ## or ## $DIRxpg/shofil.tk ## ## For an example call, see the 'Help' button command in this script, ## because this shofil.tk script uses itself to show its help. ########################################################################### ## 'CANONICAL' STRUCTURE OF THIS CODE: ## ## 0) Get input (filename) and set general window & widget parms (name, ## position-size,color-scheme,fonts,etc.). ## 1a) Define ALL frames and sub-frames. ## 1b) Pack all the frames and sub-frames ## 2) Define & pack all widgets, frame by frame. ## 2) Define key/mouse action BINDINGS, if any. ## 3) Define PROCS, if any. ## 4) ADDITIONAL GUI INITIALIZATION, if needed (typically with one ## or two of the now-defined procs) ## ## In more detail,for this particular script: ## ## 1a) Define ALL frames: ## ## - 'fRtopbar' (to contain exit, help, print buttons & filename label) ## - 'fRsearch' (to contain search button & string entry field) ## - 'fRothropts' (a normally hidden frame, to contain other options) ## - 'fRmain' (to contain text area) ## ## 1b) Pack frames in appropriate groups to get proper behavior ## of widgets in window expansion. ## ## 2) Define & pack all widgets in the frames -- basically going through ## frames in top-to-bottom, left-to-right order. ## ## - In '.fRtopbar': some button widgets and a label widget ## - In '.fRsearch': 1 label,button,entry widgets ## - In '.fRothropts': 1 label,checkbutton, etc. widgets ## - In '.fRmain': 1 'text' widget with scrollbars ## ## 3) In the BINDINGS section: ## ## - .fRsearch.entSTR ## For an Enter key press in Search entry field, ## runs the 'search4string' proc. ## - .fRmain.text ## For a Button1 click (& release) in the text area, ## the 'insert-cursor' location is reset in var, cursorLOC. ## - .fRmain.text ## Pops up a msg showing line.col nums of cursorLOC. ## - .fRmain.text ## Selects-&-highlights a string -- to whitespace ## on either side of the chracter 'tapped'. ## I.e. mouse-button-3 click anywhere on a word and ## the word is high-lighted. May facilitate copy-paste. ## ## Also special key-bindings for and keys. ## ## ## 4) In the PROCS section: ## ## - 'search4string' for '.fRsearch.entSTR ' binding ## and for 'Search (again)' button. ## ## - 'all_matches2string' for 'Show All Matches' button. ## ## and other procs, like ## ## - 'popup_msg' used to popup msg, from other procs. ## ## - 'getset_palette_color' gets r255,g255,b255 via the FE Color Selector GUI ## with 3 slider bars, ## then calls 'tk_setPalette' and 'set_text_colors'. ## Called by 'ChgColor' button. ## ## - 'set_text_colors' sets brighter text area color and colors of two ## search hilite vars, from r255,g255,b255 vars. ## ## - 'toggle_side' toggles y-scrollbar to left/right side of text. ## ## - 'set_font' starts up font-selector GUI, to chg the text font. ## ## - 'toggle_othropts' shows a 'toolbar' of 'other' options. ## ## - 'selectchar2whitespace' for '.fRmain.text ' bind ## ## - 'readfile2textwidget' loads text widget --- includes a technique ## for handling huge text files --- prompting ## whether to continue loading. Reads in blocks ## several kilobytes long. (RETIRED) ## ## - 'getfile2textwidget' an alternative to 'readfile2textwidget'. Uses ## 'gets' instead of 'read'. Reads line-by-line, ## i.e. to a linefeed character for each line. ## Truncates long lines to about a kilobyte long, ## thus allowing for avoiding problems that might ## occur with loading extremely long lines into ## the text widget. ## ## Like 'readfile2textwidget', 'getfile2textwidget' ## includes a technique for handling input files with ## a huge number of records --- prompting ## whether to continue loading. ## ## - 'finalize_textwidget' called by the 'readfile' procs to display number ## of lines read and disable the text widget. ## ## - 'popup_msg_3opts' pops up a Go/Stop/Exit message if huge number of ## records are read from the input file ## ## 5) Additional GUI initialization. ## (Runs 'set_text_colors' & 'getfile2textwidget'.) ## ########################################################################### ## NOTE ON THE 'readfile' AND 'getfile' PROCS: ## ## The 'readfile2textwidget' block reader (which has no checking for ## location of line-feeds) and limits the number of characters per read ## could be used in place of 'getfile2textwidget' --- if there were ## some performance benefit. ## ## Surprisingly (to me), 'getfile2textwidget' seems to be just as ## fast as the block-reader 'readfile2textwidget'. (Probably because ## underneath it all, the 'gets' reader has to read by blocks as well.) ## ## The 'readfile2textwidget' routine was based on Ousterhout's ## example of loading a text widget by using 'read' to read ## blocks of a file --- ## page 216, Chap 19.5 of Ousterhout book "Tcl & the Tk Toolkit". ## ## But I changed to use a 'gets' read procedure, rather than a ## block read, and clipped the text-line retrieved at about 1500 ## characters --- to avoid 'line too long' crashes ## when horizontal-scrolling to view long text lines. ## ########################################################################### ## NOTE: You can see only the non-commented, executable lines of this ## script by using the command ## egrep -v '^ *##|^ *# |^ *$' shofil.tk ## or ## grep -v '^ *##' shofil.tk | grep -v '^ *# ' | grep -v '^ *$' ## ## to eliminate (most of or all) the comment lines. ########################################################################## ## DEVELOPED WITH: (Tcl 7.4)-(Tk 4.0) --- originally ## wish>puts "$tcl_version $tk_version" ## 7.4 4.0 ## Used Tcl-Tk 8.4 on Linux in 2008-2010. Used Tcl-Tk 8.5 in 2011. ################################################## ## This script was converted to 'stand-alone' form from the 'FE xpg' system, ## as provided at www.freedomenv.com. ## The FE subsystems are copyright 2006+ by Blaise Montandon ########################################################################## ## MAINTENANCE HISTORY of 'stand-alone' shofil.tk: ## Written by: Blaise Montandon 2013aug05 Started 'stand-alone' conversion ## from 'FE xpg'. ## Changed by: Blaise Montandon 20....... ########################################################################## ###################################################################### ## Set the directory that contains this script, its auxiliary scripts, ## its help file, etc. ###################################################################### # set DIRxpg "$env(HOME)/apps/xpg" set DIRxpg "." ##+####################################################################### ## Set WINDOW TITLE. ##+####################################################################### wm title . "'xpg' file browser --- version for wiki.tcl.tk" wm iconname . "xpg" ##+####################################################################### ## Set WINDOW LOCATION --- and the SIZE (about 60 to 80% of screen size). ## We randomize the location of the window (about a base setting) ## using clock seconds to do the randomizing. ## This is because this same script is used to show ## - its own help ## - shows the extract-lines from the SAM (ShowAllMatches) feature ## - possibly up to 8 text files, via the 'xpg' wrapper script. ## So we do not want the 'shofil.tk' GUI to always lie exactly ## on top of itself. ##+####################################################################### ## A 'base' window location. set WINlocx 80 set WINlocy 80 # set WINlocx 15 # set WINlocy 30 ################################################## ## Get the current time and extract the seconds. ################################################# set secs [clock format [clock seconds] -format "%S"] ## FOR TESTING: # set secs "00" #################################################################### ## In Tcl, leading zero indicates octal number. Causes err msg: ## 'expected integer but got "08" (looks like invalid octal number)' ## from 'set adjY' statement below. So we strip off leading zero(s). #################################################################### set secs [string trimleft $secs 0] if { "$secs" == "" } { set secs 0 } ## Use current seconds to adjust the location. set adjX $secs set adjY [expr {60 - $secs}] set WINlocx [expr {$WINlocx + $adjX}] set WINlocy [expr {$WINlocy + $adjY}] ## Set initial window width & height, based on screen width & height. set WINsizex [ expr {int(0.7 * [winfo screenwidth .])} ] set WINsizey [ expr {int(0.8 * [winfo screenheight .])} ] ################################################################## ## We allow for setting the window INIT-POSITION and INIT-SIZE via ## environment vars, because some uses of this GUI may have their ## own requirements for initial location and initial size. ################################################################## catch { set WINlocx "$env(WINLOCX)" } catch { set WINlocy "$env(WINLOCY)" } catch { set WINsizex "$env(WINSIZEX)" } catch { set WINsizey "$env(WINSIZEY)" } ############################################# ## Now set both the window location and size. ############################################# set WINgeom "" append WINgeom $WINsizex "x" $WINsizey "+" $WINlocx "+" $WINlocy wm geometry . $WINgeom ##+###################################################### ## Set the COLOR SCHEME for the window and its widgets. ##+###################################################### ## These r255,g255,b255 vars will be used in a 'set_text_color' ## proc to set a slightly different shade for the text widget ## and to set a couple of search-string 'hilite' colors, ## for successive search passes on the text widget (to help ## make clear when wrap-around of the search has occurred). ## These vars are used here to set the 'palette' of the window. if {0} { ## Try gray. set r255 210 set g255 210 set b255 210 } else { ## OR try something else. set r255 110 set g255 110 set b255 255 } set hexPALETTE [format "#%02X%02X%02X" $r255 $g255 $b255] tk_setPalette "$hexPALETTE" ## Set consistent background colors for various widgets. set listboxBKGD "#f0f0f0" set entryBKGD "#f0f0f0" set textBKGD "#f0f0f0" set chkbuttBKGD "#cccccc" set radbuttBKGD "#cccccc" ##+####################################################################### ## SET FONT VARS for use in the 'font create' statements below. ##+####################################################################### set guiFONTsize 14 set guiFONT_SMALLsize 12 ## For VARIABLE WIDTH: set FONT_varwidth \ " -family {comic sans ms} -size -$guiFONTsize -weight bold -slant roman " set FONT_SMALL_varwidth \ " -family {comic sans ms} -size -$guiFONT_SMALLsize -weight normal -slant roman " ## Some other possible (similar) variable width fonts: ## Arial ## Bitstream Vera Sans ## DejaVu Sans ## Droid Sans ## FreeSans ## Liberation Sans ## Nimbus Sans L ## Trebuchet MS ## Verdana ## For FIXED WIDTH: set FONT_fixedwidth \ " -family {dejavu sans mono} -size -$guiFONTsize -weight bold -slant roman " set FONT_SMALL_fixedwidth \ " -family {dejavu sans mono} -size -$guiFONT_SMALLsize -weight normal -slant roman " ## Some other possible fixed width fonts (esp. on Linux): ## Andale Mono ## Bitstream Vera Sans Mono ## Courier 10 Pitch ## DejaVu Sans Mono ## Droid Sans Mono ## FreeMono ## Nimbus Mono L ## TlwgMono ##+##################################################################### ## DEFINE (temporary) FONT-NAMES using 'font create'. ## The font names are to be used in '-font' widget specs below --- ##+##################################################################### eval font create fontTEMP_button $FONT_varwidth eval font create fontTEMP_label $FONT_varwidth eval font create fontTEMP_entry $FONT_fixedwidth eval font create fontTEMP_listbox $FONT_fixedwidth eval font create fontTEMP_text $FONT_fixedwidth # eval font create fontTEMP_msg $FONT_fixedwidth eval font create fontTEMP_SMALL_button $FONT_SMALL_varwidth eval font create fontTEMP_SMALL_label $FONT_SMALL_varwidth eval font create fontTEMP_SMALL_entry $FONT_SMALL_fixedwidth eval font create fontTEMP_SMALL_listbox $FONT_SMALL_fixedwidth eval font create fontTEMP_SMALL_text $FONT_SMALL_fixedwidth # eval font create fontTEMP_SMALL_msg $FONT_SMALL_fixedwidth ##+####################################################################### ## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS. ## (e.g. padx,pady for Buttons) ##+####################################################################### ## For BUTTON widgets: set fePADY_button 0 set fePADX_button 0 set feBDwidth_button 2 ## For LABEL widgets: set fePADY_label 0 set fePADX_label 0 set feBDwidth_label 2 ## For ENTRY widgets: set feBDwidth_entry 2 ## For LISTBOX widgets: set feBDwidth_listbox 2 ## For TEXT and MESSAGE widgets: set feBDwidth_text 2 # set feBDwidth_msg 2 ## For CHECKBUTTON widgets: # set feRELIEF_checkbutton raised set feRELIEF_checkbutton flat set fePADY_chkbutt 0 set fePADX_chkbutt 0 set feBDwidth_chkbutt 0 ########################################################################## ## SET THE WINDOW MIN WIDTH AND HEIGHT --- MIN-SIZE (in pixels): ## Ordinarily, we set min-WIDTH such that the user can 'squeeze' the window ## horizontally, somewhat --- but not so much that important widgets ## disappear. ## ## And, for the 'shofil.tk' GUI, we set the min-HEIGHT to keep at least ## a few lines showing in the text widget. ############# ## For WIDTH, allow for the minwidth of the '.fRtopbar' frame: ## at least 3 buttons --- Exit,Help,Print ## and part of the Label(for file,dir names) ## ## For HEIGHT, allow for ## 1 char high for the widgets in the '.fRtopbar' frame, ## 1 char high for the widgets in the '.fRsearch' frame, ## 1 char high for the widgets in the '.fRothropts' frame, ## and at least 24 pixels high for the text widget of 'fRmain'. ########################################################################## set minWinWidthPx [font measure fontTEMP_varwidth \ "Exit Help Print File: wwwwwwwwwwww"] ## Add some pixels to account for right-left-side window decoration ## (about 8 pixels), about 4 x 4 pixels/widget for borders/padding for ## 4 widgets --- 3 buttons and a label. 8 + 16 = 24 pixels. set minWinWidthPx [expr {24 + $minWinWidthPx}] ## NOTE: We may want to be able to shrink the text rectangle quite a bit ## in the x-direction --- so we may not want to make the min-width very wide. ## So one could use a smaller min-width than this, if one wants to be ## able to make the window very narrow. ## MIN HEIGHT --- for the 4 frames --- allow: ## 1 char high for 'fRtopbar' ## 1 char high for 'fRsearch' ## 1 char high for 'fRothropts' ## 24 pixels high for 'fRmain' set CharHeightPx [font metrics fontTEMP_varwidth -linespace] set minWinHeightPx [expr {24 + (3 * $CharHeightPx)}] ## Add about 28 pixels for top-bottom window decoration, ## about 2+2 pixels for each of the 4 stacked frames and their ## widgets (their borders/padding). 28 + 16 = 44. set minWinHeightPx [expr {$minWinHeightPx + 44}] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ## An alternative to minsize: ## Freeze the window size at the initial pack size, with ## wm resizable . 0 0 ## BUT ... ## We allow the window to be resizable and we pack frame 'fRmain' with ## '-fill both -expand 1' so that the text widget can be enlarged by ## enlarging the window. ##+#################################################################### ## Set a TEXT-ARRAY to hold text for buttons & labels on the GUI. ## NOTE: This can aid INTERNATIONALIZATION. This array can ## be set according to a nation/region parameter. ##+#################################################################### ## if { "$VARlocale" == "en"} ## For the 'fRtopbar' frame: set aRtext(buttonEXIT) "Exit" set aRtext(buttonCLEAR) "ClearStr" set aRtext(buttonYBAR) "<-Ybar->" set aRtext(buttonOTHER) "OtherOpts" set aRtext(buttonHELP) "Help" set aRtext(buttonPRINT) "Print->" ## For the 'fRsearch' frame: set aRtext(buttonSEARCH) "Search(again)" set aRtext(labelSEARCH) "for string:" set aRtext(buttonSAM) "ShowAllMatches = SAM" set aRtext(labelPLUSMINUS) "+ / -" set aRtext(labelLINES) "Lines" ## For the 'fRothropts' frame: set aRtext(labelSRCHOPTS) "'Search(again)'opts:" set aRtext(chkbuttBACK) "Backward" set aRtext(chkbuttCASE) "CaseSense" set aRtext(chkbuttREGEXP) "RegExp" set aRtext(labelSAMOPTS) "SAMopts:" set aRtext(chkbuttNOT) "NOT" set aRtext(buttonCOLOR) "WinColor" set aRtext(buttonFONT) "TxtFont" ## END OF if { "$VARlocale" == "en"} ########################################################################## ## GET THE FILENAME TO SHOW/PRINT -- by ## 1) PROCESSING COMMAND LINE ARGUMENTS (first argument) ## OR ## 2) GETTING CONTENTS OF ENVIRONMENT VARIABLE 'SHOFILENAME'. ########################################################################## set argc [llength $argv] set FILEname "" if {$argc == 0} { catch { set FILEname "$env(SHOFILENAME)" } } else { set FILEname [lindex $argv 0] } ########################################################################## ## IF $FILEname WAS NOT LOADED, DISPLAY ERROR AND EXIT. (uses tk_dialog) ########################################################################## if { "$FILEname" == "" } { ########################################################### ## $argv0 contains the name of this script --- 'shofil.tk'. ########################################################### set message "No filename was passed to $argv0 --- on command-line --- or in env-var SHOFILENAME --- or by drag-and-drop onto a desktop icon for $argv0." option add *Dialog.msg.wrapLength 550 tk_dialog .xxx "Input Err" "$message" warning 0 Close ############################################################## ## 'popup_msg' proc is not defined at this point. This fails. ## Could move this check to the bottom of this script. ############################################################## # popup_msg "$message" exit } ################################################################# ## CHECK THAT FILE EXISTS. (uses tk_dialog) ################################################################# if { ![file exists $FILEname] } then { option add *Dialog.msg.wrapLength 400 tk_dialog .xxx "Note" \ "File $FILEname not found." \ warning 0 Close ############################################################## ## 'popup_msg' proc is not defined at this point. This fails. ## Could move this check to the bottom of this script. ############################################################## # popup_msg "File $FILEname not found." exit } ######################################################################## ######################################################################## ## DEFINE *ALL* FRAMES: ## - 'fRtopbar' (to contain cancel & print buttons & filename label) ## - 'fRsearch' (to contain search button & string entry field) ## - 'fRothropts' (a normally hidden frame, to contain other options) ## - 'fRmain' (to contain text area) ######################################################################## ######################################################################## # set BDwidth_frame 2 # set RELIEF_frame raised set BDwidth_frame 0 set RELIEF_frame flat frame .fRtopbar -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRsearch -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRothropts -relief raised -borderwidth 2 frame .fRmain -relief $RELIEF_frame -borderwidth $BDwidth_frame #################################################### ## PACK *ALL* FRAMES: 'fRtopbar' 'fRsearch' 'fRmain' ## --- except the normally hidden frame, 'fRothropts'. #################################################### pack .fRtopbar \ -side top \ -anchor nw \ -fill x \ -expand 0\ -pady 2 pack .fRsearch \ -side top \ -anchor nw \ -fill x \ -expand 0 ## DO NOT USE '-expand 1'; want buttons to stay left. ################################################################ ## *DEFER* PACK of the other-opts frame. ## Its packing is handled below in the 'toggle_otheropts' proc. ################################################################ set OTHRoptsSHOW "NO" # pack .fRothropts \ # -side top \ # -anchor nw \ # -fill x \ # -expand 0 ########################################## ## PACK the frame for the main text area. ######################################### pack .fRmain \ -side bottom \ -anchor sw \ -fill both \ -expand 1 # WAS -side left \ ######################################################################## ######################################################################## ## START DEFINING & PACKING WIDGETS IN ALL FRAMES -- ## basically from top-to-bottom, left-to-right. ######################################################################## ######################################################################## ######################################################################## ## IN 'fRtopbar' FRAME -- ## DEFINE BUTTON WIDGETS --- 'Exit' 'Clear' '<-Bar->' 'Help' & 'Print' ## and a filename TEXT WIDGET. ## THEN PACK THEM. ######################################################################## ## NOTE: ## FILEname was set at the top of this script -- from arg OR from env-var. ######################################################################## button .fRtopbar.buttExit \ -text "$aRtext(buttonEXIT)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command {exit} ## FOR TESTING: (of font setting) # if { "$TEST_MODE" == "YES" } { # puts "Defined the 'Quit' button." # puts [ .fRtopbar.buttExit cget -font ] # puts [font actual [ .fRtopbar.buttExit cget -font ] ] # } button .fRtopbar.buttClear \ -text "$aRtext(buttonCLEAR)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command {clear_search_string} button .fRtopbar.buttSide \ -text "$aRtext(buttonYBAR)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command {toggle_side} button .fRtopbar.buttOpts \ -text "$aRtext(buttonOTHER)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command {toggle_othropts} button .fRtopbar.buttHelp \ -text "$aRtext(buttonHELP)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command "eval exec $argv0 $DIRxpg/shofil.hlp &" ## The $argv0 says use myself (shofil.tk) to show the help. ## COULD BE ## -command "eval exec $DIRxpg/shofil.tk \ ## $DIRxpg/shofil.hlp &" ###################################################################### ## Set the print command to be used by the 'Print' button. ###################################################################### ## NOTE: The 'lpr' and 'lp' commands do not give much control ## over font-sizes, font-styles, page-layout, etc. ########################################################## # set fePRINTcmd "/usr/bin/lpr -P lp1 -h" # set fePRINTcmd "/usr/bin/lp -d lp1 -o cpi=12 -o lpi=8 -o page-left=72" ## Linux GUI print commands: # set fePRINTcmd "/usr/bin/kprinter" # set fePRINTcmd "/usr/bin/hp-print" set fePRINTcmd "/usr/bin/cupsdoprint -P lp1 -H localhost:631" catch { set fePRINTcmd "$env(FE_PRINT_CMD)" } button .fRtopbar.buttPrint \ -text "$aRtext(buttonPRINT)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command "eval exec $fePRINTcmd $FILEname &" ################################################# ## To show the input filename, ## we use a 'text' widget rather than this 'label' ## widget -- so that the filename is cut-able & ## paste-able. ################################################# ## label .fRtopbar.labFilename \ ## -text "File: $FILEname" \ ## -font fontTEMP_label \ ## -justify left \ ## -relief flat -borderwidth 2 \ ## -anchor w ################################################# text .fRtopbar.textFilename \ -font fontTEMP_label \ -height 1 \ -relief flat \ -borderwidth 2 \ -wrap none #################################################### ## Split the filename into its basename and dirname, ## and insert the two names in the text widget. #################################################### set FILEdir [file dirname $FILEname] set FILEbase [file tail $FILEname] if { "$FILEdir" == "." } { set FILEdir [ pwd ] } set FILEstr "File: $FILEbase Dir: $FILEdir" .fRtopbar.textFilename insert end "$FILEstr" ####################################################### ## Set the length of the text widget --- max 110 chars. ####################################################### set textlen [string length "$FILEstr"] # set textlen [ expr $textlen + 2 ] if { $textlen > 100 } {set textlen 110} .fRtopbar.textFilename configure -width $textlen ####################################################### ## Disable the text widget --- so the text is protected ## from alteration in the GUI. ####################################################### .fRtopbar.textFilename configure -state disabled ############################################# ## PACK the widgets in the 'fRtopbar' frame. ############################################# pack .fRtopbar.buttExit \ .fRtopbar.buttHelp \ .fRtopbar.buttSide \ .fRtopbar.buttClear \ .fRtopbar.buttOpts \ .fRtopbar.buttPrint \ .fRtopbar.textFilename \ -side left \ -anchor w \ -fill none \ -expand 0 ########################################################### ## IN THE 'fRsearch' frame -- DEFINE 1 BUTTON, 1 LABEL, ## and 1 ENTRY WIDGET. THEN PACK THEM. ########################################################### button .fRsearch.buttSEARCH \ -text "$aRtext(buttonSEARCH)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -bd $feBDwidth_button \ -command {search4string} label .fRsearch.labSTR \ -text "$aRtext(labelSEARCH)" \ -font fontTEMP_SMALL_label \ -justify left \ -anchor w \ -relief flat \ -bd $feBDwidth_button set HOLD_cleared_string "" entry .fRsearch.entSTR \ -width 10 \ -font fontTEMP_entry \ -relief sunken \ -bd $feBDwidth_button \ -textvariable SEARCHstring ############################################## ## PREP THE 'AllMatches' WIDGETS -- ## Button, Label, & MenuButton. ############################################## button .fRsearch.buttGETmatches \ -text "$aRtext(buttonSAM)" \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -bd $feBDwidth_button \ -command {all_matches2string} label .fRsearch.labPLUSMINUS \ -text "$aRtext(labelPLUSMINUS)" \ -font fontTEMP_SMALL_label \ -justify left \ -anchor w \ -relief flat \ -bd $feBDwidth_button # set PlusMinusLines 3 set PlusMinusLines 0 tk_optionMenu .fRsearch.optbuttPLUSMINUS PlusMinusLines \ 0 1 2 3 4 5 6 8 10 15 25 .fRsearch.optbuttPLUSMINUS configure -font fontTEMP_SMALL_button .fRsearch.optbuttPLUSMINUS configure -pady $fePADY_button label .fRsearch.labLINES \ -text "$aRtext(labelLINES) " \ -font fontTEMP_SMALL_label \ -justify left \ -anchor w \ -relief flat \ -bd $feBDwidth_button ########################################################### ## PACK THE 'fRsearch' FRAME WIDGETS. ########################################################### pack .fRsearch.buttSEARCH \ .fRsearch.labSTR \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRsearch.entSTR \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRsearch.buttGETmatches \ .fRsearch.labPLUSMINUS \ .fRsearch.optbuttPLUSMINUS \ .fRsearch.labLINES \ -side left \ -anchor w \ -fill none \ -expand 0 ################################################################## ## IN THE 'fRothropts' frame -- DEFINE 1 BUTTON, 1 LABEL, AND ## 3 CHECKBUTTON WIDGETS --- and a few more buttons to the right. ## THEN PACK THEM. ################################################################## label .fRothropts.labSRCHOPTS \ -text "$aRtext(labelSRCHOPTS)" \ -font fontTEMP_label \ -justify left \ -anchor w \ -relief flat \ -bd $feBDwidth_button set SRCHdirection0or1 0 set SRCHdirection0or1PREV 0 checkbutton .fRothropts.chkbuttDIRECTION \ -text "$aRtext(chkbuttBACK)" \ -font fontTEMP_SMALL_button \ -padx $fePADX_chkbutt \ -pady $fePADY_chkbutt \ -bd $feBDwidth_chkbutt \ -variable SRCHdirection0or1 \ -selectcolor "$chkbuttBKGD" \ -relief $feRELIEF_checkbutton set CASEsense0or1 0 checkbutton .fRothropts.chkbuttCASE \ -text "$aRtext(chkbuttCASE)" \ -font fontTEMP_SMALL_button \ -padx $fePADX_chkbutt \ -pady $fePADY_chkbutt \ -bd $feBDwidth_chkbutt \ -variable CASEsense0or1 \ -selectcolor "$chkbuttBKGD" \ -relief $feRELIEF_checkbutton set MATCHtype0or1 0 checkbutton .fRothropts.chkbuttMATCH \ -text "$aRtext(chkbuttREGEXP)" \ -font fontTEMP_SMALL_button \ -padx $fePADX_chkbutt \ -pady $fePADY_chkbutt \ -bd $feBDwidth_chkbutt \ -variable MATCHtype0or1 \ -selectcolor "$chkbuttBKGD" \ -relief $feRELIEF_checkbutton ########################################################### ## PACK THE 'Search-Opts' WIDGETS in the 'fRothropts' FRAME ## --- on the left side. ########################################################### pack .fRothropts.labSRCHOPTS \ .fRothropts.chkbuttDIRECTION \ .fRothropts.chkbuttCASE \ .fRothropts.chkbuttMATCH \ -side left \ -anchor w \ -fill x \ -expand 0 ############################################### ## END OF 'Search' opt buttons. ## START OF 'SAM' (ShowAllMatches) opt buttons. ############################################### frame .fRothropts.fRspacer1 \ -relief flat \ -borderwidth 0 \ -width 10 label .fRothropts.labSAMOPTS \ -text "$aRtext(labelSAMOPTS)" \ -font fontTEMP_label \ -justify left \ -anchor w \ -relief flat \ -bd $feBDwidth_button set SAMCASEsense0or1 0 checkbutton .fRothropts.chkbuttSAMCASE \ -text "$aRtext(chkbuttCASE)" \ -font fontTEMP_SMALL_button \ -padx $fePADX_chkbutt \ -pady $fePADY_chkbutt \ -bd $feBDwidth_chkbutt \ -variable SAMCASEsense0or1 \ -selectcolor "$chkbuttBKGD" \ -relief $feRELIEF_checkbutton set SAMNOT0or1 0 checkbutton .fRothropts.chkbuttSAMNOT \ -text "$aRtext(chkbuttNOT)" \ -font fontTEMP_SMALL_button \ -padx $fePADX_chkbutt \ -pady $fePADY_chkbutt \ -bd $feBDwidth_chkbutt \ -variable SAMNOT0or1 \ -selectcolor "$chkbuttBKGD" \ -relief $feRELIEF_checkbutton frame .fRothropts.fRspacer2 \ -relief flat \ -borderwidth 0 \ -width 15 ########################################################### ## PACK THE 'SAM-Opts' WIDGETS in the 'fRothropts' FRAME ## --- on the left side, with a spacer. ########################################################### pack .fRothropts.fRspacer1 \ .fRothropts.labSAMOPTS \ .fRothropts.chkbuttSAMCASE \ .fRothropts.chkbuttSAMNOT \ .fRothropts.fRspacer2 \ -side left \ -anchor w \ -fill x \ -expand 0 ################################################### ## END OF 'SAM' (ShowAllMatches) opt buttons. ## START OF 'MISC' opt buttons (Color,Font,EdVars). ################################################### button .fRothropts.buttcolor \ -text "$aRtext(buttonCOLOR)" \ -font fontTEMP_SMALL_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command {getset_palette_color} button .fRothropts.buttfont \ -text "$aRtext(buttonFONT)" \ -font fontTEMP_SMALL_button \ -padx $fePADX_button \ -pady $fePADY_button \ -relief raised \ -bd $feBDwidth_button \ -command {set_font} ########################################################### ## PACK THE 'MISC' WIDGETS in the 'fRothropts' FRAME ## --- on the right side. ########################################################### pack .fRothropts.buttfont \ .fRothropts.buttcolor \ -side right \ -anchor e \ -fill x \ -expand 0 ################################################################## ## IN THE 'fRmain' frame -- DEFINE 1 TEXT AND 2 SCROLLBAR WIDGETS ## THEN PACK THEM. ################################################################## ## The following code is based on ## page 216, Chap 19.5 of Ousterhout ## book "Tcl & the Tk Toolkit". ################################################################## ##################################################################### ## Initial colors of the text widget foreground & background ## are set at the bottom of this script, by proc 'set_text_colors'. ##################################################################### text .fRmain.text \ -relief raised \ -borderwidth 4 \ -wrap none \ -font fontTEMP_text \ -yscrollcommand ".fRmain.scrolly set" \ -xscrollcommand ".fRmain.scrollx set" scrollbar .fRmain.scrolly \ -orient vertical \ -command ".fRmain.text yview" scrollbar .fRmain.scrollx \ -orient horizontal \ -command ".fRmain.text xview" ## GOOD TO PACK THE SCROLLBAR BEFORE THE TEXT WIDGET. ## THE TEXT WIDGET MAY TRY TO TAKE ALL THE FRAME SPACE. set LR_sidebar "right" pack .fRmain.scrolly \ -side $LR_sidebar \ -anchor center \ -fill y \ -expand 0 ## DO NOT USE '-expand 1' HERE; ALLOWS Y-SCROLLBAR TO X-EXPAND -- ## PUTS BLANK SPACE BETWEEN Y-SCROLLBAR & ITS LISTBOX. pack .fRmain.scrollx \ -side bottom \ -anchor center \ -fill x \ -expand 0 ## DO NOT USE '-expand 1' HERE; KEEPS TEXT AREA FROM Y-EXPANDING. set LR_sidetxt "left" pack .fRmain.text \ -side $LR_sidetxt \ -anchor center \ -fill both \ -expand 1 ######################################################################## ## WE LOAD THE SPECIFIED $FILEname INTO THE '.fRmain.text' WIDGET BELOW, ## with a read-file proc, AFTER proc's are defined. ######################################################################## ######################################################################## ## INITIALIZE 'SEARCHstrPREV' and 'cursorLOCold' and ## 'selBG', for use by the 'search4string' proc. ## ( 'cursorLOCold' is commented. Not really needed now.) ######################################################################## set SEARCHstrPREV "" # set cursorLOCold 1.0 set cursorLOC 1.0 ## The following is obsolete. We now use two different hilite ## colors, for alternating search passes --- and set them ## according to current r255,g255,b255 colors. ## See the procs 'set_text_colors' and 'search4string'. ## # set selBG $search_COLOR_hilite1 # .fRmain.text tag configure sel -background $selBG ## Initialize the RELIEF vars to be used for search 'hit' hiliting. set search_RELIEF_hilite1 "raised" set search_RELIEF_hilite2 "ridge" set selRELIEF $search_RELIEF_hilite1 ########################################################################## ########################################################################## ## END OF INITIAL GUI DEFINITION. ########################################################################## ########################################################################## ########################################################################## ########################################################################## ## DEFINE BINDINGS: ## ## Bindings related to SEARCH-ENTRY-FIELD: (Return-Key-binding) ## ## - .fRsearch.entSTR search for string ## ## ## Bindings related to BUTTON-RELEASE IN THE TEXT AREA: ## ## - .fRmain.text set current cursor loc var, cursorLOC ## ## - .fRmain.text popmsg showing line.col nums of cursorLOC ## ## - .fRmain.text select-&-highlight string -- to whitespace ## on either side of the chracter 'tapped'. ## ## Bindings related to SCROLLING-THRU-TEXT: (via *keyboard*-bindings) ## ## - .fRmain.text (or .) ## - .fRmain.text (or .) ## - .fRmain.text (or .) ## - .fRmain.text (or .) ## - .fRmain.text (or .) ## - .fRmain.text (or .) ########################################################################## ########################################################################## #################################################### ## bind .fRsearch.entSTR #################################################### bind .fRsearch.entSTR {search4string} #################################################### ## bind .fRmain.text #################################################### bind .fRmain.text { set cursorLOC [ .fRmain.text index insert ] ## FOR TESTING: # puts "MB1-release cursorLOC: $cursorLOC" ## FOR TESTING: # popup_msg "New (hidden) Cursor-Location in text # (line & column numbers): $cursorLOC # (where first-line.first-colmun is 1.0)" } ## END OF BINDING for .fRmain.text #################################################### ## bind .fRmain.text #################################################### bind .fRmain.text { ## Comment this? Does not do anything here? ## Requires MB-1 poke to set insert-cursor? set cursorLOC [ .fRmain.text index insert ] ## FOR TESTING: # puts "MB2-release cursorLOC: $cursorLOC" ###################################################################### ## Popup msg showing line.col-numbers of current ## cursor location. ###################################################################### # set DOTindex [ string first {.} $cursorLOC ] # set LINEnum [ string range $cursorLOC 0 [ expr $DOTindex - 1 ] ] # set COLnum [ string range $cursorLOC [ expr $DOTindex + 1 ] end] popup_msg "Cursor Location (line & column numbers): $cursorLOC (For location last set with mouse-button-1.)" } ## END OF BINDING for .fRmain.text #################################################### ## bind .fRmain.text #################################################### bind .fRmain.text { selectchar2whitespace ## FOR TESTING: # puts "MB3-release. Performed 'selectchar2whitespace'." } ## END OF BINDING for .fRmain.text #################################################### ## FOR TESTING KEY-BINDINGS: ## SHOW ANY KEY-PRESS on .fRmain.text: ## - .fRmain.text #################################################### # bind .fRmain.text { # # ## FOR TESTING: # puts "Key pressed: %K" # puts "cursorLOC: $cursorLOC" # # } # ## END OF BINDING for .fRmain.text ##################################################### ## FOR TESTING: Show default bindings with 'bindtags': ##################################################### ## SHOWS: BINDtags: .fRmain.text Text . all ##################################################### # # set BINDtags [ bindtags .fRmain.text ] # puts "BINDtags: $BINDtags" ###################################################### ## WE COULD: OVER-RIDE THE Class 'Text' BINDINGS, ## WITH THE BINDINGS WE SET FOR '.fRmain.text' (OR '.'). ###################################################### # bindtags .fRmain.text [ list Text .fRmain.text . all ] ##################################################### ## FOR TESTING: Show new bindings with 'bindtags': ##################################################### ## SHOWS: BINDtags: Text .fRmain.text . all ##################################################### # # set BINDtags [ bindtags .fRmain.text ] # puts "BINDtags: $BINDtags" ####################################################### ## BINDING: ## - . ####################################################### # bind .fRmain.text ####################################################### bind . { .fRmain.text see 1.0 ## FOR TESTING: # puts "Key pressed: %K" } ## END OF BINDING for .fRmain.text ####################################################### ## BINDING: ## - . ####################################################### # bind .fRmain.text ####################################################### bind . { # .fRmain.text see "[expr $TOTlines - 1].0" .fRmain.text see end ## FOR TESTING: # puts "Key pressed: %K" } ## END OF BINDING for .fRmain.text ####################################################### ## BINDING: (Page-Up key) ## - . ####################################################### # bind .fRmain.text ####################################################### bind . { .fRmain.text yview scroll -1 page ## FOR TESTING: # puts "Key pressed: %K" } ## END OF BINDING for .fRmain.text ####################################################### ## BINDING: (Page-Down key) ## - . ####################################################### # bind .fRmain.text ####################################################### bind . { .fRmain.text yview scroll +1 page ## FOR TESTING: # puts "Key pressed: %K" } ## END OF BINDING for .fRmain.text ####################################################### ## BINDING: (Up-arrow key) ## - . ####################################################### # bind .fRmain.text ####################################################### bind . { .fRmain.text yview scroll -1 unit ## FOR TESTING: # puts "Key pressed: %K" } ## END OF BINDING for .fRmain.text ####################################################### ## BINDING: (Down-arrow key) ## - . ####################################################### # bind .fRmain.text ####################################################### bind . { .fRmain.text yview scroll +1 unit ## FOR TESTING: # puts "Key pressed: %K" } ## END OF BINDING for .fRmain.text ########################################################################## ########################################################################## ## DEFINE PROCEDURES: ## ## Search stuff: ## - 'search4string' ## - 'all_matches2string' ## - 'clear_search_string' ## ## Message windows: ## - 'tkerror' (commented) ## - 'popup_msg' ## - 'popup_msg2' (Alternative to popup_msg, using tk_dialog. ## Can simply use 'popup_msg' every place in ## this script and rename the 'proc' statements ## to activate the backup copy, like ## popup_msg --> popup_msgX ## and popup_msg2 --> popup_msg ) ## ## Color stuff: ## - 'toggle_color' (retired; kept for reference) ## - 'set_text_colors' ## - 'getset_palette_color' ## ## Flip y-scroll bar side-to-side: ## - 'toggle_side' ## ## Font stuff: ## - 'toggle_font' (retired) ## - 'set_font' (replaces 'toggle_font') ## ## Show current location in text widget: ## - 'selectchar2whitespace' ## ## Show/Hide 'Other' frame: ## - 'toggle_othropts' ## ## InputFile reading: ## - 'readfile2textwidget' ## - 'getfile2textwidget' ## - 'popup_msg_3opts' ## - 'finalize_textwidget' ########################################################################## ########################################################################## ######################################################################## ## 'search4string' PROCEDURE ######################################################################## ## ## PURPOSE: To locate the search-string in the text widget and ## position the cursor there. ## ## CALLED BY: .fRsearch.entSTR BINDING ## and button .fRsearch.buttSEARCH ## ########################################################################## ## Based on code in pages 523-528 of the book ## by Hattie Schroeder & Mike Doyel,'Interactive Web Applications ## with Tcl/Tk', Appendix A "ED, the Tcl Code Editor". ## --- ## The code changed significantly on adding the backward search capability. ########################################################################## proc search4string { } { global SEARCHstring SEARCHstrPREV cursorLOC TOTmatches global search_COLOR_hilite1 search_COLOR_hilite2 selBG global search_RELIEF_hilite1 search_RELIEF_hilite2 selRELIEF global PlusMinusLines global SRCHdirection0or1 CASEsense0or1 MATCHtype0or1 global SRCHdirection0or1PREV ## Set an indicator of whether the match-highlight-color is ## changed during the current call to this proc. set selBGchanged "no" ## FOR TESTING: # puts "" # puts "*************************************************" # puts "Entering proc 'search4string' with var values ..." # puts "SRCHdirection0or1: $SRCHdirection0or1" # puts "CASEsense0or1: $CASEsense0or1" # puts "MATCHtype0or1: $MATCHtype0or1" # puts "" # puts "cursorLOC: $cursorLOC" ######################################################################## ## IF THE SEARCH-STRING IS A NEW ONE (i.e. if it changed): ## 1) Set cursorLOC (the 'index' for the 'search' command) ## at the beginning or end of the text widget --- depending on ## whether the current search-direction is forward or backward. ## 2) Reset TOTmatches to zero. ## 3) Remove the current 'sel' tags, and set the 'sel' tag ## background color. (We toggle between two contrasting colors.) ## 4) Reset SEARCHstrPREV to the NEW SEARCHstring. ######################################################################## if { "$SEARCHstring" != "$SEARCHstrPREV" } { ## FOR TESTING: # puts "" # puts "AAAAAAAAAAAAAAAAAAAAAAAAAAAA" # puts "Search string has changed. Settings:" # puts "SEARCHstring : $SEARCHstring" # puts "SEARCHstrPREV : $SEARCHstrPREV" # puts "TOTmatches: $TOTmatches" # puts "cursorLOC : $cursorLOC" ## If searching forward and the search string is changed, automatically ## re-position cursor in order to start search at top of file. if { $SRCHdirection0or1 == 0 } { set cursorLOC 1.0 } ## If searching backward and the search string is changed, leave ## cursor position at start of found string. Typically the user ## wants to find a different string. ## Example: Found a directory name indicator, now want to go ## backward to find a filename with a different string. ## COMMENTED 31mar2008: (This was sticking the search at the same string.) #if { $SRCHdirection0or1 == 1 } { # set cursorLOC [ .fRmain.text index "end - 1 char" ] #} set TOTmatches 0 ## Change the highlight-color on the matches, since the search string ## has been changed. if { "$selBG" == "$search_COLOR_hilite1" } { set selBG $search_COLOR_hilite2 } else { set selBG $search_COLOR_hilite1 } set selBGchanged "yes" if { "$selRELIEF" == "$search_RELIEF_hilite1" } { set selRELIEF $search_RELIEF_hilite2 } else { set selRELIEF $search_RELIEF_hilite1 } ## Remove the current highlights and set the new highlighting color ## and the new highlighting relief. .fRmain.text tag remove sel 1.0 end .fRmain.text tag configure sel -background $selBG .fRmain.text tag configure sel -borderwidth 3 .fRmain.text tag configure sel -relief $selRELIEF ## Save the new search string for future comparison. set SEARCHstrPREV "$SEARCHstring" ## FOR TESTING: # puts "-------------" # puts "New settings:" # puts "SEARCHstring : $SEARCHstring" # puts "SEARCHstrPREV : $SEARCHstrPREV" # puts "TOTmatches: $TOTmatches" # puts "cursorLOC : $cursorLOC" } ## END OF if { "$SEARCHstring" != "$SEARCHstrPREV" } ######################################################################## ## IF THE SEARCH DIRECTION HAS CHANGED: ## 1) Leave cursorLOC set to the current search-index location, ## which, ordinarily, is the location of the last match ## (end of the match string for a forward search, and ## beginning of the match string for a backward search) ## --- or cursorLOC is an initialized search-start location. ## 2) Reset TOTmatches to zero. ## 3) Remove the current 'sel' tags, and set the 'sel' tag ## background color. (We toggle between two contrasting colors.) ## 4) Reset SRCHdirection0or1PREV. ######################################################################## if { $SRCHdirection0or1 != $SRCHdirection0or1PREV } { ## FOR TESTING: # puts "" # puts "AAAAAAAAAAAAAAAAAAAAAAAAAAAA" # puts "Search direction has changed. Settings:" # puts "SRCHdirection0or1 : $SRCHdirection0or1" # puts "SRCHdirection0or1PREV: $SRCHdirection0or1PREV" # puts "TOTmatches: $TOTmatches" # puts "cursorLOC: $cursorLOC" ################################################################### ## WE DO *NOT* RESET 'cursorLOC' with a statement like the following. ## Nor do we adjust 'cursorLOC', when search-direction is changed. ################################################################### # set cursorLOC [ .fRmain.text index current ] # set cursorLOC [ .fRmain.text index insert ] set TOTmatches 0 ## If the match-highlight-color has not been changed, change it to ## correspond to the search direction being changed. ## Change the relief at the same time. if { "$selBGchanged" == "no" } { if { "$selBG" == "$search_COLOR_hilite1" } { set selBG $search_COLOR_hilite2 } else { set selBG $search_COLOR_hilite1 } if { "$selRELIEF" == "$search_RELIEF_hilite1" } { set selRELIEF $search_RELIEF_hilite2 } else { set selRELIEF $search_RELIEF_hilite1 } set selBGchanged "no" } ## Remove current match-highlights and set the new ## match-highlighting color and the new relief. .fRmain.text tag remove sel 1.0 end .fRmain.text tag configure sel -background $selBG .fRmain.text tag configure sel -borderwidth 3 .fRmain.text tag configure sel -relief $selRELIEF ## Save the current search-direction for comparison. set SRCHdirection0or1PREV $SRCHdirection0or1 ## FOR TESTING: # puts "-------------" # puts "New settings:" # puts "SRCHdirection0or1 : $SRCHdirection0or1" # puts "SRCHdirection0or1PREV: $SRCHdirection0or1PREV" # puts "TOTmatches: $TOTmatches" # puts "cursorLOC: $cursorLOC" } ## END OF if { $SRCHdirection0or1 != $SRCHdirection0or1PREV } ######################################################################## ## IF THE SEARCH-STRING IS EMPTY: ## 1) pop a message, ## 2) set cursorLOC at the beginning of the text widget, ## 3) set TOTmatches to zero, ## 4) return. ######################################################################## if { "$SEARCHstring" == "" } { popup_msg "Need a search string for 'Search (again)'." set cursorLOC 1.0 ; set TOTmatches 0 ; return } ######################################################################## ## SET THE '.fRmain.text search' COMMAND PARMS --- for ## CASESENSEparm and MATCHTYPEparm. ######################################################################## set SRCHDIRECTNparm "-forward" if { "$SRCHdirection0or1" == "1" } { set SRCHDIRECTNparm "-backward" } set CASESENSEparm "-nocase" if { "$CASEsense0or1" == "1" } { set CASESENSEparm "" } set MATCHTYPEparm "-exact" if { "$MATCHtype0or1" == "1" } { set MATCHTYPEparm "-regexp" } ## FOR TESTING: # puts "" # puts "Doing the '.fRmain.text search' with parms ..." # puts "SRCHDIRECTNparm: $SRCHDIRECTNparm" # puts "CASESENSEparm: $CASESENSEparm" # puts "MATCHTYPEparm: $MATCHTYPEparm" # puts "cursorLOC: $cursorLOC" ######################################################################## ## DO THE SEARCH -- from cursorLOC to ## - 'end' if the search is forward, ## or ## - '1.0' if the search is backward. ######################################################################## set length 0 set cursorLOCsrchLAST $cursorLOC if { $SRCHdirection0or1 == 0 } { ## FOR TESTING: # puts "" # puts "Doing the FORWARD search." set cursorLOC [eval .fRmain.text search \ $SRCHDIRECTNparm $CASESENSEparm $MATCHTYPEparm \ -count length -- \"$SEARCHstring\" \ $cursorLOC end ] # $cursorLOC ] } else { ## FOR TESTING: # puts "" # puts "Doing the BACKWARD search." set cursorLOC [eval .fRmain.text search \ $SRCHDIRECTNparm $CASESENSEparm $MATCHTYPEparm \ -count length -- \"$SEARCHstring\" \ $cursorLOC 1.0 ] # $cursorLOC ] ## cycles around # $cursorLOC 1.0 ] ## works, except when $cursorLOC is 'end' # 1.0 $cursorLOC ] ## does not work } ## FOR TESTING: # puts "===========================" # puts "In the 'search4string' proc," # puts "right AFTER the 'search' command ..." # puts "" # puts "SEARCHstrPREV: $SEARCHstrPREV" # puts "SEARCHstring : $SEARCHstring" # puts "cursorLOC : $cursorLOC" # puts "cursorLOCsrchLAST : $cursorLOCsrchLAST" ######################################################################## ## If the 'search' fails (yields a null new-cursor-location): ## 1) Popup a message. ## (If TOTmatches not zero, show the count in the msg.) ## 2) Leave cursorLOC var as-is. (It will be reset if there is a ## change in search-string or search-direction. See above.) ## 3) Reset SEARCHstrPREV to null (to trigger the ## search-match-color-change, removal of current 'sel' selections, ## and other changes, above, when a new search is started). ## 4) Return. ######################################################################## if { "$cursorLOC" == "" } { if { $TOTmatches == 0 } { set NOMATCHmsg "No string match for string: $SEARCHstring" } else { set NOMATCHmsg "No further string matches for string: $SEARCHstring Total Matches found/high-lighted: $TOTmatches" } popup_msg "$NOMATCHmsg Search Direction: $SRCHDIRECTNparm Last search-start location (Line.Column): $cursorLOCsrchLAST" ################################################################## ## WE DO *NOT* RESET 'cursorLOC' (nor search-direction) with ## statements like the following, when no more matches are found. ################################################################## # set cursorLOC 1.0 # set SRCHdirection0or1 0 ####################################### ## Return display to cursorLOC 1.0 ####################################### # .fRmain.text see $cursorLOC set SEARCHstrPREV "" ################################################################## ## Resetting $SEARCHstrPREV to null should suffice to trigger ## the following 'tag remove sel' statement & change $selBG. ## See 'if' statements above, when search-string or search-direction ## change. ################################################################## # # .fRmain.text tag remove sel 1.0 end # # if { "$selBG" == "$search_COLOR_hilite1" } { # set selBG $search_COLOR_hilite2 # } else { # set selBG $search_COLOR_hilite1 # } return } ## END OF if { "$cursorLOC" == "" } ######################################################################## ## If we got past the previous 'if' and its 'return' (i.e. if ## cursorLOC was NOT set to NULL by 'search', i.e. search did NOT fail), ## and if the '$length' is not 0 (i.e. if 'search' definitely succeeded): ## 1) Add the text found to the 'sel' tag. ## 2) Increment TOTmatches. ## 3) Set cursorLOC to end of current match (if search was 'forward'). ## 4) Use 'see' to expose the current match-line to the user. ## Try to have at least one to three lines showing either ## BELOW the match line (if the search was 'forward') or ## ABOVE the match line (if the search was 'backward'). ## ## (In other words, ## the index in the 'see' line may be set differently depending ## whether the search was forward or backward.) ######################################################################## ## NOTE: We could probably drop the 'if { $length != 0 }' and simply ## do the statements in that 'if' section. ######################################################################## if { $length != 0 } { .fRmain.text tag add sel $cursorLOC "$cursorLOC + $length char" set TOTmatches [ expr $TOTmatches + 1 ] if { $SRCHdirection0or1 == 0 } { ################################################################ ## If search-direction is 'forward', we adjust cursorLOC to the ## end of the found string, ## for the start of the next search for the same string. ################################################################ set cursorLOC [.fRmain.text index "$cursorLOC + $length char" ] ################################################################ ## FOR a 'forward' search: ## We use 'see' to put the line that is $PlusMinusLines ## (or at least one line) past the match line, in the view area. ################################################################ ## The following group of lines used to be the single line ## .fRmain.text see $cursorLOC ################################################################ set NmoreLines $PlusMinusLines # if { $NmoreLines < 1 } { # set NmoreLines 1 # } if { $NmoreLines < 3 } { set NmoreLines 4 } .fRmain.text see "$cursorLOC + $NmoreLines lines" ####################################### ## Make sure the match-line is showing. ####################################### .fRmain.text see $cursorLOC } else { ################################################################ ## If search-direction is 'backward', we leave cursorLOC unchanged, ## for the start of the next search for the same string. ################################################################ # set cursorLOC [.fRmain.text index "$cursorLOC - $length char" ] ################################################################ ## FOR a 'backward' search: ## We use 'see' to put the line that is $PlusMinusLines ## (or at least one line) past the match line, in the view area. ################################################################ ## The following group of lines used to be the single line ## .fRmain.text see $cursorLOC ################################################################ set NminusLines $PlusMinusLines # if { $NminusLines < 1 } { # set NminusLines 1 # } if { $NminusLines < 3 } { set NminusLines 4 } .fRmain.text see "$cursorLOC - $NminusLines lines" ####################################### ## Make sure the match-line is showing. ####################################### .fRmain.text see $cursorLOC } ## END OF if { $SRCHdirection0or1 == 0 } } ## END OF if { $length != 0 } ## FOR TESTING: # puts "===========================" # puts "In the 'search4string' proc," # puts "AFTER the failed-'search' & successful-'search' checks ..." # puts "" # puts "SEARCHstrPREV: $SEARCHstrPREV" # puts "SEARCHstring : $SEARCHstring" # puts "cursorLOC : $cursorLOC" # puts "cursorLOCsrchLAST : $cursorLOCsrchLAST" } ## END OF 'search4string' PROCEDURE ########################################################################### ## 'all_matches2string' PROCEDURE ########################################################################### ## PURPOSE: Shows the user ALL the Matches to the current search string, ## in the entire input file. ## CALLED BY: .fRsearch.buttGETmatches button command. ########################################################################### proc all_matches2string { } { global SEARCHstring FILEname PlusMinusLines DIRxpg \ SAMCASEsense0or1 SAMNOT0or1 if { "$SEARCHstring" == "" } { popup_msg "Need a search string for ShowAllMatches." return } set CASESENSEyesno "no" if { "$SAMCASEsense0or1" != "0" } { set CASESENSEyesno "yes" } ## OLD PLACE-HOLDER: # popup_msg "Matching lines, plus-or-minus N lines, will show in a window." if { "$SAMNOT0or1" == "0" } { ## FOR TESTING: # puts "SAMNOT0or1: $SAMNOT0or1" # puts "string N yes/no filename : '$SEARCHstring' $PlusMinusLines $CASESENSEyesno $FILEname" ## OLD VERSION (Failed when search string was a char like ">", ## which the shell interpreted as the direction operator.): # # exec $DIRxpg/findANDshow_stringINfile_plusminusNlines \ # $PlusMinusLines "$SEARCHstring" $FILEname & ## NEW VERSION --- with single-quotes to hide string var from shell: ## (Requires an 'eval' trick in the findANDshow script, ## to remove the single-quotes from around the SEARCHstring.) exec $DIRxpg/findANDshow_stringsINfile_plusminusNlines.sh \ '$SEARCHstring' $PlusMinusLines "$CASESENSEyesno" "$FILEname" & } else { ## FOR TESTING: # puts "SAMNOT0or1: $SAMNOT0or1" # puts "string yes/no filename : '$SEARCHstring' $CASESENSEyesno $FILEname" exec $DIRxpg/findANDshow_NOTstringsINfile.sh \ '$SEARCHstring' "$CASESENSEyesno" "$FILEname" & } ## END OF if { "$SAMNOT0or1" == "0" } } ## END OF 'all_matches2string' PROCEDURE ########################################################################### ## 'clear_search_string' PROCEDURE ########################################################################### ## PURPOSE: Clears the search string field --- or restores it, if empty. ## CALLED BY: .fRsearch.buttClear button command. ########################################################################### proc clear_search_string { } { global SEARCHstring HOLD_cleared_string if { "$SEARCHstring" == "" } { set SEARCHstring "$HOLD_cleared_string" } else { set HOLD_cleared_string "$SEARCHstring" set SEARCHstring "" } } ## END OF 'clear_search_string' PROCEDURE ########################################################################### ## 'tkerror' PROCEDURE (Commented. We let the Tcl-Tk interpreter ## show a nice trace.) ########################################################################### ## PURPOSE: Let user see errors -- to report them. ## CALLED BY: Globally available. ########################################################################### ## Base on the Eric Johnson book 'Graphical Applications with Tcl & Tk', ## page 263, Chapter 8 "Tcl Tricks & Traps: Handling Errors & Debugging". ########################################################################### ## Method of commenting the proc without putting '#' on each line. if { 0 } { proc tkerror { errmsg } { global errorInfo errorCode w env set TKtest "" catch { set TKtest $env(TKTEST) } if { "$TKtest" == "YES" } { set msg [format "Error: %s\nResult: %s." $errmsg $errorCode] } else { set msg [format "Error: %s\n" $errmsg] } ############################################# ## Alert user to error. ############################################# ## tk_dialog .dlg "Error" $msg error 0 OK ############################################# ## RETURN THE CURSOR TO A 'LEFT POINTER'. ############################################# # . configure -cursor { left_ptr red white } ## return } ## END OF 'tkerror' PROCEDURE } ## END OF if { 0 } to comment this proc. ########################################################################### ## 'popup_msg' PROCEDURE ########################################################################### ## PURPOSE: Report information (a text message) to the user. ## CALLED BY: 'file_info' proc and error-check 'if' statements in various ## procs. ########################################################################### ## To have more control over the formatting of the message (esp. ## words per line), we use this 'toplevel-with-text-widget' window making ## method, rather than the 'tk_dialog' method --- see 'popup_msg2' proc ## below --- from page 574 of the book by Hattie Schroeder & Mike Doyel, ## 'Interactive Web Applications with Tcl/Tk', Appendix A ## "ED, the Tcl Code Editor". ########################################################################### proc popup_msg { VARtext } { global feFONT_text feFONT_button feBDwidth_text feBDwidth_button ## Use 'THIShost' and 'env(USER)' in popup wintitle. global THIShost env # bell bell ############################################# ## SETUP 'TOP LEVEL' HELP WINDOW --- titles. ############################################# set w .topmsg catch {destroy $w} toplevel $w # wm title $w "ShowFile Note, from $THIShost to $env(USER)" wm title $w "ShowFile Note" wm iconname $w "ShoFilNote" ###################################### ## To keep the popup in front of other ## windows, incl. the one generated by ## this app, try one of the following. ###################################### # raise .topmsg # raise .topmsg . ## This is said to work with the Gnome metacity wm: # wm group .topmsg . ############################################# ## Put '.topmsg' window near upper-left corner ## of the application '.' window. ############################################# ## Ref: p.140, Chap 4 Menus, "Graphical ## Applications with Tcl & Tk", ## Eric F. Johnson ############################################# ## COMMENTED. Instead, we set the location ## relative to the upper left of the ## 'shofil.tk' GUI window. ############################################# ## wm geometry $w 662x646+431+202 ## wm geometry $w +200+100 # wm geometry $w +050+050 ############################################## ## SET the location of the popup msg window ## relative to the upper left of the ## 'shofil.tk' GUI window. ############################################# ## Get global x,y pos of app. ############################################# set gx [winfo rootx .] set gy [winfo rooty .] ## If we were to postition at mouse cursor: ## Add local mouse pos. # set mx [expr %x + $gx] # set my [expr %y + $gy] set gx [expr $gx + 300] set gy [expr $gy + 120] wm geometry $w +${gx}+${gy} ########################################### ## SET the MINSIZE of the popup msg window. ########################################### wm minsize $w 200 60 ##################################### ## SETUP TEXT WIDGET for popup msg. ##################################### text $w.text \ -relief raised \ -borderwidth $feBDwidth_text \ -font fontTEMP_text pack $w.text \ -side top \ -anchor center \ -fill both \ -expand 0 ## $w.text delete 1.0 end $w.text insert end $VARtext $w.text configure -state disabled ################################################### ## SETUP 'Close' BUTTON WIDGET on popup msg window. ################################################### button $w.buttClose \ -text "Close" \ -font fontTEMP_button \ -relief raised -borderwidth $feBDwidth_button \ -command " destroy $w ; return " pack $w.buttClose \ -side top \ -anchor center \ -fill none \ -expand 0 ################################################# ## Get VARheight & VARwidth from $VARtext --- and ## set the height and width of the text widget in ## the popup msg window. ################################################# ## To get VARheight, ## split at '\n' (newlines) and count 'lines'. ################################################# set VARlist [ split $VARtext "\n" ] ## FOR TESTING: # puts "VARlist: $VARlist" set VARheight [ llength $VARlist ] ## FOR TESTING: # puts "VARheight: $VARheight" $w.text configure -height $VARheight ################################################# ## To get VARwidth, ## loop through the 'lines' getting length ## of each; save max. ################################################# set VARwidth 0 ############################################# ## LOOK AT EACH LINE IN THE LIST. ############################################# foreach line $VARlist { ############################################# ## Get the length of the line. ############################################# set LINEwidth [ string length $line ] if { $LINEwidth > $VARwidth } { set VARwidth $LINEwidth } } ## END OF foreach line $VARlist set VARwidth [ expr $VARwidth + 1 ] $w.text configure -width $VARwidth ## FOR TESTING: # puts "VARwidth: $VARwidth" ######################################################################## ## NOTE: VARwidth works for an adobe-courier fixed-width font used ## for the text widget ... BUT the programmer may need to be ## careful that the contents of VARtext ## are all countable characters by the 'string length' command. ######################################################################## } ## END OF 'popup_msg' PROCEDURE ########################################################################### ## 'popup_msg2' PROCEDURE ########################################################################### ## PURPOSE: Report search-failure conditions to the user. ## CALLED BY: near bottom of 'search4string' proc, at "No match." ########################################################################### ## From page 574 of the book ## by Hattie Schroeder & Mike Doyel,'Interactive Web Applications ## with Tcl/Tk', Appendix A "ED, the Tcl Code Editor". ########################################################################### proc popup_msg2 { message } { # sound_bell set w .popmsg ###################################################################### ## This 'destroy' does not work on the 'tk_dialog' window, because ## 'tk_dialog' hangs the app, waiting for a click on one of its buttons. ###################################################################### # catch {destroy $w} ############################################# ## After 100 milliseconds, grab' the window. ############################################# ## Not good practice. Can cause screen lockups. ############################################# # # after 100 { # grab -global $w # } ############################################# ############################################# ## Use 'tk_dialog' to define&pack the window. ############################################# tk_dialog $w "Note" $message warning 0 Close ############################################# ## Release the 'grabbed' window. ############################################# # grab release $w ############################################# } # ## END OF 'popup_msg2' PROCEDURE ######################################################################## ## 'toggle_color' PROCEDURE (NOT USED ; maybe someday) ######################################################################## ## ## PURPOSE: To 'switch' the foreground & background colors of ## the text widget. ## ## CALLED BY: .fRtopbar.togcolor button ## ######################################################################## ## Method to comment out the following proc without using '#' on each line. if { 0 } { proc toggle_color { } { global COLOR_fg COLOR_bg feFONT_text global COLOR_palette_dark COLOR_palette_bright global COLOR_textdark COLOR_bkgdbright COLOR_textbright COLOR_bkgddark ### Could use a larger font in bright-text-on-dark to improve readability. ### Declare FONT_LARGE_Text above in the font-defs section. # # global FONT_TextHold FONT_LARGE_Text if { "$COLOR_fg" == "$COLOR_textdark" } { set COLOR_fg $COLOR_textbright set COLOR_bg $COLOR_bkgddark tk_setPalette $COLOR_palette_dark # set FONT_TextHold $FONT_LARGE_Text } else { set COLOR_fg $COLOR_textdark set COLOR_bg $COLOR_bkgdbright tk_setPalette $COLOR_palette_bright # set FONT_TextHold $FONT_Text } .fRmain.text configure -fg $COLOR_fg -bg $COLOR_bg -font fontTEMP_text } ## END OF 'toggle_color' PROCEDURE } ##END OF if { 0 } to comment out this proc. ########################################################################## ## 'set_text_colors' PROCEDURE ########################################################################## ## PURPOSE: ## This procedure is invoked to set a slightly brighter background color ## for the text widget, .fRmain.text --- brighter than the color given by ## current values in three global vars --- r255 g255 b255 --- ## which should be the values used to set the 'palette' of the entire GUI. ## ## This proc also sets search-hilite vars ## set search_COLOR_hilite1 ## set search_COLOR_hilite2 ## to contrast to text-area background color. ## ## These 2 search_COLOR vars are used in the 'search4string' proc --- to ## high-light match strings. One color is used in a search pass, and if ## the search is changed in some sense (direction, search string, whatever), ## the other color is used for the next search pass. (For those who are ## color blind, 2 'relief' vars are also used.) ## ## [Could also call proc 'set_foregd_color' (below) to set the ## FOREGROUND text widget color to black or off-white depending ## on the luminance value of the chosen text background color. ## ## That is, we could use a different foreground-color setting technique ## from the foreground-color setting logic used in 'tk_setPalette'.] ## ## Arguments: none ## ## CALLED BY: proc 'getset_palette_color' below, which is invoked by ## the 'ChgColor' button ## ## This proc is ALSO CALLED at the bottom of this script as a GUI ## initialization procedure (for the colors in the text widget). ######################################################################## proc set_text_colors {} { global r255 g255 b255 global search_COLOR_hilite1 search_COLOR_hilite2 selBG ###################################################### ## Set text-area BACKGROUND color to slightly brighter ## color than the current r255,g255,b255 values --- ## which should be the values used to set the GUI palette. ###################################################### set CFACT 1.1 set r255TEMP [ expr int($CFACT * $r255) ] set g255TEMP [ expr int($CFACT * $g255) ] set b255TEMP [ expr int($CFACT * $b255) ] if { $r255TEMP > 255 } { set r255TEMP 255 } if { $g255TEMP > 255 } { set g255TEMP 255 } if { $b255TEMP > 255 } { set b255TEMP 255 } set COLOR_bg_hex [format "#%02X%02X%02X" $r255 $g255 $b255] .fRmain.text configure -bg $COLOR_bg_hex ## We could change the foreground color too, in the text area, with: ## .fRmain.text configure -bg $COLOR_bg_hex -fg $COLOR_fg_hex ## BUT we keep the same foreground color as last set by 'tk_setPalette'. ############################################################### ## SET 2 COLORS TO USE FOR SEARCH-STRING HIGH-LIGHTING. ############################################################### ## This code is intended to assure hilites are set different from ## text widget BACKGROUND color. ## (We also should include some logic to assure that these ## colors are not too close of the FOREGROUND color of the text. ## Probably should query the current foreground color. Someday? ## For now, can use 'ChgColor' button to try different colors.) ############################################################### set LUMval [ expr .299*$r255 + .587*$g255 + .114*$b255 ] set MIDlum 127 if { $LUMval < $MIDlum } { set r1 200 set g1 200 set b1 0 set r2 0 set g2 200 set b2 200 } else { set r1 100 set g1 100 set b1 0 set r2 0 set g2 100 set b2 100 } # if { $r255 > $MIDlum } { # set r1 [ expr int( 0.5 * $r255 ) ] # set r2 [ expr int( 0.2 * $r255 ) ] # } else { # set r1 [ expr int( 1.7 * $r255 ) ] # set r2 [ expr int( 1.4 * $r255 ) ] # } # if { $g255 > $MIDlum } { # set g1 [ expr int( 0.7 * $g255 ) ] # set g2 [ expr int( 0.4 * $g255 ) ] # } else { # set g1 [ expr int( 1.6 * $g255 ) ] # set g2 [ expr int( 1.3 * $g255 ) ] # } # if { $b255 > $MIDlum } { # set b1 [ expr int( 0.6 * $b255 ) ] # set b2 [ expr int( 0.4 * $b255 ) ] # } else { # set b1 [ expr int( 1.5 * $b255 ) ] # set b2 [ expr int( 1.3 * $b255 ) ] # } set COLOR1 [format "#%02X%02X%02X" $r1 $g1 $b1] set search_COLOR_hilite1 "$COLOR1" # FOR TESTING: # puts "COLOR1: $COLOR1 $r1 $g1 $b1" set COLOR2 [format "#%02X%02X%02X" $r2 $g2 $b2] set search_COLOR_hilite2 "$COLOR2" # FOR TESTING: # puts "COLOR2: $COLOR2 $r2 $g2 $b2" ## In case we were in the middle of a search when we ## clicked the 'ChgColor' button to change the palette and ## text-area colors, we reset the 'sel' tag color to ## assure we have a hilite color based on the new color. set selBG $search_COLOR_hilite1 .fRmain.text tag configure sel -background $selBG } ## END OF 'set_text_colors' PROCEDURE ######################################################################## ## 'set_foregd_color' PROCEDURE (NOT USED, yet) ######################################################################## ## PURPOSE: ## This procedure is invoked to set a foreground color for text on ## the text widget, .fRmain.text, based on ## current values in three global vars: r255 g255 b255 ## ## Arguments: none ## ## CALLED BY: proc ? ######################################################################## proc set_foregd_color {} { ###################################################### ## Set text FOREGROUND color to black or off-white, ## according to luminance of background --- the ## current r255,g255,b255 colors. ###################################################### ## NOTE: 'Luminance' (Y) is given by a ## weighted average of RGB values, ## according to the formula: ## ## Y = .299*R + .587*G + .114*B ##################################################### set LUMval [ expr .299*$r255 + .587*$g255 + .114*$b255 ] set LOWlum 90 if { $LUMval < $LOWlum } { set COLOR_fg "#CCCCCC" } else { set COLOR_fg "#000000" } ################################################################ ## Set a somewhat different bkgd color for window heading and ## border (to be set by tk_Palette), based on the chosen text ## bkgdd color = r255,g255,b255. ## ## If the text background has high luminance, ## we make the heading-and-border a little darker. ## If the text background has low luminance, ## we make the heading-and-border a little brighter. ################################################################ set CFACT 0.85 set CMIN 60 if { $LUMval > $LOWlum } { set r255TEMP [ expr int($CFACT * $r255) ] set g255TEMP [ expr int($CFACT * $g255) ] set b255TEMP [ expr int($CFACT * $b255) ] } else { set r255TEMP [ expr $r255 + $CMIN ] set g255TEMP [ expr $g255 + $CMIN ] set b255TEMP [ expr $b255 + $CMIN ] if { $r255TEMP > 255 } { set r255TEMP 255 } if { $g255TEMP > 255 } { set g255TEMP 255 } if { $b255TEMP > 255 } { set b255TEMP 255 } } set COLOR_fg [format "#%02X%02X%02X" $r255TEMP $g255TEMP $b255TEMP] .fRmain.text configure -fg $COLOR_fg } ## END OF proc 'set_foregd_color' ######################################################################## ## 'getset_palette_color' PROCEDURE ######################################################################## ## PURPOSE: ## ## This procedure is invoked to get an RGB triplet (r255 g255 b255) ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses 'tk_setPalette' to set the palette of the entire GUI. ## ## Then uses 'set_text_colors' proc to set slightly different text area ## color for the text widget, .fRmain.text --- and colors for two ## search color hilite vars. ## ## Arguments: none ## ## CALLED BY: .fRothropts.buttcolor button ######################################################################## proc getset_palette_color {} { global r255 g255 b255 DIRxpg ## FOR TESTING: # puts "r255: $r255" # puts "g255: $g255" # puts "b255: $b255" set TEMPrgb [ exec \ $DIRxpg/sho_colorvals_via_sliders3rgb.tk \ $r255 $g255 $b255] ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } ## 2010aug23 changed output of 'sho_colorvals_via_sliders3rgb.tk'. ## It no longer has the strings 'R255=','G255=','B255='. # scan $TEMPrgb "R255=%s ; G255=%s ; B255=%s" r255 g255 b255 scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" # puts "r255: $r255" # puts "g255: $g255" # puts "b255: $b255" eval set r255 $r255 eval set g255 $g255 eval set b255 $b255 set COLOR_hex [format "#%02X%02X%02X" $r255 $g255 $b255] tk_setPalette $COLOR_hex ######################################################################### ## Set text area to slightly brighter color and set 2 search hilite vars ## from current values in r255,g255,b255. ######################################################################### set_text_colors } ## END OF 'getset_palette_color' PROCEDURE ######################################################################## ## 'toggle_side' PROCEDURE ######################################################################## ## ## PURPOSE: To switch the sides of the 'sliders' & 'preview' frames ## ## CALLED BY: .fRtopbar.buttSide button ## ######################################################################## proc toggle_side { } { global LR_sidebar LR_sidetxt if { "$LR_sidebar" == "left" } { set LR_sidebar "right" set LR_sidetxt "left" } else { set LR_sidebar "left" set LR_sidetxt "right" } pack forget .fRmain.scrolly .fRmain.text pack .fRmain.scrolly \ -side $LR_sidebar \ -anchor center \ -fill y \ -expand 0 pack .fRmain.text \ -side $LR_sidetxt \ -anchor center \ -fill both \ -expand 1 } ## END of proc 'toggle_side' ######################################################################## ## 'set_font' PROCEDURE ######################################################################## ## ## PURPOSE: To show the 'select_tkFont.tk' GUI to the user so they ## can select from all fonts known to Tcl-Tk --- ## anti-aliasable and scalable fonts, as well as X-fonts. ## ## CALLED BY: .fRtopbar.buttfont button ## ######################################################################## proc set_font { } { global DIRxpg fontTEMP_text # set TEST_MODE "YES" set TEST_MODE "NO" if { "$TEST_MODE" == "YES" } { puts "Proc: set_font : Changing text font via GUI." } set textAreaFONTparms [ font actual fontTEMP_text ] set newFONTspecs [ exec $DIRxpg/select_tkFont.tk $textAreaFONTparms ] if { "$newFONTspecs" == ""} { return } font delete fontTEMP_text eval font create fontTEMP_text $newFONTspecs .fRmain.text configure -font fontTEMP_text ## WAS: # eval font create fontTEMP $FONTspecs # .fRmain.text configure -font fontTEMP ## FOR TESTING: # font create fontTEMP -family { new century schoolbook } -size 14 \ # -weight bold -slant roman -underline 0 -overstrike 0 # .fRmain.text configure -font fontTEMP if { "$TEST_MODE" == "YES" } { puts "Changed text font to $FONTspecs" puts [ .fRmain.text cget -font ] puts [font actual [ .fRmain.text cget -font ] ] } } ##END of proc 'set_font' ######################################################################## ## 'selectchar2whitespace' PROCEDURE ######################################################################## ## ## PURPOSE: To highlight-select a string (like a filename containing ## special characters like slashes) with a single click --- ## instead of double-click high-lighting ending at special ## characters to the left & right of the clicked-upon ## character --- and instead of a triple-click high-lighting ## the entire line. ## ## I.e. to highlight-select a string with a single click --- ## FROM the first white-space (space or tab) to the left of ## the clicked-upon character --- and TO the first white-space ## to the right of the clicked-upon character. ## ## CALLED BY: .fRmain.text ## ######################################################################## ## NOTE: Currently it takes over 20 statements to lead up to the ## 'tag add sel' statement that does the highlighting-&-selection. ## Hopefully we can find a more compact way to do this. ## ## Unfortunately, there are 'string first' and 'string last' index ## commands, but nothing like 'string left' and 'string right' ## substring commands. (Perhaps we should make two procs called ## 'string_left' and 'string_right' and use them here --- and ## be positioned to use them as utilities elsewhere.) ######################################################################## proc selectchar2whitespace { } { # global ... (not needed?) set charLOC [.fRmain.text index current] ## FOR TESTING: # puts "Set charLOC using '.fRmain.text index current' ..." # puts "charLOC: $charLOC" ###################################################### ## charLOC is an index of the form linenum.colnum. ## We break it apart into a separate linenum & colnum. ###################################################### set DOTindex [string first {.} $charLOC] set LINEnum [string range $charLOC 0 [expr $DOTindex - 1]] set COLnum [string range $charLOC [expr $DOTindex + 1] end] ## FOR TESTING: # puts "Got charLOC at MB3 release ..." # puts "breaking apart charLOC into ..." # puts "DOTindex: $DOTindex" # puts "LINEnum : $LINEnum" # puts "COLnum : $COLnum" ############################################################# ## Put the contents of theentire line that was clicked-on ## in the var LINEsel. ############################################################# set LINEsel [.fRmain.text get ${LINEnum}.0 ${LINEnum}.end] ## Alternative: (?) # set LINEsel [.fRmain.text get "$charLOC linestart" " $charLOC lineend" ] ## FOR TESTING: # puts "Got the 'MB3-tapped' line in var LINEsel ..." # puts "LINEsel: $LINEsel" ############################################################# ## Get the string to the LEFT of the clicked-on character, ## and the length of that string -- in leftSTRING & leftLEN. ############################################################# set LINEleft [string range $LINEsel 0 $COLnum] ## FOR TESTING: # puts "Here is the left part of the line," # puts "from the 'MB3-tapped' character ..." # puts "LINEleft: $LINEleft" ## For now, we simply look for the last space, rather than ## the last whitespace (space or tab character). set LASTindex [string last " " $LINEleft ] if {$LASTindex == -1} { set LASTindex 0 } else { set LASTindex [expr $LASTindex + 1] } ## FOR TESTING: # puts "Here is the 'index' to the last space" # puts "in LINEleft ..." # puts "LASTindex: $LASTindex" set leftSTRING [string range $LINEleft $LASTindex end] ## FOR TESTING: # puts "Here is the part of LINEleft from the space" # puts "to the end of LINEleft ..." # puts "leftSTRING: $leftSTRING" ## We may want to NOT-select&highlight quotes or left-paren on the left. # set leftSTRING [ string trimleft $leftSTRING "'\"(" ] set leftLEN [string length $leftSTRING] ## FOR TESTING: # puts "Here is the length of leftSTRING ..." # puts "leftLEN: $leftLEN" ############################################################# ## Get the string to the RIGHT of the clicked-on character, ## and the length of that string -- in rightSTRING & rightLEN. ############################################################# set LINEright [string range $LINEsel $COLnum end] ## FOR TESTING: # puts "Here is the right part of the line," # puts "from the 'MB3-tapped' character ..." # puts "LINEright: $LINEright" ## For now, we simply look for the first space, rather than ## the first whitespace (space or tab character). set FIRSTindex [string first " " $LINEright ] if {$FIRSTindex == -1} { set FIRSTindex [string length $LINEright] } ## FOR TESTING: # puts "Here is the 'index' to the first space" # puts "in LINEright ..." # puts "FIRSTindex: $FIRSTindex" set rightSTRING [string range $LINEright 0 [expr $FIRSTindex - 1] ] ## FOR TESTING: # puts "Here is the part of LINEright from the beginning" # puts "of LINEright to the first space ..." # puts "rightSTRING: $rightSTRING" ## We may want to NOT-select&highlight quotes or right-paren on the right. # set righttSTRING [ string trimright $rightSTRING "'\")" ] set rightLEN [string length $rightSTRING] ## FOR TESTING: # puts "Here is the length of rightSTRING ..." # puts "rightLEN: $rightLEN" ############################################################# ## Remove previous selections. ############################################################# .fRmain.text tag remove sel 1.0 end ############################################################# ## Make selection using $charLOC, $leftLEN, $rightLEN. ############################################################# .fRmain.text tag add sel \ "$charLOC - [expr $leftLEN - 1] char" \ "$charLOC + $rightLEN char" # "$charLOC - [expr $leftLEN - 2] char" ## FOR TESTING: # puts "Performed 'tag add sel' in the text area ..." # puts "using the variables ..." # puts "charLOC : $charLOC" # puts "leftLEN : $leftLEN" # puts "rightLEN : $rightLEN" } ## END of proc 'selectchar2whitespace' ######################################################################## ## 'toggle_othropts' PROCEDURE ######################################################################## ## ## PURPOSE: To show (or hide) the widgets in the 'fRothropts' frame. ## ## CALLED BY: .fRtopbar.buttOpts button ## ######################################################################## proc toggle_othropts { } { ########################################## #### METHOD: with 'pack forget' & 'pack' ########################################## global OTHRoptsSHOW minWIDTH1 minHEIGHT1 minHEIGHT2 # global MINWIDTH MINHEIGHT if { "$OTHRoptsSHOW" == "NO" } { ## THIS ROUTINE IS DONE WHEN "$OTHRoptsSHOW" == "NO" --- for example, ## 1st time 'toggle_othropts' is executed & odd-numbered times. ## ## This routine does 'show' frame 'fRothropts'. # set winX [winfo x .] # set winY [winfo y .] # set holdWIDTH [winfo width .] # wm geometry . ${holdWIDTH}x${minHEIGHT2}+${winX}+$winY # # wm geometry . ${minWIDTH1}x${minHEIGHT2}+${winX}+$winY # wm minsize . $minWIDTH1 $minHEIGHT2 # wm minsize . $MINWIDTH $minHEIGHT2 # wm minsize . $MINWIDTH $MINHEIGHT pack forget .fRtopbar pack forget .fRsearch pack forget .fRmain pack .fRtopbar \ -side top \ -anchor w \ -fill x \ -expand 0 \ -pady 2 pack .fRsearch \ -side top \ -anchor w \ -fill x \ -expand 0 pack .fRothropts \ -side top \ -anchor w \ -fill x \ -expand 0 pack .fRmain \ -side bottom \ -anchor w \ -fill both \ -expand 1 # -fill x \ # -expand 0 set OTHRoptsSHOW "YES" } else { ## THIS ROUTINE IS DONE WHEN "$OTHRoptsSHOW" == "YES" --- which ## is the 2nd time 'toggle_othropts' is executed & all other ## even-numbered times. ## ## This routine does 'hide' frame 'fRothropts'. # set winX [winfo x .] # set winY [winfo y .] pack forget .fRothropts # set holdWIDTH [winfo width .] # wm geometry . ${holdWIDTH}x${minHEIGHT1}+${winX}+$winY # # wm geometry . ${minWIDTH1}x${minHEIGHT1}+${winX}+$winY # wm minsize . $minWIDTH1 $minHEIGHT1 # wm minsize . $MINWIDTH $minHEIGHT1 # wm minsize . $MINWIDTH $MINHEIGHT set OTHRoptsSHOW "NO" } ## END of if { "$OTHRoptsSHOW" == "NO" } } ## END of proc 'toggle_othropts' ########################################################################### ## 'popup_msg_3opts' PROCEDURE ########################################################################### ## PURPOSE: Report information (a text message) to the user ## and present 3 options. ## CALLED BY: 'readfile2textwidget' proc. (below) ########################################################################### ## To have more control over the formatting of the message (esp. ## words per line), we use this 'toplevel-text' method, ## rather than the 'tk_dialog' method from page 574 of the book ## by Hattie Schroeder & Mike Doyel,'Interactive Web Applications ## with Tcl/Tk', Appendix A "ED, the Tcl Code Editor". ########################################################################### ## For an example of making your own dialog window, see the book by ## Eric Foster-Johnson, 'Graphical Applications with Tcl & Tk', Chapter 7, ## "Dialog Windows". See pgs 247-250 of edition 1. ########################################################################### proc popup_msg_3opts { VARtext } { global feFONT_text feFONT_button feBDwidth_text feBDwidth_button global REPLY_3opts ## Use 'THIShost' and 'env(USER)' in popup wintitle. global THIShost env # bell bell ##################################### ## SETUP 'TOP LEVEL' HELP WINDOW. ##################################### set w .topmsg catch {destroy $w} toplevel $w -class Dialog ## Declare 'transient' if you want no window frame. wm transient $w wm title $w "Reading-File Options, host $THIShost user $env(USER)" wm iconname $w "ReadFilOpts" ###################################### ## To keep the popup in front of other ## windows, incl. the one generated by ## this app, try one of the following. ###################################### # raise .topmsg # raise .topmsg . ## This is said to work with the Gnome metacity wm: # wm group .topmsg . ############################################# ## Put '.topmsg' window near upper-left corner ## of the application '.' window. ############################################# ## Ref: p.140, Chap 4 Menus, "Graphical ## Applications with Tcl & Tk", ## Eric F. Johnson ############################################# ## wm geometry $w 662x646+431+202 ## wm geometry $w +200+300 # wm geometry $w +050+050 ## Get global x,y pos of app. set gx [winfo rootx .] set gy [winfo rooty .] ## If we were to postition at mouse cursor: ## Add local mouse pos. # set mx [expr %x + $gx] # set my [expr %y + $gy] # set gx [expr $gx + 300] # set gy [expr $gy + 120] wm geometry $w +${gx}+${gy} ############################################# ## Set minsize of '.topmsg' window. ############################################# wm minsize $w 200 60 ############################################# ## Make two frames, for text and for buttons. ############################################# frame $w.fRmsg -bd 2 -relief flat frame $w.fRbutts -bd 2 -relief raised pack $w.fRmsg \ $w.fRbutts \ -side top \ -anchor center \ -fill x \ -expand 1 ## DO NOT USE '-expand 1'; if want buttons to stay left. ##################################### ## SETUP TEXT WIDGET. ##################################### text $w.fRmsg.text \ -relief raised \ -borderwidth $feBDwidth_text \ -font fontTEMP_text pack $w.fRmsg.text \ -side top \ -anchor center \ -fill both \ -expand 0 ## $w.text delete 1.0 end $w.fRmsg.text insert end $VARtext $w.fRmsg.text configure -state disabled ############################################ ## SETUP 'More' 'Stop' 'Exit' BUTTON WIDGETS. ############################################ button $w.fRbutts.buttMore \ -text "More" \ -font fontTEMP_button \ -relief raised -borderwidth $feBDwidth_button \ -command "set REPLY_3opts More ; destroy $w " # -command "puts 'More' ; destroy $w ; return " button $w.fRbutts.buttStop \ -text "Stop" \ -font fontTEMP_button \ -relief raised -borderwidth $feBDwidth_button \ -command "set REPLY_3opts Stop ; destroy $w " button $w.fRbutts.buttExit \ -text "Exit" \ -font fontTEMP_button \ -relief raised -borderwidth $feBDwidth_button \ -command "set REPLY_3opts Exit ; destroy $w " pack $w.fRbutts.buttMore \ -side left \ -anchor center \ -fill none \ -expand 1 pack $w.fRbutts.buttStop \ -side left \ -anchor center \ -fill none \ -expand 1 pack $w.fRbutts.buttExit \ -side left \ -anchor center \ -fill none \ -expand 1 ################################################# ## Set VARwidth & VARheight from $VARtext. ## ################################################# ## To get VARheight, ## split at '\n' (newlines) and count 'lines'. ################################################# set VARlist [ split $VARtext "\n" ] ## FOR TESTING: # puts "VARlist: $VARlist" set VARheight [ llength $VARlist ] ## FOR TESTING: # puts "VARheight: $VARheight" $w.fRmsg.text configure -height $VARheight ################################################# ## To get VARwidth, ## loop through the 'lines' getting length ## of each; save max. ################################################# set VARwidth 0 ############################################# ## LOOK AT EACH LINE IN THE LIST. ############################################# foreach line $VARlist { ############################################# ## Get the length of the line. ############################################# set LINEwidth [ string length $line ] if { $LINEwidth > $VARwidth } { set VARwidth $LINEwidth } } ## END OF foreach line $VARlist set VARwidth [ expr $VARwidth + 1 ] $w.fRmsg.text configure -width $VARwidth ## FOR TESTING: # puts "VARwidth: $VARwidth" ######################################################################## ## NOTE: VARwidth works for an adobe-courier fixed-width font used ## for the text widget ... BUT the programmer may need to be ## careful that the contents of VARtext ## are all countable characters by the 'string length' command. ######################################################################## ######################################################################## ## Force a pause for input. (We expect a click on one of the 3 buttoms ## above, which would trigger a 'puts' and a 'destroy $w'.) ######################################################################## raise $w tkwait window $w } ## END OF 'popup_msg_3opts' PROCEDURE ########################################################################### ## 'finalize_textwidget' PROCEDURE ########################################################################### ## PURPOSE: 1) Put tot-lines of text in label '.fRsearch.labLINES'. ## 2) Make the text 'read-only' -- i.e. non-editable. ## CALLED BY: 'readfile2textwidget' proc. (below) ########################################################################### proc finalize_textwidget { } { ###################################################################### ## Get total number of text widget lines, for [possible] display ## in the 'shofil' window, for user's edification. ###################################################################### ## Gets the end of text widget in 'line.col' form by using 'index end'. ## Reference: Page 156 of Eric Johnson book, "Graphical Applications ## with Tcl and Tk". ## Then uses string commands to break this apart at the dot (.). ## We subract 2 from the 'line' figure to get the actual line count. ###################################################################### set LASTline_dot_col [ .fRmain.text index end ] ## FOR TESTING: # puts "LASTline_dot_col: $LASTline_dot_col" set DOTindex [ string first {.} $LASTline_dot_col ] set TOTlines [ string range $LASTline_dot_col 0 [ expr $DOTindex - 1 ] ] set TOTlines [ expr $TOTlines - 2 ] if { $TOTlines < 0 } { set TOTlines 1 } .fRsearch.labLINES configure -text "Lines, of $TOTlines" ## FOR TESTING: # puts "TOTlines: $TOTlines" ######################################################################## ## MAKE THE TEXT 'READ-ONLY' -- I.E. NON-EDITABLE. ######################################################################## .fRmain.text configure -state disabled ## .fRmain.text configure -state normal .fRmain.text configure -cursor xterm } ## END OF 'finalize_textwidget' PROCEDURE ######################################################################## ## 'readfile2textwidget' PROCEDURE ######################################################################## ## ## PURPOSE: To load the contents of $FILEname into the text widget, ## '.fRmain.text'. Uses 'read' to read blocks, several ## thousand bytes at a time. ## ## NOTE: There is NO logic to discover positions of ## linefeed chars and then truncate long lines. ## ## Handles huge files via a More/Stop/Exit dialog prompt. ## ## CALLED BY: final GUI initialization section below ## ######################################################################## proc readfile2textwidget { } { global FILEname REPLY_3opts ######################################################################## ## SETUP for the while-loop to READ input FILE INTO TEXT WIDGET. ######################################################################## .fRmain.text delete 1.0 end set f [open $FILEname] set Bytes2read 1000 set TotBytesRead 0 set TotMegRead 0 set TotBlocksRead 0 set BlockCnt 0 ## Prompt user whether to continue reading at Bytes2read*BlockCnt2Check. ## If Bytes2read=5000 & BlockCnt2Check=200, the product is 1 Meg. ## If Bytes2read=5000 & BlockCnt2Check=800, the product is 4 Meg. # set BlockCnt2Check 200 # set BlockCnt2Check 400 set BlockCnt2Check 800 catch { set BlockCnt2Check "$env(BLOCKCNT2CHECK)" } set REPLY_3opts "" ## FOR TESTING: # set BlockCnt2Check 2 while {![eof $f]} { ## In case text widget is 'disabled', unset it to allow update. .fRmain.text configure -state normal ## NOTE: The 'read' number here should be the same as set ## in the Bytes2read var above. .fRmain.text insert end [read $f 1000] ## Undo the '-state normal' above. ## This 'disabled' statement is also called ## in proc 'finalize_textwidget', which is called ## at the end of loading the text widget, ## as well as one or more times while loading a huge file. ## We want to make sure the text area is disabled at ## essentially all times during loading that area. .fRmain.text configure -state disabled set TotBytesRead [expr $TotBytesRead + $Bytes2read] set TotBlocksRead [expr $TotBlocksRead + 1] set BlockCnt [expr $BlockCnt + 1] set TotMegRead [expr $TotBytesRead / 1000000.0] # set TotMegRead [format "%f" [expr $TotBytesRead / 1000000.0]] ## FOR TESTING: # puts "*************************" # puts "TotBytesRead : $TotBytesRead" # puts "TotBlocksRead : $TotBlocksRead" # puts "BlockCnt : $BlockCnt" # puts "TotMegRead : $TotMegRead" # puts "BlockCnt2Check : $BlockCnt2Check" if { $BlockCnt > $BlockCnt2Check } { ## Double 'BlockCnt2Check' at each read iteration. set BlockCnt2Check [expr $BlockCnt2Check + $BlockCnt2Check] finalize_textwidget popup_msg_3opts "\ $TotMegRead Megabytes have been read from file $FILEname Do you want to read More, Stop, or Exit (Quit,Cancel)?" set BlockCnt 0 ## FOR TESTING: # puts "*************************" # puts "popup_msg_3opts reply: $REPLY_3opts" if {"$REPLY_3opts" == "More"} { continue } if {"$REPLY_3opts" == "Stop"} { finalize_textwidget close $f return } if {"$REPLY_3opts" == "Exit"} { close $f exit } } ## END OF if { $BlockCnt > $BlockCnt2Check } } ## END OF while {![eof $f]} finalize_textwidget close $f if {"$REPLY_3opts" == "More"} { popup_msg "Finished reading file. Total Megabytes: $TotMegRead" } } ## END of proc 'readfile2textwidget' ######################################################################## ## 'getfile2textwidget' PROCEDURE ######################################################################## ## ## PURPOSE: To load the contents of $FILEname into the text widget, ## '.fRmain.text'. Uses 'gets' to read line-by-line, i.e. ## to each newline character. Truncates long lines. ## ## Handles huge files via a More/Stop/Exit dialog prompt. ## ## CALLED BY: final GUI initialization section below ## ## (an alternative to proc 'readfile2textwidget') ######################################################################## proc getfile2textwidget { } { global FILEname REPLY_3opts ######################################################################## ## Set up for READing FILE INTO TEXT WIDGET. ######################################################################## .fRmain.text delete 1.0 end set f [open $FILEname] ## FOR TESTING: # puts "*************************" # puts "Starting proc getfile2textwidget." # puts "Opened file $FILEname" set TotBytesRead 0 set line "" set maxLen 1000 ## Set a size parameter used to determine when to ## prompt user whether to continue reading, at about 4 Meg. set TotBytes2Check 4000000 catch { set TotBytes2Check "$env(TOTBYTES2CHECK)" } ## FOR TESTING More/Stop/Exit prompt: # set TotBytes2Check 4000 ## Var to hold 'More', 'Stop', or 'Exit'. set REPLY_3opts "" ## START OF WHILE-LOOP for the 'gets' file-READING. ## The while-test below is equivalent to 'while {![eof $f]}'. while {[eof $f] == 0} { ## In case text widget is 'disabled', unset it to allow update. .fRmain.text configure -state normal ## GET the next line (up to a line feed) --- and its length. set lineLen [gets $f line] ## If line too long, truncate. if { $lineLen > $maxLen } { set line "[string range $line 0 $maxLen]...xpg:truncated-this-line-in-this-window" # set lineLen $maxLen } ## ADD the line (truncated if long) to the text widget, with a linefeed. .fRmain.text insert end "$line\n" ## Undo '-state normal', set above. ## This 'disabled' statement ## is also called in proc 'finalize_textwidget', ## which is called at the end of loading the text ## widget, as well as one or more times while loading ## a huge file. .fRmain.text configure -state disabled set TotBytesRead [expr $TotBytesRead + $lineLen] ## FOR TESTING: # puts "*************************" # puts "TotBytesRead : $TotBytesRead" # puts "TotBytes2Check : $TotBytes2Check" # puts "Cur. lineLen : $lineLen" # puts "line : $line" if { $TotBytesRead > $TotBytes2Check } { ## Double 'TotBytes2Check' at each prompt. set TotBytes2Check [expr $TotBytes2Check + $TotBytes2Check] finalize_textwidget set TotMegRead [expr $TotBytesRead / 1000000.0] popup_msg_3opts "\ $TotMegRead Megabytes have been read from file $FILEname Do you want to read More, Stop, or Exit (Quit,Cancel)?" ## FOR TESTING: # puts "*************************" # puts "popup_msg_3opts reply: $REPLY_3opts" if {"$REPLY_3opts" == "More"} { continue } if {"$REPLY_3opts" == "Stop"} { finalize_textwidget close $f return } if {"$REPLY_3opts" == "Exit"} { close $f exit } } ## END OF if { $TotBytesRead > $TotBytes2Check } } ## END OF while {![eof $f]} finalize_textwidget close $f if {"$REPLY_3opts" == "More"} { set TotMegRead [expr $TotBytesRead / 1000000.0] popup_msg "Finished reading file. Total Megabytes: $TotMegRead" } } ## END of proc 'getfile2textwidget' ######################################################################### ######################################################################### #### ADDITIONAL GUI INITIALIZATION SECTION. (with now-defined procs) ######################################################################### ######################################################################### ######################################################################### ## Set window colors according to r255,g255,b255, which were initialized ## near the top of this script where various widget colors were set. ######################################################################### set_text_colors ######################################################################### ## Force the text window to popup before a '.topmsg' window that ## prompts the user with More,Stop,Exit buttons --- if the input ## file is huge. The '.topmsg' window comes from execution of ## the following call to a proc to load the text widget. ######################################################################### update ######################################################################### ## Read $FILEname into '.fRmain.text'. ######################################################################### ## 'getfile2textwidget' is safer to use because it uses 'gets' to read ## one line (i.e. up to a newline character) at a time, and if the line ## is very long (more than about 1k bytes or whatever is set in the ## var maxLen), the line is truncated. This can avoid problems with ## a crash when using the horizontal scroll bar. ######################################################################### ## 'readfile2textwidget' WAS used, but it can cause crashes --- if ## the user horizontally-scrolls the window at long lines. ## It uses 'read' to read blocks of several thousand bytes at a time, ## with no (complex) code to check for distance between newline chars ## and hence no truncation of long lines. ######################################################################### ## I did not have troubles with crashes when using 'readfile2textwidget' ## on Ubuntu 9.10, but on Ubuntu 10.10 some lines more than about ## 1,075 bytes long along with use of the horizontal scroll bar ## caused crashes --- with briefly seen 'AppArmor' and 'format' messages ## as the X-server crashed and a login prompt re-appeared. I could ## not find the complete messages in log files, like 'Xorg.0.log.old'. ######################################################################### ## In the unlikely case where use of the 'getfile' proc causes a problem, ## the user can comment out 'getfile2textwidget' and de-comment ## 'readfile2textwidget' --- to give the 'readfile' proc a try on files with ## long lines, including big binary files, like large compiled executables. ######################################################################### ## OLD, RETIRED: ## readfile2textwidget ######################## getfile2textwidget