[D. McC]: I've been working on some "wee" apps for some time now. The most developed one is WISH [Supernotepad] 1.2, a simple text and HTML editor . In modified or unmodified form, it might serve the purpose of a "weeEdit." The program script, uncompressed, takes up slightly less than 100 KB. (The WISH acronym, originally derived from the wish interpreter, now stands for Wee Integrated Suite of Helpers, although the "integrated" aspect still needs some work.) [Larry Smith] The Wee project (aka the "We" project from [Eolas]) has not been static, but I have not had much time to work on it. I have integrated supernotepad, a browser (plume), a chat program, draw and paint programs, a notepad, two calculators - a four-banger and the IQ-15 from [HP Calculator Simulations], and the tk# spreadsheet. The window manager is much improved, but there are a few more bugs to squash in order to get to a stable release. [Eolas]'s Mike Doyle ([MDD]) has been funding this. I'm a home computer user and hobbyist who developed the various functions of WISH Supernotepad because I, or members of my family, needed or wanted them. It was designed to run on Linux, but no doubt it could be made to work on other operating systems (with a bit of assistance from people who know more than I do about those systems). The code is intended to be comprehensible, well organized, and easily modified. Here are some things it can do; let's see if anyone wants to compare them with things they think a "weeEdit" should or shouldn't do. * Basic text editing functions: New, Open, Save, Save As, Cut, Copy, Paste, Delete, Undo and Redo (unlimited, but stack is emptied when file is saved), Select All, Insert File, Find, Replace. A list of recently used files is maintained, and displayed when the "Open Recent" or "Insert Recent" command is invoked. * Not-so-basic text editing functions: Single-click insertion of special characters; simultaneous global search and replace of multiple expressions; word count; insertion of time and date. * Printing of monospaced text with word wrap (on Unix-type systems only, so far), using the X Printing Panel (XPP) if available, otherwise lpr. * HTML editing functions: New HTML; Convert (plain text) to HTML; hexadecimal color code selection by color name or RGB content (using scale widgets that instantly cause the displayed color to change); toplevel windows for quick insertion of codes for Heading, Font, Anchor, Link, Image, List, and Table (creation, continuation, and data entry); single-keystroke (or single-key-combination, or single-click) insertion of codes for Paragraph, Line Break, Italics, Bold, and Center. * Tcl/Tk code editing functions: New Script; Run Selected Code; automatic indentation; single key combinations for paired braces, brackets, etc., plus Next Braces and Leave Braces. ---- [Zipguy] 2014-01-24 - You can find out my email address by clicking on [Zipguy]. In case you just wondered what it looked like, I just added a screenshot of this program called weeEdit. This is what it looks like: [http://www.geocities.ws/thezipguy/tcl/misc/weeEdit_01.png] It only had one problem with Windows 7, which was at line number 2762, which was in the special characters section. I commented it out, and it ran just fine. and here's the program. ---- ====== #!/usr/bin/env wish # WISH Supernotepad 2006 # (the ninth version of WISH Supernotepad) # by David McClamrock # based on Tk NotePad 0.5.0 by Joseph Acosta # and "textedit.tcl" by Eric Foster-Johnson # with help from Eric Foster-Johnson, # Graphical Applications with Tcl & Tk (2nd edition) # and Christopher Nelson, Tcl/Tk Programmer's Reference # Copyright ?2001-2006 David H. McClamrock # Freely available under Maximum Use License for Everyone # You should have received a copy of this license with this program. # If you didn't, e-mail the author to get one. ### INITIALIZATION ### # WISH applications require at least Tcl and Tk 8.4: set version "2006" set packtype regular set tclo [package require Tcl] set tko [package require Tk] if {$tclo < 8.4 || $tko < 8.4} { tk_messageBox -message "WISH Supernotepad requires at least version 8.4\ of Tcl and Tk" -type ok exit } # Setup for Starkit or regular filesystem: if {$packtype eq "starkit"} { package provide app-supernotepad $version set docdir [file join $starkit::topdir doc] set libdir [file join $starkit::topdir lib] } else { # Default settings: set docdir /usr/local/doc/wishes set libdir /usr/local/lib/wishes # May be altered by root's config file: set hardfig [file join / root wishes] if {[file isdirectory $hardfig]} { set locfig [file join $hardfig comdirs.tcl] if {[file readable $locfig]} { source $locfig } } } # One or more features may work only on unix platforms (including Linux), # so identify the platform: set platform [split [array get tcl_platform] ] if {[lsearch $platform unix] != -1} { set platform unix } # Make directory for configuration, etc., if it isn't there already: set wishdir [file join $env(HOME) wishes] if {[file isdirectory $wishdir] == 0} { file mkdir $wishdir } # Get lists of recently opened or inserted files, # and recently cut or copied blocks of text: set rece [file join $wishdir superece.tcl] set superpaste [file join $wishdir superpaste.tcl] if {[file readable $rece]} { source $rece } else { set recentlist [list] set reclim 1000 } if {[file readable $superpaste]} { source $superpaste } else { set pastelist [list] set pastelim 1000 } # Set some defaults (may be changed by configuration file--see below): set currentfile "" ; # No name for open file yet set addfile "" ; # No name for file to add, either set curprint "" ; # Nor a name for file to print set backfile "" ; # And no name for backup file set openins Open ; # By default, open rather than insert file set openew 0 ; # At first, don't open file in new window set converto 0 ; # Don't convert existing text to HTML unless told to do it set tabno 0 ; # No tabs have yet been automatically inserted set dumpfile "" ; # Don't trash old name of file that hasn't yet been renamed set filetosave none ; # Don't save a file when you haven't done anything set texwid 80 ; # Width of text widget set formawid 80 ; # Width of text formatted with newlines set texhi 32 ; # Height of text widget set wordwrap word ; # Word wrap on by default set fonto "lucidatypewriter" ; # Default font set siz 14 ; # Font size set helpfont "times" ; # User Help Guide font set helpsiz 14 ; # User Help Guide font size set fontaine [list $fonto $siz] ; # Default font with size set helpall [list $helpfont $helpsiz] ; # User Help Guide font with size set reunito 0 ; # Replace needless newlines (if desired) with spaces set parsep 1 ; # Keep paragraphs separate when omitting needless newlines set expert 0 ; # Don't do expert search with regular expressions set headsize 1 ; # size of HTML heading set html_fontsize 0 ; # Default regular HTML font size set listtype 1 ; # Use 1-2-3 numbering in HTML list set autotab 1 ; # Auto-tab to write Tcl code set palmdir "" ; # Directory to search for Palm Doc files set t .tx ; # Global variable for text widget set linkup 0 ; # Don't display Link-Text unless told to set linklist [list] ; # Nothing yet in list of Link-Text links # Read configuration file, if there is one: set superfig [file join $wishdir superfig.tcl] if {[file readable $superfig]} { source $superfig } # Use WISH Color Picker Plus for color configuration # (It sets color variables with default values; # values may then be changed by configuration files): # WISH Color Picker Plus (wishcolorplus.tcl) # Megawidget and related code for color configuration # in Tcl/Tk applications # by David McClamrock # Copyright ?2002-2005 David H. McClamrock # (Pre-2005 versions were incorporated in WISH Supernotepad) # Freely available under Maximum Use License for Everyone # You should have received a copy of this license with this file. # If you didn't, e-mail the author to get one. ### List color names and values: ### set colorlist [list \ {255 250 250 snow} \ {248 248 255 GhostWhite} \ {245 245 245 WhiteSmoke} \ {220 220 220 gainsboro} \ {255 250 240 FloralWhite} \ {253 245 230 OldLace} \ {250 240 230 linen} \ {250 235 215 AntiqueWhite} \ {255 239 213 PapayaWhip} \ {255 235 205 BlanchedAlmond} \ {255 228 196 bisque} \ {255 218 185 PeachPuff} \ {255 222 173 NavajoWhite} \ {255 228 181 moccasin} \ {255 248 220 cornsilk} \ {255 255 240 ivory} \ {255 250 205 LemonChiffon} \ {255 245 238 seashell} \ {240 255 240 honeydew} \ {245 255 250 MintCream} \ {240 255 255 azure} \ {240 248 255 AliceBlue} \ {230 230 250 lavender} \ {255 240 245 LavenderBlush} \ {255 228 225 MistyRose} \ {255 255 255 white} \ {0 0 0 black} \ {47 79 79 DarkSlateGray} \ {105 105 105 DimGray} \ {112 128 144 SlateGray} \ {119 136 153 LightSlateGray} \ {190 190 190 gray} \ {211 211 211 LightGray} \ {25 25 112 MidnightBlue} \ {0 0 128 NavyBlue} \ {100 149 237 CornflowerBlue} \ {72 61 139 DarkSlateBlue} \ {106 90 205 SlateBlue} \ {123 104 238 MediumSlateBlue} \ {132 112 255 LightSlateBlue} \ {0 0 205 MediumBlue} \ {65 105 225 RoyalBlue} \ {0 0 255 blue} \ {30 144 255 DodgerBlue} \ {0 191 255 DeepSkyBlue} \ {135 206 235 SkyBlue} \ {135 206 250 LightSkyBlue} \ {70 130 180 SteelBlue} \ {176 196 222 LightSteelBlue} \ {173 216 230 LightBlue} \ {176 224 230 PowderBlue} \ {175 238 238 PaleTurquoise} \ {0 206 209 DarkTurquoise} \ {72 209 204 MediumTurquoise} \ {64 224 208 turquoise} \ {0 255 255 cyan} \ {224 255 255 LightCyan} \ {95 158 160 CadetBlue} \ {102 205 170 MediumAquamarine} \ {127 255 212 aquamarine} \ {0 100 0 DarkGreen} \ {85 107 47 DarkOliveGreen} \ {143 188 143 DarkSeaGreen} \ {46 139 87 SeaGreen} \ {60 179 113 MediumSeaGreen} \ {32 178 170 LightSeaGreen} \ {152 251 152 PaleGreen} \ {0 255 127 SpringGreen} \ {124 252 0 LawnGreen} \ {0 255 0 green} \ {127 255 0 chartreuse} \ {0 250 154 MediumSpringGreen} \ {173 255 47 GreenYellow} \ {50 205 50 LimeGreen} \ {154 205 50 YellowGreen} \ {34 139 34 ForestGreen} \ {107 142 35 OliveDrab} \ {189 183 107 DarkKhaki} \ {240 230 140 khaki} \ {238 232 170 PaleGoldenrod} \ {250 250 210 LightGoldenrodYellow} \ {255 255 224 LightYellow} \ {255 255 0 yellow} \ {255 215 0 gold} \ {238 221 130 LightGoldenrod} \ {218 165 32 goldenrod} \ {184 134 11 DarkGoldenrod} \ {188 143 143 RosyBrown} \ {205 92 92 IndianRed} \ {139 69 19 SaddleBrown} \ {160 82 45 sienna} \ {205 133 63 peru} \ {222 184 135 burlywood} \ {245 245 220 beige} \ {245 222 179 wheat} \ {244 164 96 SandyBrown} \ {210 180 140 tan} \ {210 105 30 chocolate} \ {178 34 34 firebrick} \ {165 42 42 brown} \ {233 150 122 DarkSalmon} \ {250 128 114 salmon} \ {255 160 122 LightSalmon} \ {255 165 0 orange} \ {255 140 0 DarkOrange} \ {255 127 80 coral} \ {240 128 128 LightCoral} \ {255 99 71 tomato} \ {255 69 0 OrangeRed} \ {255 0 0 red} \ {255 105 180 HotPink} \ {255 20 147 DeepPink} \ {255 192 203 pink} \ {255 182 193 LightPink} \ {219 112 147 PaleVioletRed} \ {176 48 96 maroon} \ {199 21 133 MediumVioletRed} \ {208 32 144 VioletRed} \ {255 0 255 magenta} \ {238 130 238 violet} \ {221 160 221 plum} \ {218 112 214 orchid} \ {186 85 211 MediumOrchid} \ {153 50 204 DarkOrchid} \ {148 0 211 DarkViolet} \ {138 43 226 BlueViolet} \ {160 32 240 purple} \ {147 112 219 MediumPurple} \ {216 191 216 thistle} \ {255 250 250 snow1} \ {238 233 233 snow2} \ {205 201 201 snow3} \ {139 137 137 snow4} \ {255 245 238 seashell1} \ {238 229 222 seashell2} \ {205 197 191 seashell3} \ {139 134 130 seashell4} \ {255 239 219 AntiqueWhite1} \ {238 223 204 AntiqueWhite2} \ {205 192 176 AntiqueWhite3} \ {139 131 120 AntiqueWhite4} \ {255 228 196 bisque1} \ {238 213 183 bisque2} \ {205 183 158 bisque3} \ {139 125 107 bisque4} \ {255 218 185 PeachPuff1} \ {238 203 173 PeachPuff2} \ {205 175 149 PeachPuff3} \ {139 119 101 PeachPuff4} \ {255 222 173 NavajoWhite1} \ {238 207 161 NavajoWhite2} \ {205 179 139 NavajoWhite3} \ {139 121 94 NavajoWhite4} \ {255 250 205 LemonChiffon1} \ {238 233 191 LemonChiffon2} \ {205 201 165 LemonChiffon3} \ {139 137 112 LemonChiffon4} \ {255 248 220 cornsilk1} \ {238 232 205 cornsilk2} \ {205 200 177 cornsilk3} \ {139 136 120 cornsilk4} \ {255 255 240 ivory1} \ {238 238 224 ivory2} \ {205 205 193 ivory3} \ {139 139 131 ivory4} \ {240 255 240 honeydew1} \ {224 238 224 honeydew2} \ {193 205 193 honeydew3} \ {131 139 131 honeydew4} \ {255 240 245 LavenderBlush1} \ {238 224 229 LavenderBlush2} \ {205 193 197 LavenderBlush3} \ {139 131 134 LavenderBlush4} \ {255 228 225 MistyRose1} \ {238 213 210 MistyRose2} \ {205 183 181 MistyRose3} \ {139 125 123 MistyRose4} \ {240 255 255 azure1} \ {224 238 238 azure2} \ {193 205 205 azure3} \ {131 139 139 azure4} \ {131 111 255 SlateBlue1} \ {122 103 238 SlateBlue2} \ {105 89 205 SlateBlue3} \ {71 60 139 SlateBlue4} \ {72 118 255 RoyalBlue1} \ {67 110 238 RoyalBlue2} \ {58 95 205 RoyalBlue3} \ {39 64 139 RoyalBlue4} \ {0 0 255 blue1} \ {0 0 238 blue2} \ {0 0 205 blue3} \ {0 0 139 blue4} \ {30 144 255 DodgerBlue1} \ {28 134 238 DodgerBlue2} \ {24 116 205 DodgerBlue3} \ {16 78 139 DodgerBlue4} \ {99 184 255 SteelBlue1} \ {92 172 238 SteelBlue2} \ {79 148 205 SteelBlue3} \ {54 100 139 SteelBlue4} \ {0 191 255 DeepSkyBlue1} \ {0 178 238 DeepSkyBlue2} \ {0 154 205 DeepSkyBlue3} \ {0 104 139 DeepSkyBlue4} \ {135 206 255 SkyBlue1} \ {126 192 238 SkyBlue2} \ {108 166 205 SkyBlue3} \ {74 112 139 SkyBlue4} \ {176 226 255 LightSkyBlue1} \ {164 211 238 LightSkyBlue2} \ {141 182 205 LightSkyBlue3} \ {96 123 139 LightSkyBlue4} \ {198 226 255 SlateGray1} \ {185 211 238 SlateGray2} \ {159 182 205 SlateGray3} \ {108 123 139 SlateGray4} \ {202 225 255 LightSteelBlue1} \ {188 210 238 LightSteelBlue2} \ {162 181 205 LightSteelBlue3} \ {110 123 139 LightSteelBlue4} \ {191 239 255 LightBlue1} \ {178 223 238 LightBlue2} \ {154 192 205 LightBlue3} \ {104 131 139 LightBlue4} \ {224 255 255 LightCyan1} \ {209 238 238 LightCyan2} \ {180 205 205 LightCyan3} \ {122 139 139 LightCyan4} \ {187 255 255 PaleTurquoise1} \ {174 238 238 PaleTurquoise2} \ {150 205 205 PaleTurquoise3} \ {102 139 139 PaleTurquoise4} \ {152 245 255 CadetBlue1} \ {142 229 238 CadetBlue2} \ {122 197 205 CadetBlue3} \ {83 134 139 CadetBlue4} \ {0 245 255 turquoise1} \ {0 229 238 turquoise2} \ {0 197 205 turquoise3} \ {0 134 139 turquoise4} \ {0 255 255 cyan1} \ {0 238 238 cyan2} \ {0 205 205 cyan3} \ {0 139 139 cyan4} \ {151 255 255 DarkSlateGray1} \ {141 238 238 DarkSlateGray2} \ {121 205 205 DarkSlateGray3} \ {82 139 139 DarkSlateGray4} \ {127 255 212 aquamarine1} \ {118 238 198 aquamarine2} \ {102 205 170 aquamarine3} \ {69 139 116 aquamarine4} \ {193 255 193 DarkSeaGreen1} \ {180 238 180 DarkSeaGreen2} \ {155 205 155 DarkSeaGreen3} \ {105 139 105 DarkSeaGreen4} \ {84 255 159 SeaGreen1} \ {78 238 148 SeaGreen2} \ {67 205 128 SeaGreen3} \ {46 139 87 SeaGreen4} \ {154 255 154 PaleGreen1} \ {144 238 144 PaleGreen2} \ {124 205 124 PaleGreen3} \ {84 139 84 PaleGreen4} \ {0 255 127 SpringGreen1} \ {0 238 118 SpringGreen2} \ {0 205 102 SpringGreen3} \ {0 139 69 SpringGreen4} \ {0 255 0 green1} \ {0 238 0 green2} \ {0 205 0 green3} \ {0 139 0 green4} \ {127 255 0 chartreuse1} \ {118 238 0 chartreuse2} \ {102 205 0 chartreuse3} \ {69 139 0 chartreuse4} \ {192 255 62 OliveDrab1} \ {179 238 58 OliveDrab2} \ {154 205 50 OliveDrab3} \ {105 139 34 OliveDrab4} \ {202 255 112 DarkOliveGreen1} \ {188 238 104 DarkOliveGreen2} \ {162 205 90 DarkOliveGreen3} \ {110 139 61 DarkOliveGreen4} \ {255 246 143 khaki1} \ {238 230 133 khaki2} \ {205 198 115 khaki3} \ {139 134 78 khaki4} \ {255 236 139 LightGoldenrod1} \ {238 220 130 LightGoldenrod2} \ {205 190 112 LightGoldenrod3} \ {139 129 76 LightGoldenrod4} \ {255 255 224 LightYellow1} \ {238 238 209 LightYellow2} \ {205 205 180 LightYellow3} \ {139 139 122 LightYellow4} \ {255 255 0 yellow1} \ {238 238 0 yellow2} \ {205 205 0 yellow3} \ {139 139 0 yellow4} \ {255 215 0 gold1} \ {238 201 0 gold2} \ {205 173 0 gold3} \ {139 117 0 gold4} \ {255 193 37 goldenrod1} \ {238 180 34 goldenrod2} \ {205 155 29 goldenrod3} \ {139 105 20 goldenrod4} \ {255 185 15 DarkGoldenrod1} \ {238 173 14 DarkGoldenrod2} \ {205 149 12 DarkGoldenrod3} \ {139 101 8 DarkGoldenrod4} \ {255 193 193 RosyBrown1} \ {238 180 180 RosyBrown2} \ {205 155 155 RosyBrown3} \ {139 105 105 RosyBrown4} \ {255 106 106 IndianRed1} \ {238 99 99 IndianRed2} \ {205 85 85 IndianRed3} \ {139 58 58 IndianRed4} \ {255 130 71 sienna1} \ {238 121 66 sienna2} \ {205 104 57 sienna3} \ {139 71 38 sienna4} \ {255 211 155 burlywood1} \ {238 197 145 burlywood2} \ {205 170 125 burlywood3} \ {139 115 85 burlywood4} \ {255 231 186 wheat1} \ {238 216 174 wheat2} \ {205 186 150 wheat3} \ {139 126 102 wheat4} \ {255 165 79 tan1} \ {238 154 73 tan2} \ {205 133 63 tan3} \ {139 90 43 tan4} \ {255 127 36 chocolate1} \ {238 118 33 chocolate2} \ {205 102 29 chocolate3} \ {139 69 19 chocolate4} \ {255 48 48 firebrick1} \ {238 44 44 firebrick2} \ {205 38 38 firebrick3} \ {139 26 26 firebrick4} \ {255 64 64 brown1} \ {238 59 59 brown2} \ {205 51 51 brown3} \ {139 35 35 brown4} \ {255 140 105 salmon1} \ {238 130 98 salmon2} \ {205 112 84 salmon3} \ {139 76 57 salmon4} \ {255 160 122 LightSalmon1} \ {238 149 114 LightSalmon2} \ {205 129 98 LightSalmon3} \ {139 87 66 LightSalmon4} \ {255 165 0 orange1} \ {238 154 0 orange2} \ {205 133 0 orange3} \ {139 90 0 orange4} \ {255 127 0 DarkOrange1} \ {238 118 0 DarkOrange2} \ {205 102 0 DarkOrange3} \ {139 69 0 DarkOrange4} \ {255 114 86 coral1} \ {238 106 80 coral2} \ {205 91 69 coral3} \ {139 62 47 coral4} \ {255 99 71 tomato1} \ {238 92 66 tomato2} \ {205 79 57 tomato3} \ {139 54 38 tomato4} \ {255 69 0 OrangeRed1} \ {238 64 0 OrangeRed2} \ {205 55 0 OrangeRed3} \ {139 37 0 OrangeRed4} \ {255 0 0 red1} \ {238 0 0 red2} \ {205 0 0 red3} \ {139 0 0 red4} \ {255 20 147 DeepPink1} \ {238 18 137 DeepPink2} \ {205 16 118 DeepPink3} \ {139 10 80 DeepPink4} \ {255 110 180 HotPink1} \ {238 106 167 HotPink2} \ {205 96 144 HotPink3} \ {139 58 98 HotPink4} \ {255 181 197 pink1} \ {238 169 184 pink2} \ {205 145 158 pink3} \ {139 99 108 pink4} \ {255 174 185 LightPink1} \ {238 162 173 LightPink2} \ {205 140 149 LightPink3} \ {139 95 101 LightPink4} \ {255 130 171 PaleVioletRed1} \ {238 121 159 PaleVioletRed2} \ {205 104 137 PaleVioletRed3} \ {139 71 93 PaleVioletRed4} \ {255 52 179 maroon1} \ {238 48 167 maroon2} \ {205 41 144 maroon3} \ {139 28 98 maroon4} \ {255 62 150 VioletRed1} \ {238 58 140 VioletRed2} \ {205 50 120 VioletRed3} \ {139 34 82 VioletRed4} \ {255 0 255 magenta1} \ {238 0 238 magenta2} \ {205 0 205 magenta3} \ {139 0 139 magenta4} \ {255 131 250 orchid1} \ {238 122 233 orchid2} \ {205 105 201 orchid3} \ {139 71 137 orchid4} \ {255 187 255 plum1} \ {238 174 238 plum2} \ {205 150 205 plum3} \ {139 102 139 plum4} \ {224 102 255 MediumOrchid1} \ {209 95 238 MediumOrchid2} \ {180 82 205 MediumOrchid3} \ {122 55 139 MediumOrchid4} \ {191 62 255 DarkOrchid1} \ {178 58 238 DarkOrchid2} \ {154 50 205 DarkOrchid3} \ {104 34 139 DarkOrchid4} \ {155 48 255 purple1} \ {145 44 238 purple2} \ {125 38 205 purple3} \ {85 26 139 purple4} \ {171 130 255 MediumPurple1} \ {159 121 238 MediumPurple2} \ {137 104 205 MediumPurple3} \ {93 71 139 MediumPurple4} \ {255 225 255 thistle1} \ {238 210 238 thistle2} \ {205 181 205 thistle3} \ {139 123 139 thistle4} \ {169 169 169 DarkGray} \ {0 0 139 DarkBlue} \ {0 139 139 DarkCyan} \ {139 0 139 DarkMagenta} \ {139 0 0 DarkRed} \ {144 238 144 LightGreen}] set colorlist [lsort -dictionary -index end $colorlist] ### Initialize directories and settings: ### # Where program listings and configuration files go: set wishdir [file join $env(HOME) .wishes] set oldwishdir [file join $env(HOME) wishes] if {[file isdirectory $wishdir] == 0} { if {[file isdirectory $oldwishdir]} { file link $wishdir $oldwishdir set wishdir $oldwishdir } else { file mkdir $wishdir } } # Where color schemes come from: set schemedir [file join $wishdir colorschemes] set sampledir [file join $libdir colorschemes] ; # App sets variable "libdir" if {[file isdirectory $schemedir] == 0} { catch {file copy $sampledir $schemedir} } # Default color settings for WISH applications # (may be changed by configuration files) set winback bisque ; # Window background set winfore black ; # Window foreground set selback cyan ; # Selection background set selfore black ; # Selection foreground set buttback bisque ; # Regular button background set buttfore black ; # Regular button foreground set miniback "#FFD0A0" ; # Mini-toolbar button background set minifore black ; # Mini-toolbar button foreground set listback "#FFFFF0" ; # Listbox background set listfore black ; # Listbox foreground set textback white ; # Text widget background set textfore black ; # Text widget foreground set inacback "#40E4FF" ; # Inactive selection background set linktex blue ; # Link text color set entback "#FFFFF0" ; # Entry widget background set entfore black ; # Entry widget foreground set headback "#FFC080" ; # Emphasized label background set headfore black ; # Emphasized label foreground set lightback "#FFF0E4" ; # Light label background set lightfore black ; # Light label foreground # Selection color for checkbuttons and radiobuttons is # different in Tk 8.5 than in 8.4: set newsel white ; # Tk 8.5 set oldsel blue ; # Tk 8.4 set tko [package require Tk] if {$tko > 8.4} { set regradio $newsel } else { set regradio $oldsel } set whatbutt "" ; # Nothing selected to configure yet tk_setPalette background $winback foreground $winfore \ selectBackground $selback selectForeground $selfore # Lists of widgets to configure # (applications should add their own widgets # after sourcing wishcolorplus.tcl): set buttlist [list .colo.pickapply .colo.schemapply \ .colo.schemedel .colo.ok .colo.close] ; # Buttons set minilist [list .colo.schemename] ; # Use this to show mini-toolbar color set lublist [list .colo.list .colo.schemelist] ; # Listboxes set texlist [list .colo.tx] ; # Text widgets set entlist [list .colo.ent] ; # Entry widgets set regradiolist [list] ; # No regular radiobuttons or checkbuttons here set spinlist [list] ; # Nor spinboxes # Alternating radiobuttons: set headlist [list .colo.winfad .colo.selfad \ .colo.buttfad .colo.minifad .colo.listfad .colo.textfad \ .colo.linkup .colo.entfad .colo.headfad .colo.lightfad ] set lightlist [list .colo.winbad .colo.selbad \ .colo.buttbad .colo.minibad .colo.listbad .colo.textbad \ .colo.inacbad .colo.entbad .colo.headbad .colo.lightbad] ### Procedure for setting up color selection box ### # RGB Color-setting Scale # from Graphical Applications with Tcl and Tk, 2nd edition, Chapter 3 # by Eric Foster-Johnson # modified by David McClamrock # Thanks to Ulrich Sch?? for suggesting that I add color names, # and for contributing some code! proc wishcolorplus {} { # Set variables for red, green, blue, color selected, # and hexadecimal code color; set background # (number 128 will be midpoint of color scale): global red green blue color hex colorlist showname appcolo toplevel .colo wm title .colo "WISH Color Picker Plus" tk_setPalette background $::winback foreground $::winfore \ selectBackground $::selback selectForeground $::selfore set red 255 set green 204 set blue 153 set color "" set showname nothing set hex black grid [label .colo.pick -text "Right-click or double left-click\ color name (or move sliders)" -pady 4 -background $::lightback \ -foreground $::lightfore] \ -row 0 -column 0 -columnspan 3 -sticky news # Sliding scale to change the amount of red: set scaleng 200 ; # Length of scales set scalwid 12 ; # Width of scales set slidleng 24 ; # Length of sliders grid [label .colo.reddo -text "Red : "] \ -row 1 -column 0 -sticky news grid [scale .colo.red -from 0 -to 255 -orient horizontal \ -length $scaleng -width $scalwid -sliderlength $slidleng \ -variable red -activebackground red -tickinterval 64 \ -command "modify_color red"] \ -row 1 -column 1 -sticky news # Same for green and blue: grid [label .colo.greeno -text "Green : "] \ -row 2 -column 0 -sticky news grid [scale .colo.green -from 0 -to 255 -orient horizontal \ -length $scaleng -width $scalwid -sliderlength $slidleng \ -variable green -activebackground green -tickinterval 64 \ -command "modify_color green"] \ -row 2 -column 1 -sticky news grid [label .colo.bluey -text "Blue : "] \ -row 3 -column 0 -sticky news grid [scale .colo.blue -from 0 -to 255 -orient horizontal \ -length $scaleng -width $scalwid -sliderlength $slidleng \ -variable blue -activebackground blue -tickinterval 64 \ -command "modify_color blue"] \ -row 3 -column 1 -sticky news foreach scala [list .colo.red .colo.green .colo.blue] { bind $scala { catch {.colo.list selection clear 0 end} } } # Scrolling listbox for color names: frame .colo.lib listbox .colo.list -bg "#FFFFF0" -width 20 scrollbar .colo.rolly -width 12 -command ".colo.list yview" .colo.list configure -yscrollcommand ".colo.rolly set" pack .colo.list .colo.rolly -in .colo.lib \ -side left -expand 1 -fill both grid .colo.lib -row 1 -column 2 -rowspan 6 -sticky news foreach couleur $colorlist { .colo.list insert end [lindex $couleur end] } bind .colo.list { set item [.colo.list curselection] set showname [.colo.list get $item] pickname $item } bind .colo.list { .colo.list selection clear 0 end set clixel %y set clickline [.colo.list nearest $clixel] .colo.list selection set $clickline $clickline set item [.colo.list curselection] set showname [.colo.list get $item] pickname $item } # Labeled button to show the color selected: grid [label .colo.pico -text "PICK: "] -row 4 -column 0 -sticky news grid [button .colo.color -textvariable color -border 4 -pady 4] \ -row 4 -column 1 -sticky news .colo.color configure -bg $::headback -fg $::headfore -command { $whatbutt configure -text $color after 10 {colorgrip $whatbutt} } # Color schemes: grid [button .colo.schemename -bg $::miniback -fg $::minifore \ -relief groove -pady 2 -border 3 -text "Name This Color Scheme: " \ -command name_scheme] -row 5 -column 0 -columnspan 2 -sticky news grid [entry .colo.schement -width 36 -bg $::entback \ -fg $::entfore -border 2 -exportselection 0] \ -row 6 -column 0 -columnspan 2 -sticky news frame .colo.flub listbox .colo.schemelist -width 36 -height 7 -bg $::listback \ -fg $::listfore -listvariable schemelist -selectmode single \ -exportselection 0 scrollbar .colo.schemeroll -width 12 -command ".colo.schemelist yview" .colo.schemelist configure -yscrollcommand ".colo.schemeroll set" pack .colo.schemelist .colo.schemeroll -in .colo.flub \ -side left -expand 1 -fill both grid .colo.flub -row 7 -column 0 -columnspan 2 -sticky news frame .colo.scutts button .colo.pickapply -text "Apply Picked Colors" -command { .colo.schemelist selection clear 0 end pickapply showcolo } button .colo.schemapply -text "Apply Color Scheme" \ -command apply_scheme button .colo.schemedel -text "Delete Color Scheme" \ -activebackground red -command delete_scheme button .colo.ok -text "OK" -command { savecolo $appcolo destroy .colo } button .colo.close -text "Close" -command {destroy .colo} foreach butt [list .colo.pickapply .colo.schemapply \ .colo.schemedel .colo.ok .colo.close] { $butt configure -border 1 -pady 0 -bg $::buttback -fg $::buttfore } pack .colo.pickapply .colo.schemapply .colo.schemedel .colo.ok \ .colo.close -in .colo.scutts -side top -expand 1 -fill both grid .colo.scutts -row 7 -column 2 -sticky news bind .colo.schement name_scheme bind .colo.schemelist showschemename bind .colo.schemelist apply_scheme bind .colo.schemelist { .colo.schemelist selection clear 0 end set clixel %y set clickline [.colo.schemelist nearest $clixel] .colo.schemelist selection set $clickline showschemename apply_scheme } focus .colo.schement getschemes # Color-selection radiobuttons and display buttons: grid [label .colo.choo -text "CHOOSE COLOR TO CHANGE" -bg $::headback \ -fg $::headfore] -row 0 -column 3 -columnspan 2 -sticky news frame .colo.fradio frame .colo.flabs radiobutton .colo.winbad -text "Window background : " \ -variable whatbutt -value ".colo.winback" button .colo.winback -bg $::winback -text $::winback radiobutton .colo.winfad -text "Window text : " \ -variable whatbutt -value ".colo.winfore" button .colo.winfore -bg $::winfore -text $::winfore radiobutton .colo.selbad -text "Selection background : " \ -variable whatbutt -value ".colo.selback" button .colo.selback -bg $::selback -text $::selback radiobutton .colo.selfad -text "Selected text : " \ -variable whatbutt -value ".colo.selfore" button .colo.selfore -bg $::selfore -text $::selfore radiobutton .colo.buttbad -text "Regular button background : " \ -variable whatbutt -value ".colo.buttback" button .colo.buttback -bg $::buttback -text $::buttback radiobutton .colo.buttfad -text "Regular button text : " \ -variable whatbutt -value ".colo.buttfore" button .colo.buttfore -bg $::buttfore -text $::buttfore radiobutton .colo.minibad -text "Mini-toolbar button background : " \ -variable whatbutt -value ".colo.miniback" button .colo.miniback -bg $::miniback -text $::miniback radiobutton .colo.minifad -text "Mini-toolbar button text : " \ -variable whatbutt -value ".colo.minifore" button .colo.minifore -bg $::minifore -text $::minifore radiobutton .colo.listbad -text "Listbox background : " \ -variable whatbutt -value ".colo.listback" button .colo.listback -bg $::listback -text $::listback radiobutton .colo.listfad -text "Listbox text : " \ -variable whatbutt -value ".colo.listfore" button .colo.listfore -bg $::listfore -text $::listfore radiobutton .colo.textbad -text "Multi-line textbox background : " \ -variable whatbutt -value ".colo.textback" button .colo.textback -bg $::textback -text $::textback radiobutton .colo.textfad -text "Multi-line textbox text : " \ -variable whatbutt -value ".colo.textfore" button .colo.textfore -bg $::textfore -text $::textfore radiobutton .colo.inacbad -text "Inactive selection background : " \ -variable whatbutt -value ".colo.inacback" button .colo.inacback -bg $::inacback -text $::inacback radiobutton .colo.linkup -text "Link text : " \ -variable whatbutt -value ".colo.linktex" button .colo.linktex -bg $::linktex -text $::linktex radiobutton .colo.entbad -text "Single-line entry background : " \ -variable whatbutt -value ".colo.entback" button .colo.entback -bg $::entback -text $::entback radiobutton .colo.entfad -text "Single-line entry text : " \ -variable whatbutt -value ".colo.entfore" button .colo.entfore -bg $::entfore -text $::entfore radiobutton .colo.headbad -text "Emphasized label background : " \ -variable whatbutt -value ".colo.headback" button .colo.headback -bg $::headback -text $::headback radiobutton .colo.headfad -text "Emphasized label text : " \ -variable whatbutt -value ".colo.headfore" button .colo.headfore -bg $::headfore -text $::headfore radiobutton .colo.lightbad -text "Light label background : " \ -variable whatbutt -value ".colo.lightback" button .colo.lightback -bg $::lightback -text $::lightback radiobutton .colo.lightfad -text "Light label text : " \ -variable whatbutt -value ".colo.lightfore" button .colo.lightfore -bg $::lightfore -text $::lightfore # Get each widget's color-display button ready # to transmit its color to others: foreach colorbutt [list .colo.winback .colo.winfore .colo.selback \ .colo.selfore .colo.buttback .colo.buttfore .colo.miniback \ .colo.minifore .colo.listback .colo.listfore .colo.textback \ .colo.textfore .colo.inacback .colo.linktex \ .colo.entback .colo.entfore .colo.headback .colo.headfore \ .colo.lightback .colo.lightfore] { colortext $colorbutt $colorbutt configure -pady 0 -border 0 bind $colorbutt { set mybutt %W $::whatbutt configure -text [$mybutt cget -text] after 10 {colorgrip $::whatbutt} } colorgrip $colorbutt } pack .colo.winbad .colo.winfad .colo.selbad .colo.selfad \ .colo.buttbad .colo.buttfad .colo.minibad .colo.minifad \ .colo.listbad .colo.listfad .colo.textbad .colo.textfad \ .colo.inacbad .colo.linkup .colo.entbad .colo.entfad \ .colo.headbad .colo.headfad .colo.lightbad .colo.lightfad \ -in .colo.fradio -side top -expand 1 -fill both pack .colo.winback .colo.winfore .colo.selback .colo.selfore \ .colo.buttback .colo.buttfore .colo.miniback .colo.minifore \ .colo.listback .colo.listfore .colo.textback .colo.textfore \ .colo.inacback .colo.linktex .colo.entback .colo.entfore \ .colo.headback .colo.headfore .colo.lightback .colo.lightfore \ -in .colo.flabs -side top -expand 1 -fill both grid .colo.fradio -row 1 -column 3 -rowspan 7 -sticky news grid .colo.flabs -row 1 -column 4 -rowspan 7 -sticky news frame .colo.tux text .colo.tx -bg $::textback -fg $::textfore -height 3 \ -font "lucidatypewriter 14" scrollbar .colo.tuxroll -width 12 -command ".colo.tx yview" .colo.tx configure -yscrollcommand ".colo.tuxroll set" pack .colo.tx .colo.tuxroll -in .colo.tux \ -side left -expand 1 -fill both grid .colo.tux -row 8 -column 0 -columnspan 5 -sticky news .colo.tx insert 1.0 "TEST TEXT HERE\nLinks look like this" .colo.tx tag configure linklike -foreground $::linktex -underline 1 .colo.tx tag add linklike 2.0 "2.0 lineend" # Make sure radiobutton and checkbutton colors are right: colorcheck } ### Color-selection procedures ### # Procedure to show color name in display button: proc colortext {butt} { global winback winfore selback selfore buttback buttfore miniback \ minifore listback listfore textback textfore inacback linktex \ entback entfore headback headfore lightback lightfore # A little quick trickery to get the variable names, # abusing "file extension" for buttons not files: set buttvar [string trimleft [file extension $butt] "."] $butt configure -text [set $buttvar] } # Procedure to display picked color in button: proc colorgrip {butt} { global colorlist set couleur [$butt cget -text] if {[string first "#" $couleur] < 0} { set listline [lsearch -regexp $colorlist "\\\W$couleur"] set reds [lindex $colorlist $listline 0] set greens [lindex $colorlist $listline 1] set blues [lindex $colorlist $listline 2] set couleur [format "#%2.2X%2.2X%2.2X" $reds $greens $blues] } set reds [string range $couleur 1 2] set greens [string range $couleur 3 4] set blues [string range $couleur 5 6] if {[expr 0x$reds + 0x$greens + 0x$blues < 480] && \ [expr 0x$greens < 180]} { $butt configure -fg white } else { $butt configure -fg black } $butt configure -bg $couleur } # Procedure to set new values for color variables # in preparation for applying new colors: proc pickapply {} { global winback winfore selback selfore buttback buttfore miniback \ minifore listback listfore textback textfore inacback linktex \ entback entfore headback headfore lightback lightfore foreach butt [list .colo.winback .colo.winfore .colo.selback \ .colo.selfore .colo.buttback .colo.buttfore .colo.miniback \ .colo.minifore .colo.listback .colo.listfore .colo.textback \ .colo.textfore .colo.inacback .colo.linktex .colo.entback \ .colo.entfore .colo.headback .colo.headfore .colo.lightback \ .colo.lightfore] { # There's that quick trickery again: set buttvar [string trimleft [file extension $butt] "."] set $buttvar [$butt cget -text] } } # Procedure for changing the color selected: proc modify_color {which_color value} { global color red green blue showname switch $which_color { red {set red $value} green {set green $value} blue {set blue $value} } if {[expr $red + $green + $blue < 480] && \ [expr $green < 180]} { set hex white } else { set hex black } if {$color ne $showname} { set color [format "#%2.2X%2.2X%2.2X" \ $red $green $blue] } .colo.color configure -background $color \ -foreground $hex } # Procedure for getting a color name selection # to make the sliders move and the color code change: proc pickname {item} { global color colorlist red green blue showname whatbutt set listline [lindex $colorlist $item] set red [lindex $listline 0] modify_color red $red set green [lindex $listline 1] modify_color green $green set blue [lindex $listline 2] modify_color blue $blue set color $showname set showname nothing } # Procedure to make sure radiobutton, checkbutton, \ # and label colors are right: proc colorcheck {} { # Labels, or radiobuttons with alternating label colors: foreach head $::headlist { if {[winfo exists $head]} { $head configure -background $::headback \ -foreground $::headfore } } foreach light $::lightlist { if {[winfo exists $light]} { $light configure -background $::lightback \ -foreground $::lightfore } } # Get more or less correct selection colors # for radiobuttons and checkbuttons: set ::newsel [.colo.winfore cget -fg] set ::oldsel $::winfore if {$::tko > 8.4} { set ::emphasel [.colo.headfore cget -fg] set ::lightsel [.colo.lightfore cget -fg] set ::regradio $::newsel } else { set ::emphasel $::headfore set ::lightsel $::lightfore set ::regradio $::oldsel } # Once more through the lists, to apply selection colors: foreach head $::headlist { if {[winfo exists $head] && [regexp \ {Radiobutton|Checkbutton} [winfo class $head]]} { $head configure -selectcolor $::emphasel } } foreach light $::lightlist { if {[winfo exists $light] && [regexp \ {Radiobutton|Checkbutton} [winfo class $light]]} { $light configure -selectcolor $::lightsel } } foreach reg $::regradiolist { if {[winfo exists $reg]} { $reg configure -selectcolor $::regradio } } } # Procedure to show new configuration: proc showcolo {} { global winback winfore selback selfore buttback buttfore miniback \ minifore listback listfore textback textfore inacback linktex \ entback entfore headback headfore lightback lightfore newsel oldsel\ buttlist minilist lublist texlist entlist headlist lightlist spinlist tk_setPalette background $winback foreground $winfore \ selectBackground $selback selectForeground $selfore if {[winfo exists .colo.pick]} { .colo.pick configure -bg $lightback -fg $lightfore } if {[winfo exists .colo.choo]} { .colo.choo configure -bg $headback -fg $headfore } foreach butt $buttlist { if {[winfo exists $butt]} { $butt configure -bg $buttback -fg $buttfore } } foreach mini $minilist { if {[winfo exists $mini]} { $mini configure -bg $miniback -fg $minifore } } foreach lub $lublist { if {[winfo exists $lub]} { $lub configure -bg $listback -fg $listfore } } foreach tex $texlist { if {[winfo exists $tex]} { $tex configure -bg $textback -fg $textfore $tex tag configure linklike -foreground $linktex -underline 1 if {$::tko > 8.4} { $tex configure -inactiveselectbackground $inacback } } } foreach ent $entlist { if {[winfo exists $ent]} { $ent configure -bg $entback -fg $entfore } } foreach head $headlist { if {[winfo exists $head]} { $head configure -bg $headback -fg $headfore } } foreach light $lightlist { if {[winfo exists $light]} { $light configure -bg $lightback -fg $lightfore } } foreach spin $spinlist { if {[winfo exists $spin]} { $spin configure -buttonbackground $buttback } } foreach butt [list .colo.winback .colo.winfore .colo.selback \ .colo.selfore .colo.buttback .colo.buttfore .colo.miniback \ .colo.minifore .colo.listback .colo.listfore .colo.textback \ .colo.textfore .colo.inacback .colo.linktex .colo.entback \ .colo.entfore .colo.headback .colo.headfore .colo.lightback \ .colo.lightfore] { colorgrip $butt } colorcheck } # Procedure to save color configuration: proc savecolo {colofile} { set colosaver "set ::winback \"$::winback\"\ \nset ::winfore \"$::winfore\"\ \nset ::selback \"$::selback\"\ \nset ::selfore \"$::selfore\"\ \nset ::buttback \"$::buttback\"\ \nset ::buttfore \"$::buttfore\"\ \nset ::miniback \"$::miniback\"\ \nset ::minifore \"$::minifore\"\ \nset ::listback \"$::listback\"\ \nset ::listfore \"$::listfore\"\ \nset ::textback \"$::textback\"\ \nset ::textfore \"$::textfore\"\ \nset ::inacback \"$::inacback\"\ \nset ::linktex \"$::linktex\"\ \nset ::entback \"$::entback\"\ \nset ::entfore \"$::entfore\"\ \nset ::headback \"$::headback\"\ \nset ::headfore \"$::headfore\"\ \nset ::lightback \"$::lightback\"\ \nset ::lightfore \"$::lightfore\"\ \nset ::newsel \"$::newsel\"\ \nset ::oldsel \"$::oldsel\"" set filid [open $colofile w] puts -nonewline $filid $colosaver close $filid } ### Color-scheme procedures # Procedure to show color-scheme name in entry widget: proc showschemename {} { .colo.schement delete 0 end after 10 { set getline [.colo.schemelist curselection] .colo.schement insert 0 [.colo.schemelist get $getline] .colo.schement selection range 0 end } } # Procedure to name color scheme: proc name_scheme {} { global schemelist # Apply picked colors, if they haven't been applied: .colo.schemelist selection clear 0 end showcolo set isaname [.colo.schement get] # Don't accept a color scheme with no name: if {$isaname eq ""} { tk_messageBox -message "Please enter a name for this color scheme" \ type ok return } # Ask whether to change an existing color scheme: set thisname [lsearch $schemelist $isaname] if {$thisname != -1} { set revise [tk_messageBox -message "Revise\n\"$isaname\"\n\ color scheme?" -type yesno] if {$revise eq "yes"} { # Avoid duplication of name: .colo.schemelist delete $thisname } } # Get rid of any non-space characters that don't belong in file names: set isaname [regsub -all \\W $isaname {}] # Show the name in the list of color schemes: lappend schemelist $isaname set schemelist [lsort -dictionary $schemelist] .colo.schemelist selection set [lsearch $schemelist $isaname] # Blank out the entry line: .colo.schement delete 0 end # Now make a real file name: set isafile [file join $::schemedir [string map "{ } _" $isaname].tcl] # Save the current color scheme in the file: set colorsaver "set ::winback \"$::winback\"\ \nset ::winfore \"$::winfore\"\ \nset ::selback \"$::selback\"\ \nset ::selfore \"$::selfore\"\ \nset ::buttback \"$::buttback\"\ \nset ::buttfore \"$::buttfore\"\ \nset ::miniback \"$::miniback\"\ \nset ::minifore \"$::minifore\"\ \nset ::listback \"$::listback\"\ \nset ::listfore \"$::listfore\"\ \nset ::textback \"$::textback\"\ \nset ::textfore \"$::textfore\"\ \nset ::inacback \"$::inacback\"\ \nset ::linktex \"$::linktex\"\ \nset ::entback \"$::entback\"\ \nset ::entfore \"$::entfore\"\ \nset ::headback \"$::headback\"\ \nset ::headfore \"$::headfore\"\ \nset ::lightback \"$::lightback\"\ \nset ::lightfore \"$::lightfore\"\ \nset ::newsel \"$::newsel\"\ \nset ::oldsel \"$::oldsel\"" set filid [open $isafile w] if {[catch {puts -nonewline $filid $colorsaver} nosave]} { tk_messageBox -message $nosave -type ok } close $filid } # Procedure to retrieve color-scheme names: proc getschemes {} { global schemelist set schemelist [list] set schemeroo [lsort -dictionary [glob -nocomplain -tails \ -directory $::schemedir *]] foreach scheme $schemeroo { lappend schemelist [string map "_ { }" [file rootname $scheme]] } } # Procedure to apply color scheme: proc apply_scheme {} { set schemer [string map "{ } _" [.colo.schemelist get \ [.colo.schemelist curselection]]] set schemefile [file join $::schemedir ${schemer}.tcl] source $schemefile foreach lab [list .colo.winback .colo.winfore .colo.selback \ .colo.selfore .colo.buttback .colo.buttfore .colo.miniback \ .colo.minifore .colo.listback .colo.listfore .colo.textback \ .colo.textfore .colo.inacback .colo.linktex .colo.entback \ .colo.entfore .colo.headback .colo.headfore .colo.lightback \ .colo.lightfore] { colortext $lab colorgrip $lab } showcolo } # Procedure to delete color scheme: proc delete_scheme {} { set picker [.colo.schemelist curselection] set schemer [string map "{ } _" [.colo.schemelist get $picker]] set schemefile [file join $::schemedir ${schemer}.tcl] file delete $schemefile .colo.schemelist delete $picker } # Get color configuration file, if available: set appcolo [file join $wishdir comcolo.tcl] if {[file readable $appcolo]} { source $appcolo } # Use some of the specified color variables: tk_setPalette background $winback foreground $winfore selectBackground \ $selback selectForeground $selfore # Procedure to find out whether executable program is in system's PATH or not: proc inpath {prog} { global env set exok 0 set envlist [split $env(PATH) :] foreach direc $envlist { if {[file executable [file join $direc $prog]]} { set exok 1 break } } return $exok } # Which program to use for printing (Unix-type systems only): if {[inpath xpp]} { set printprog xpp } else { set printprog lpr } # Integer range generator for "foreach" # (to do a "for" loop without ugly, awkward "for" code): proc range {start cutoff finish {step 1}} { # If "start" and "finish" aren't integers, do nothing: if {[string is integer -strict $start] == 0 || [string is\ integer -strict $finish] == 0} { error"range:Rangemustcontaintwointegers" } # "Step" has to be an integer too, and # no infinite loops that go nowhere are allowed: if {$step == 0 || [string is integer -strict $step] == 0} { error "range: Step must be an integer other than zero" } # Does the range include the last number? switch $cutoff { "to" {set inclu 1} "no" {set inclu 0} default { error "range: Use \"to\" for an inclusive range,\ or \"no\" for a noninclusive range" } } # Is the range ascending or descending (or neither)? set ascendo [expr $finish - $start] if {$ascendo > -1} { set up 1 } else { set up 0 } # If range is descending and step is positive but doesn't have a "+" sign, # change step to negative: if {$up == 0 && $step > 0 && [string first "+" $start] != 0} { set step [expr $step * -1] } set ranger [list] ; # Initialize list variable for generated range switch "$up $inclu" { "1 1" {set op "<=" ; # Ascending, inclusive range} "1 0" {set op "<" ; # Ascending, noninclusive range} "0 1" {set op ">=" ; # Descending, inclusive range} "0 0" {set op ">" ; # Descending, noninclusive range} } # Generate a list containing the specified range of integers: for {set i $start} "\$i $op $finish" {incr i $step} { lappend ranger $i } return $ranger } ### GUI SETUP ### # Procedure to change display on title bar: proc wmtitle {} { global currentfile if {$currentfile eq ""} { if {[.tx edit modified]} { wm title . "WISH Supernotepad (Save?)" } else { wm title . "WISH Supernotepad" } } else { if {[.tx edit modified]} { wm title . "WISH Supernotepad (Save?) : $currentfile " } else { wm title . "WISH Supernotepad : $currentfile" } } bind . {after 10 saveup} bind . {after 10 saveup} } # Make and arrange mini-toolbar buttons: frame .froolbar button .new -text "New" -command file_new button .open -text "Open" -command {set openins Open ; openrece file} button .ins -text "Insert" -command {matchinline file} button .save -text "Save" -command file_save button .backup -text "Backup" -command backup button .print -text "Print?" -command printbox button .cut -text "Cut" -command cut_text button .copy -text "Copy" -command copy_text button .paste -text "Paste" -command paste_text button .undo -text "Undo" -command {catch {.tx edit undo}} button .redo -text "Redo" -command {catch {.tx edit redo}} button .special -text "Special" -command specialbox button .findbutt -text "Find" -command findwhat button .repbutt -text "Replace" -command search_replace button .quit -text "Quit" -command gitoot set miniline [list .new .open .ins .save .backup .print .cut .copy \ .paste .undo .redo .special .findbutt .repbutt .quit] foreach mini $miniline { $mini configure -pady 0 -padx 0 -bord 1 -bg $::miniback -fg $::minifore pack $mini -in .froolbar -side left -expand 1 -fill both } grid .froolbar -row 0 -column 0 -columnspan 2 -sticky news # Make the text area and scrollbars: grid [text .tx -width $texwid -height $texhi -bg $::textback \ -fg $::textfore -wrap $wordwrap -setgrid 1 -undo 1 \ -font "$fontaine" -tabs {36 72 108 144 180 216 252 288}] \ -row 3 -column 0 -sticky news if {$tclo > 8.4} { .tx configure -inactiveselectbackground $::inacback } grid [scrollbar .ybar -width 12 -command ".tx yview"] \ -row 3 -column 1 -sticky news grid [scrollbar .xbar -width 12 -command ".tx xview" \ -orient horizontal] \ -row 4 -column 0 -columnspan 2 -sticky news .tx configure -xscrollcommand ".xbar set" \ -yscrollcommand ".ybar set" grid rowconfigure . 3 -weight 1 grid columnconfigure . 0 -weight 1 focus .tx set foco .tx bind .tx {set foco .tx} .tx edit separator .tx edit modified 0 wmtitle # Procedure to get ready to remove old contents from text area: proc readytogo {} { set exitanswer "" if {[.tx edit modified]} { if {$::currentfile ne ""} { file_save } else { set exitanswer [tk_messageBox -message "Save changes?" \ -title "Save changes?" -type yesnocancel -icon question] if {$exitanswer eq "yes"} { file_saveas } } } if {$exitanswer eq "cancel"} { return 0 } else { return 1 } } # Procedure to remove old contents from text area: proc outwithold {} { set ::currentfile "" set ::backfile "" .tx delete 1.0 end .tx edit reset .tx edit modified 0 } # Procedure to get saved changes recognized at once: proc saveup {} { if {[.tx edit modified]} { bind .tx {} bind .tx \n\ \n\t \ \n\t \ \n\ \n\t\n\n\ \n\n\n\t\n\n\n" if {$converto == 0} { .tx insert end "\n\ \n\n\n\n\n\n" } else { .tx insert end "\n\n\n\n\n" } .tx mark set insert 9.0 .tx edit reset .tx edit modified 0 after 1000 wmtitle } ### File -- New Window .filemenu.files add command -label "New Window" -underline 4 \ -accelerator Ctrl+n -command {eval exec supernotepad &} bind . {eval exec supernotepad &} .filemenu.files add separator ### File -- Open Any .filemenu.files add command -label "Open Any" \ -underline 0 -command {file_open any} proc file_open {which} { global newfile currentfile filetosave openins openew set openins Open set go [readytogo] if {$go == 0} {return} if {$which eq "any"} { set newfile [tk_getOpenFile] } if {$newfile ne ""} { if {$openew == 1} { eval exec supernotepad $newfile & } else { outwithold inwithnew .tx mark set insert 1.0 saverece } } if {[winfo exists .rece]} { destroy .rece } } ### File -- Open Recent .filemenu.files add command -label "Open Recent" -underline 5 -command { set openins Open openrece file } -accelerator "Ctrl+. (period)" bind . {set openins Open ; openrece file} # Procedure to make GUI box for selecting # recently opened or inserted files # (also used for selecting "Superpaste" items): proc openrece {what} { global wishdir recentlist reclim newfile addfile mandatum \ foco currentfile openins findum pastelist pastelim openew # Open file in new window if there's one in current window: if {$currentfile ne ""} { set openew 1 } set findum "" toplevel .rece grid [listbox .rece.list -width 72 -height 16 -bg $::listback \ -fg $::listfore -selectmode extended] -row 0 -column 0 -sticky news grid [scrollbar .rece.rolly -width 12 -command [list .rece.list yview]] \ -row 0 -column 1 -sticky news grid [scrollbar .rece.rollx -orient horizontal -width 12 \ -command [list .rece.list xview]] \ -row 1 -column 0 -columnspan 2 -sticky news .rece.list configure -xscrollcommand ".rece.rollx set" \ -yscrollcommand ".rece.rolly set" frame .rece.fir button .rece.find -text "Search" -relief groove -border 3 \ -command findrece entry .rece.ent -bg $::entback -fg $::entfore -width 48 \ -textvariable findum label .rece.found -relief sunken -border 2 -text "0 found" pack .rece.find .rece.ent .rece.found -in .rece.fir \ -side left -expand 1 -fill both grid .rece.fir -row 2 -column 0 -columnspan 2 -sticky news frame .rece.fr checkbutton .rece.new -text "New window?" -variable openew \ -selectcolor $::regradio if {$openins ne "Open" || $what ne "file"} { .rece.new configure -state disabled } button .rece.open # This button isn't for Superpaste: button .rece.all -text "$openins Any" -command { if {$openins == "Insert"} { file_insert any } else { file_open any } } button .rece.whole -text "See Whole" -command seewhole label .rece.show -text "Show" spinbox .rece.spin -width 4 -from 1 -to 9999 -bg $::entback \ -fg $::entfore -buttonbackground $::buttback label .rece.fils button .rece.unlist -text "Unlist" -command "unlisto $what" button .rece.close -text "Close" -command {destroy .rece} foreach butt [list .rece.find .rece.open .rece.all .rece.unlist \ .rece.whole .rece.close] { $butt configure -pady 2 -padx 4 -bg $::buttback -fg $::buttfore } grid .rece.fr -row 3 -column 0 -columnspan 2 -sticky news .rece.list see end grid columnconfigure .rece 0 -weight 1 grid rowconfigure .rece 0 -weight 1 if {$what eq "paste"} { wm title .rece "Superpaste" .rece.list configure -listvariable pastelist bind .rece {findrece paste} .rece.open configure -text "Superpaste" -command superpaste .rece.spin configure -textvariable pastelim .rece.fils configure -text "items" pack .rece.new .rece.open .rece.whole .rece.show .rece.spin \ .rece.fils .rece.unlist .rece.close -in .rece.fr \ -side left -expand 1 -fill both set mandatum superpaste } else { wm title .rece "$openins Recently Viewed File" .rece.list configure -listvariable recentlist bind .rece {findrece rece} .rece.open configure -text $openins -command openorins .rece.spin configure -textvariable reclim .rece.fils configure -text "files" pack .rece.new .rece.open .rece.all .rece.show .rece.spin \ .rece.fils .rece.unlist .rece.close -in .rece.fr \ -side left -expand 1 -fill both set mandatum openorins } bind .rece.list {eval $mandatum} bind .rece.list { selection clear set clixel %y set clickline [.rece.list nearest $clixel] .rece.list selection set $clickline $clickline eval $mandatum } focus .rece.ent .rece.list see end } # Procedure to paste item from "Superpaste" list: proc superpaste {} { global pastelist foco set recenum [.rece.list curselection] if {[llength $recenum] != 1} { tk_messageBox -message "Please insert one selection\ at a time" -type ok } else { $foco insert insert [.rece.list get $recenum] } selection clear .rece.found configure -text "0 found" .rece.ent delete 0 end } # Procedure to see whole item on "Superpaste" list: proc seewhole {} { global foco set seenum [.rece.list curselection] if {[llength $seenum] != 1} { tk_messageBox -message "Please select exactly one\ text item to view" -type ok return } toplevel .see wm title .see "See Whole" grid [text .see.whole -bg $::textback -fg $::textfore] \ -row 0 -column 0 -sticky news grid [scrollbar .see.ybar -width 12 -command ".see.whole yview"] \ -row 0 -column 1 -sticky news grid [scrollbar .see.xbar -width 12 -orient horizontal \ -command "see.whole xview"] -row 1 -column 0 \ -columnspan 2 -sticky news .see.whole configure -xscrollcommand ".see.xbar set" \ -yscrollcommand ".see.ybar set" frame .see.fr button .see.ins -text "Insert" -command { superpaste destroy .see } button .see.close -text "Close" -command {destroy .see} pack .see.ins .see.close -in .see.fr -side left -expand 1 -fill both grid .see.fr -row 2 -column 0 -columnspan 2 -sticky news .see.whole insert insert [.rece.list get $seenum] } # Procedure to find name of recently viewed file # or item in "Superpaste" list: proc findrece {which} { global findum recentlist pastelist if {$which eq "paste"} { set listo $pastelist } else { set listo $recentlist } set whatitis [lsearch -all $listo *$findum*] set howmany [llength $whatitis] if {$howmany > 0} { .rece.found configure -text "$howmany found" foreach it $whatitis { .rece.list selection set $it } .rece.list see [lindex $whatitis 0] } else { set findum "NOT FOUND" .rece.ent selection range 0 end .rece.ent icursor end } } # Procedure to open or insert recently viewed file: proc openorins {} { global addfile newfile openins openew set recenum [.rece.list curselection] if {[llength $recenum] != 1} { tk_messageBox -message "Please select exactly one file" -type ok selection clear } else { set receline [.rece.list get $recenum] if {$openins eq "Insert"} { set addfile $receline file_insert recent } else { if {$openew == 1} { eval exec supernotepad $receline & } else { set newfile $receline file_open recent } } if {[winfo exists .rece]} { destroy .rece } } } # Procedure to delete listings of recently viewed files, # or of "Superpaste" items: proc unlisto {which} { set delrec [.rece.list curselection] set delleng [expr [llength $delrec] -1] foreach d [range $delleng to 0] { set delnum [lindex $delrec $d] .rece.list delete $delnum } if {$which eq "paste"} { savepaste } else { saverece } } # Procedure to save list of recently opened or inserted files: proc saverece {} { global recentlist wishdir newfile currentfile \ reclim openins addfile dumpfile rece set recleng [expr {[llength $recentlist] -1}] foreach r [range $recleng to 0] { set rindex [lindex $recentlist $r] if {$openins eq "Insert" && $rindex eq $addfile} { set recentlist [lreplace $recentlist $r $r] } elseif {$rindex eq $currentfile || $rindex eq $dumpfile} { set recentlist [lreplace $recentlist $r $r] } } if {$recleng > $reclim} { set limless [expr {$recleng-$reclim-1}] set recentlist [lreplace $recentlist 0 $limless] } if {$openins eq "Insert"} { lappend recentlist $addfile } else { lappend recentlist $currentfile } set recfil [open $rece "w"] set recentex "set reclim $reclim\nset recentlist \[list $recentlist\]" puts -nonewline $recfil $recentex close $recfil } ### File -- Open (New Window) .filemenu.files add command -label "Open (New Window)" \ -underline 13 -command openwin # Procedure to open file in new window: proc openwin {} { set newfie [tk_getOpenFile] if {$newfie ne ""} { eval exec supernotepad $newfie & } } .filemenu.files add separator ### File -- Save .filemenu.files add command -label "Save" -underline 0 \ -command "file_save" -accelerator Ctrl+s bind . {file_save} proc file_save {} { global currentfile filecont set filecont [.tx get 1.0 end] set texttosave [string trimright $filecont] if {$currentfile ne ""} { set fileid [open $currentfile "w"] puts $fileid $filecont close $fileid .tx edit reset .tx edit modified 0 wm title . "WISH Supernotepad : Saved $currentfile" after 1000 wmtitle } else {file_saveas} } ### File -- Save As .filemenu.files add command -label "Save As" -underline 5 \ -command "file_saveas" proc file_saveas {} { global currentfile newfile filecont filetosave if {[file writable $currentfile]} { file_save } else { set filecont [.tx get 1.0 end] } set texttosave [string trimright $filecont] if {$currentfile ne ""} { set initdir [file dirname $currentfile] } else { set initdir [pwd] } set filetosave [tk_getSaveFile -initialdir $initdir] if {$filetosave eq ""} { return } set fileid [open $filetosave "w"] puts $fileid $filecont close $fileid set currentfile $filetosave .tx edit reset .tx edit modified 0 saverece wm title . "WISH Supernotepad : Saved $currentfile" after 1000 wmtitle } ### File -- Backup .filemenu.files add command -label "Backup" -command backup proc backup {} { global currentfile backfile if {$currentfile ne ""} { if {[.tx edit modified]} { file_save } } else { tk_messageBox -message "Contents must be saved under one name\ before they can be backed up under another name" -type ok return } if {[file writable $backfile]} { file copy -force $currentfile $backfile wm title . "WISH Supernotepad : File backed up as $backfile" after 1000 wmtitle } else { backup_as } } ### File -- Backup As .filemenu.files add command -label "Backup As" -underline 0 \ -command "backup_as" proc backup_as {} { global currentfile backfile if {$currentfile ne ""} { if {[.tx edit modified]} { file_save } } else { tk_messageBox -message "Contents must be saved under one name\ before they can be backed up under another name" -type ok return } set initdir [file dirname $currentfile] set backfile [tk_getSaveFile -title "Backup As" -initialdir $initdir] if {$backfile ne ""} { file copy -force $currentfile $backfile wm title . "WISH Supernotepad : File backed up as $backfile" after 1000 wmtitle } } ### File -- Move/Rename .filemenu.files add command -label "Move/Rename" -underline 0 \ -command "file_rename" # Procedure to move or rename file: proc file_rename {} { global currentfile dumpfile if {$currentfile ne ""} { set initdir [file dirname $currentfile] } else { set initdir [pwd] } set newname [tk_getSaveFile -title "Move/Rename File" -initialdir $initdir] if {$newname ne ""} { set dumpfile $currentfile file rename -force $currentfile $newname set currentfile $newname file_save saverece } } .filemenu.files add separator ### File -- Import Palm Doc .filemenu.files add command -label "Import Palm Doc" -command openpalm proc openpalm {} { global palmdir env newfile platform # WISH Supernotepad uses "txt2pdbdoc" to convert # to and from Palm Doc format: foreach prog [list txt2pdbdoc html2pdbtxt] { if {[inpath $prog] == 0} { tk_messageBox -message "WISH Supernotepad requires the free\ \"txt2pdbdoc\" and \"html2pdbtxt\" programs for conversion\ to and from Palm Doc format" -type ok return } elseif {$platform ne "unix"} { tk_messageBox -message "Sorry, WISH Supernotepad's Palm Doc\ conversion feature will work only on Unix-type systems"\ -type ok return } } if {$palmdir eq ""} { set initdir $env(HOME) } else { set initdir $palmdir } set palmtype { {"Palm Doc" {".pdb"}} } set texttype { {"Plain Text" {".txt"}} } set newpalm [tk_getOpenFile -filetypes $palmtype -initialdir $initdir \ -title "Open Palm Doc"] if {$newpalm ne ""} { set palmdir [file dirname $newpalm] set destiname [tk_getSaveFile -title "Name & Directory of\ Text File" -filetypes $texttype] if {$destiname eq ""} { tk_messageBox -message "Content from Palm Doc must be given\ name and directory as text file" -type ok return } grid [label .palm -text "Converting from Palm Doc format ..." \ -font "helvetica 18 bold"] -row 1 -column 0 -columnspan 2 \ -sticky news exec txt2pdbdoc -d "$newpalm" "$destiname" set newfile $destiname file_open palm } destroy .palm } ### File -- Export As Palm Doc .filemenu.files add command -label "Export As Palm Doc" -command exportpalm proc exportpalm {} { global currentfile wishdir platform palmdir env # WISH Supernotepad uses "txt2pdbdoc" to convert # to and from Palm Doc format: foreach prog [list txt2pdbdoc html2pdbtxt] { if {[inpath $prog] == 0} { tk_messageBox -message "WISH Supernotepad requires the free\ \"txt2pdbdoc\" and \"html2pdbtxt\" programs for conversion\ to and from Palm Doc format" -type ok return } elseif {$platform ne "unix"} { tk_messageBox -message "Sorry, WISH Supernotepad's Palm Doc\ conversion feature will work only on Unix-type systems"\ -type ok return } } if {$palmdir eq ""} { set initdir $env(HOME) } else { set initdir $palmdir } set palmcont [string trim [.tx get 1.0 end]] set tempee [file join $env(HOME) wishes tempee] set tempnum [open $tempee w] puts -nonewline $tempnum $palmcont close $tempnum set filtip [exec file $tempee] if {[regexp HTML $filtip]} { set textcont [exec html2pdbtxt "$tempee"] set filid [open "$tempee" w] puts -nonewline $filid $textcont close $filid } set texttype { {"Palm Doc" {".pdb"}} } set palmtitle [tk_getSaveFile -title "Descriptive Title for Palm Doc" \ -initialdir $initdir -filetypes $texttype -defaultextension .pdb] if {$palmtitle ne ""} { set palmroot [file tail [file rootname $palmtitle]] exec txt2pdbdoc "$palmroot" "$tempee" "$palmtitle" } file delete $tempee wm title . "WISH Supernotepad : Exported $palmtitle" after 1000 wmtitle } .filemenu.files add separator ### File -- Print .filemenu.files add command -label "Print?" -underline 0 \ -command printbox -accelerator Ctrl+q bind . printbox # Procedure to set up dialog bar for printing: proc printbox {} { global texwid formawid fonto printprog platform if {$platform ne "unix"} { tk_messageBox -message "Sorry, only Unix-type systems can print\ directly from WISH Supernotepad." -type ok return } clearout set formawid $texwid if {[winfo exists .prin]} { grid .prin } else { frame .prin label .prin.tex -text "Text width:" -pady 0 spinbox .prin.spin -width 3 -from 20 -to 200 -textvariable formawid label .prin.lab -text "Set other options when X Printing\ Panel (XPP) is running" button .prin.ok -takefocus 0 -command { filetoprint clearin .prin } button .prin.close -text "Close" -pady 0 -border 1 \ -takefocus 0 -command { clearin .prin } pack .prin.tex .prin.spin .prin.lab .prin.ok .prin.close \ -in .prin -side left -expand 1 -fill both grid .prin -row 1 -column 0 -columnspan 2 -sticky news focus .prin.spin } .prin.spin configure -bg $::entback -fg $::entfore \ -buttonbackground $::buttback foreach butt [list .prin.ok .prin.close] { $butt configure -bg $::buttback -fg $::buttfore } printswitch focus .prin.spin } # Procedure to use X Printing Panel (XPP) for printing # if available, otherwise lpr: proc printswitch {} { global printprog if {$printprog eq "xpp"} { .prin.lab configure -state normal .prin.ok configure -text "Print with XPP" } else { .prin.lab configure -state disabled .prin.ok configure -text "Print with LPR" } } # Procedure to save file (if necessary) and format it for printing; proc filetoprint {} { global platform currentfile fonto wishdir printprog \ formawid texwid wordwrap set go [readytogo] if {$go == 0} {return} .tx configure -width $formawid -wrap word wm geometry . {} if {$currentfile ne ""} { set ::curprint [file rootname $currentfile] } else { set ::curprint [file join $wishdir printtemp] } append ::curprint ".fmt" after 1000 { set formex [formatit print] set fileid [open $::curprint "w"] puts -nonewline $fileid $formex close $fileid .tx configure -width $texwid -wrap $wordwrap wm geometry . {} eval exec $printprog $::curprint & } } .filemenu.files add separator ### File -- Exit .filemenu.files add command -label "Exit" -underline 1 -command gitoot # Procedure to shut down properly: proc gitoot {} { global curprint if {[.tx edit modified]} { set seeya 1 } else { set seeya 0 } set go [readytogo] if {$go == 0} {return} savefig if {[file exists $curprint]} { file delete $curprint } if {$seeya == 0 || [regexp {Saved} [wm title .]] == 0} { exit } else { # Give the user half a second to see that changes have been saved: after 500 exit } } # Procedure to save configuration: proc savefig {} { set figlines "set openins $::openins\ \nset texwid $::texwid\ \nset formawid $::formawid\ \nset texhi $::texhi\ \nset wordwrap $::wordwrap\ \nset fonto \"$::fonto\"\ \nset siz $::siz\ \nset fontaine \"$::fontaine\"\ \nset printprog $::printprog\ \nset reunito $::reunito\ \nset parsep $::parsep\ \nset expert $::expert\ \nset headsize $::headsize\ \nset html_fontsize $::html_fontsize\ \nset listtype $::listtype\ \nset autotab $::autotab" set filid [open $::superfig w] puts -nonewline $filid $figlines close $filid } ### EDIT MENU ### # using built-in procedures tk_textCut, tk_textCopy, tk_textPaste menu .filemenu.edit -tearoff 0 .filemenu add cascade -label "Edit" -underline 0 -menu .filemenu.edit ### Edit -- Cut .filemenu.edit add command -label "Cut" -underline 2 \ -command cut_text -accelerator Ctrl+x bind . {cut_text ; break} proc cut_text {} { global foco if {[winfo class $foco] eq "Text"} { tk_textCut $foco $foco edit separator if {$foco eq ".tx"} { wmtitle } } } ### Edit -- Copy .filemenu.edit add command -label "Copy" -underline 0 \ -command copy_text -accelerator Ctrl+c bind . {copy_text ; break} proc copy_text {} { global foco if {[winfo class $foco] eq "Text"} { tk_textCopy $foco } } ### Edit -- Paste .filemenu.edit add command -label "Paste" -underline 0 \ -command paste_text -accelerator Ctrl+g bind . paste_text # didn't work quite right--I don't know why. proc paste_text {} { global foco if {[winfo class $foco] eq "Text"} { tk_textPaste $foco $foco edit separator if {$foco eq ".tx"} { wmtitle } } } ### Edit -- Delete .filemenu.edit add command -label "Delete" -underline 0 \ -command delete_text -accelerator Del proc delete_text {} { .tx delete sel.first sel.last .tx edit separator wmtitle } .filemenu.edit add separator ### Edit -- Supercut .filemenu.edit add command -label "Supercut" \ -command supercut -accelerator Ctrl+X bind . supercut proc supercut {} { global foco pastelist if {[winfo class $foco] eq "Text"} { set anysel [catch {$foco get sel.first sel.last} pastee] if {$anysel == 0} { if {[lsearch $pastelist $pastee] == -1} { lappend pastelist $pastee } savepaste } tk_textCut $foco $foco edit separator if {$foco eq ".tx"} { wmtitle } } } ### Edit -- Supercopy .filemenu.edit add command -label "Supercopy" \ -command supercopy -accelerator Ctrl+C bind . supercopy proc supercopy {} { global foco pastelist if {[winfo class $foco] eq "Text"} { set anysel [catch {$foco get sel.first sel.last} pastee] if {$anysel == 0} { if {[lsearch $pastelist $pastee] == -1} { lappend pastelist $pastee } savepaste } tk_textCopy $foco } else { if {[selection own] eq $foco} { lappend pastelist [selection get] savepaste } } } ### Edit -- Superpaste .filemenu.edit add command -label "Superpaste" -underline 3 \ -command {matchinline paste} -accelerator F1 bind . {matchinline paste} # Procedures to view, select, and paste text from "Superpaste" list # are under the "File--Open" menu item above, because they use the # same listbox with slightly different names for buttons and things # Procedure to paste text from "Superpaste" list # or to insert file from "Recent File" list, without # opening the box, if possible; if not, then to open the box: proc matchinline {whatfor} { global pastelist recentlist foco addfile openins set anysel [catch {$foco get sel.first sel.last} texas] if {$anysel == 0} { set firstum [$foco index sel.first] set lastum [$foco index sel.last] } else { set realine [realword] set texas [lindex $realine 0] set firstum [lindex $realine 1] set lastum [lindex $realine end] } set selgo [$foco index $firstum] $foco delete $firstum $lastum if {$whatfor eq "paste"} { set whatitis [lsearch -all $pastelist *$texas*] } else { set whatitis [lsearch -all $recentlist *$texas*] } set howmany [llength $whatitis] if {$howmany == 1} { set it [lindex $whatitis 0] if {$whatfor eq "paste"} { $foco insert $selgo [lindex $pastelist $it] } else { set addfile [lindex $recentlist $it] file_insert recent } } else { set openins Insert openrece $whatfor } } # Procedure to identify the real beginning of a real word # in a text widget (unlike "string wordstart"): proc realword {} { global foco set linum [line_number] set insum [$foco index insert] set linget [string trim [$foco get $linum.0 $insum]] set spa [string last " " $linget] set ta [string last "\t" $linget] if {$spa == -1 && $ta == -1} { set wordo $linget set wordleng [string length $wordo] set firsto [$foco index "$insum - $wordleng char"] } else { set spend [expr {$spa+1}] set tabend [expr {$ta+1}] if {$spend > $tabend} { set wordo [$foco get $linum.$spend $insum] set firsto $linum.$spend } else { set wordo [$foco get $linum.$tabend $insum] set firsto $linum.$tabend } } return [list $wordo $firsto $insum] } # Procedure to save "superpaste" list: proc savepaste {} { global pastelist pastelim superpaste set pastleng [expr {[llength $pastelist] -1}] if {$pastleng > $pastelim} { set limless [expr {$pastleng-$pastelim-1}] set pastelist [lreplace $pastelist 0 $limless] } set pastfil [open $superpaste "w"] set pastex "set pastelim $pastelim\nset pastelist \[list $pastelist\]" puts -nonewline $pastfil $pastex close $pastfil } .filemenu.edit add separator ### Edit -- Undo .filemenu.edit add command -label "Undo" -underline 0 -command { catch {.tx edit undo} } -accelerator Ctrl+z # Binding Ctrl+z is built in ### Edit -- Redo .filemenu.edit add command -label "Redo" -underline 0 \ -command {catch {.tx edit redo}} -accelerator Ctrl+r bind . {catch {.tx edit redo}} bind . {.tx edit separator} bind . {.tx edit separator} ### Edit -- Undo All Since Last Save .filemenu.edit add command -label "Undo All Since Last Save" \ -underline 9 -command undolast # Procedure to undo all changes since last save: proc undolast {} { global currentfile newfile if {[.tx edit modified]} { .tx delete 1.0 end if {$currentfile ne ""} { set newfile $currentfile inwithnew } else { .tx edit reset .tx edit modified 0 wmtitle } } else { tk_messageBox -message "No changes have been made since\ the last save" -type ok } } .filemenu.edit add separator ### Edit -- Title .filemenu.edit add command -label "Title" -command title proc title {} { if {[.tx tag ranges sel] eq ""} {return} set input [.tx get sel.first sel.last] set output "" set nocaps [list a an and at but by for from in into of on or the to with] set count 0 foreach word [split $input] { # Strip quotation marks: if {[string index $word 0] == "\""} { set quote 1 set word [string trim $word \"] } else { set quote 0 } # Always capitalize the first word; otherwise, # don't capitalize any words in the "nocaps" list: if {$count == 0 || [lsearch $nocaps $word] == -1} { set word [string totitle $word] } # Add word plus space, with or without quotation marks, to output: if {$quote} { append output "\"$word\" " } else { append output "$word " } # Capitalize any word after a colon: if {[string index $word end] == ":"} { set count 0 } else { incr count } } set inhere [.tx index sel.first] .tx delete sel.first sel.last .tx insert $inhere [string trim $output] } .filemenu.edit add command -label "Untitle" -command untitle ### Edit -- Untitle proc untitle {} { if {[.tx tag ranges sel] eq ""} {return} set input [.tx get sel.first sel.last] set inhere [.tx index sel.first] .tx delete sel.first sel.last .tx insert $inhere [string tolower $input] } .filemenu.edit add separator ### Edit -- Select All .filemenu.edit add command -label "Select all" -underline 7 \ -command ".tx tag add sel 1.0 end" -accelerator Ctrl+/ # binding is built-in ### Edit -- Auto-tab .filemenu.edit add checkbutton -variable autotab -label "Auto-tab"\ -underline 5 -selectcolor $winfore -command autotaborno proc autotaborno {} { global autotab if {$autotab == 1} { bind . {autotab go ; .tx edit separator} bind . {autotab stop} } else { bind . {.tx edit separator} bind . {} } } autotaborno # Procedure to find out how many tabs at beginning of line: proc tabgrab {} { global charno tabno bogno if {[.tx get $bogno.$charno] eq "\t"} { incr tabno incr charno tabgrab } } # Procedure to auto-tab: proc autotab {stoporgo} { global tabno charno bogno set bogno [expr [line_number] -1] set charno 0 set tabno 0 tabgrab set herenow [.tx index insert] set gripchar [.tx get "$herenow -2c" $herenow] set gripchar [string trim $gripchar] if {$gripchar eq "\{"} { incr tabno } if {$stoporgo eq "stop"} { if {$tabno > 0} { incr tabno -1 } } set tabstring [string repeat "\t" $tabno] .tx insert insert $tabstring .tx edit separator if {$stoporgo eq "stop"} { .tx mark set insert "insert +1c" } } ### INSERT MENU ### menu .filemenu.insert -tearoff 0 .filemenu add cascade -label "Insert" -underline 0 -menu .filemenu.insert ### Insert -- File -- Any .filemenu.insert add command -label "File--Any" -underline 0 \ -command "file_insert any" proc file_insert {which} { global addfile openins foco set openins Insert # Variable "addfile" may already have been set # by another procedure. If not, do this: if {$which eq "any"} { set addfile [tk_getOpenFile -title "Insert File"] } if {$addfile ne ""} { set star [open $addfile "r"] set filecont [read $star] close $star set filecont [string trimright $filecont] $foco insert insert $filecont $foco edit separator $foco see insert wmtitle } else { unset addfile } if {[winfo exists .rece]} { destroy .rece } } .filemenu.insert add command -label "File--Recent" -underline 6 \ -command {matchinline file} -accelerator "Ctrl+, (comma)" bind . {matchinline file} .filemenu.insert add separator ### Insert -- Special Characters .filemenu.insert add command -label "Special Characters" \ -underline 0 -command specialbox -accelerator F4 bind . specialbox set charlist [list \ "b "¢ "â "G "T \ "? "? "? "? "? \ "? "? "? "? "? \ "? "? "? "? "? \ "? "? "? "? "? \ "? "? "? "? "? \ "? "" "b "¢ "â \ "G "T "? "? "? \ "? "? "? "? "? \ "? "? "? "? "? \ "? "? "? "? "? \ "? "? "? "? "? \ "? "? "? "?"?\ "?"?"?"?"?\ "?"?"?"?"?\ "?"?"?"?"?? "?????????? "?????????? "???????? # Procedure for finding correct text or entry widget # and inserting special (or non-special) characters: proc findwin {char} { global foco set winclass [winfo class $foco] $foco insert insert $char if {$winclass == "Text"} { $foco edit separator wmtitle } after 10 {focus $foco} } # Procedure for setting up special-character selection box: set specialbutts [list] proc specialbox {} { global charlist foco buttlist minilist toplevel .spec wm title .spec "Special" set bigfons -adobe-helvetica-bold-r-normal--14-*-*-*-*-*-* set row 0 set col 0 foreach c [range 0 no [llength $charlist]] { set chartext [lindex $charlist $c] grid [button .spec.but($c) -text $chartext -font $bigfons \ -pady 1 -padx 2 -borderwidth 1] \ -row $row -column $col -sticky news .spec.but($c) configure -bg $::buttback -fg $::buttfore if {[lsearch $buttlist ".spec.but($c)"] < 0} { lappend buttlist .spec.but($c) } bind .spec.but($c) { set butt %W set charx [$butt cget -text] findwin $charx } incr col if {$col > 4} { set col 0 incr row } } grid [button .spec.amp -text "&"] -row $row -column 4 -sticky news bind .spec.amp {findwin "&"} set bigoe_data " #define bigoe_width 17 #define bigoe_height 13 static unsigned char bigoe_bits[] = { 0xf8, 0xfe, 0x01, 0xfe, 0xff, 0x01, 0xcf, 0x07, \ 0x00, 0x87, 0x07, 0x00, 0x07, 0x07, 0x00, 0x07, \ 0x3f, 0x00, 0x07, 0x3f, 0x00, 0x07, 0x07, 0x00, \ 0x07, 0x07, 0x00, 0x07, 0x07, 0x00, 0x8e, 0x07, \ 0x00, 0xfc, 0xff, 0x01, 0xf8, 0xfe, 0x01 };" image create bitmap bigoe -data $bigoe_data grid [button .spec.oebig -image bigoe \ -pady 1 -padx 2 -borderwidth 1] \ -row [expr $row+1] -column 0 -sticky news bind .spec.oebig {findwin "Œ"} set liloe_data " #define liloe_width 13 #define liloe_height 9 static unsigned char liloe_bits[] = { 0xbc, 0x07, 0xfe, 0x0f, 0xc3, 0x18, 0xc3, 0x18, \ 0xc3, 0x1f, 0xc3, 0x00, 0xe7, 0x18, 0xfe, 0x0f, \ 0x3c, 0x07 };" image create bitmap liloe -data $liloe_data grid [button .spec.oelil -image liloe -pady 1 \ -pady 1 -padx 2 -borderwidth 1] \ -row [expr $row+1] -column 1 -sticky news bind .spec.oelil {findwin "œ"} grid [button .spec.lt -text "<"] \ -row [expr $row+1] -column 2 -sticky news bind .spec.lt {findwin "<"} grid [button .spec.gt -text ">"] \ -row [expr $row+1] -column 3 -sticky news bind .spec.gt {findwin ">"} grid [button .spec.quot -text "\""] \ -row [expr $row+1] -column 4 -sticky news bind .spec.quot {findwin """} grid [button .spec.nbsp -text " "] \ -row [expr $row+2] -column 0 -columnspan 2 -sticky news bind .spec.nbsp {findwin " "} grid [button .spec.close -text "Close" \ -command {destroy .spec}] -row [expr $row+2] \ -column 2 -columnspan 3 -sticky news foreach butt [list .spec.oebig .spec.oelil .spec.nbsp .spec.amp \ .spec.lt .spec.gt .spec.quot .spec.close] { $butt configure -pady 1 -padx 2 -borderwidth 1 \ -bg $::miniback -fg $::minifore -font $bigfons if {[lsearch $minilist $butt] < 0} { lappend minilist $butt } } } .filemenu.insert add separator ### Insert -- Color Code # Get WISH Color Picker to do this job: bind . { wishcolor .col.color configure -command { $foco insert insert "\"$colo\"" } } .filemenu.insert add command -label "Color Code" -underline 0 -command { wishcolor .col.color configure -command { $foco insert insert "\"$colo\"" } } -accelerator Ctrl+F4 .filemenu.insert add separator ### Insert -- Time/Date .filemenu.insert add command -label "Time/Date" \ -underline 0 -command printtime proc printtime {} { set nowtime [clock seconds] set clocktime [clock format $nowtime -format "%R %p %D"] .tx insert insert $clocktime .tx edit separator wmtitle } ### SEARCH MENU ### menu .filemenu.search -tearoff 0 .filemenu add cascade -label "Search" -underline 0 -menu .filemenu.search ### Search -- Find .filemenu.search add command -label "Find" -underline 0 \ -command findwhat -accelerator F2 bind . findwhat proc findwhat {} { if {[catch {grid info .findreg} whatnot] == 0 && $whatnot != ""} { find_text find } else { search_find } } # Initialize some variables: set casematch nocase set searchway forward set search_for "" # This shows up when search is done (see proc "find_text," below): frame .fin label .fin.is -font "helvetica 18 bold" -relief raised -border 2 button .fin.clo -pady 2 -border 2 -bg $::buttback -fg $::buttfore \ -text "Close" -command whichnew pack .fin.is .fin.clo -in .fin -side left -expand 1 -fill both # Procedure to determine whether to start over in "Find" or "Replace": proc whichnew {} { set gridslaves [grid slaves .] if {[regexp {.findreg} $gridslaves]} { newfind find } elseif {[regexp {.replace} $gridslaves]} { newfind replace } clearin .fin } # Procedure to insert starting and ending codes for HTML # (or Tcl/Tk) code and to put cursor in the right place: proc dualcodes {star cont fin} { global foco set winclass [winfo class $foco] set selon [catch {$foco index sel.first}] if {$selon == 1} { # No selected text: if {$cont == {}} { $foco insert insert "$star$fin" set goback [string length $fin] if {$winclass == "Text"} { $foco mark set insert "[$foco index insert] \ - $goback chars" $foco see insert $foco edit separator if {$foco == ".tx"} { wmtitle } } else { $foco icursor [expr [$foco index insert] - $goback] } } else { $foco insert insert "$star$cont$fin" } } else { # Text selected: $foco insert sel.first $star $foco insert sel.last "$fin" set goforth [expr {[string length $fin] +1}] if {$winclass == "Text"} { $foco mark set insert "sel.last + $goforth chars" $foco see insert $foco edit separator if {$foco eq ".tx"} { wmtitle } } else { $foco icursor [expr {[$foco index insert] + $goforth}] } } selection clear after 10 {focus $foco} } # Procedure to set up "Find" dialog bar: proc search_find {} { global search_for casematch searchway foco anytries regexy expert findex set findex .findreg clearout if {[winfo exists .findreg]} { grid .findreg } else { frame .findreg frame .find button .find.next -text "Find (F2)" -command {find_text find} entry .find.enter -width 90 -bg white -textvariable search_for pack .find.next .find.enter -in .find -side left -expand 1 -fill both frame .findex checkbutton .findex.exp -text "Expert search (with regular\ expressions)" -variable expert checkbutton .findex.match -text "Match case" \ -variable casematch -onvalue "exact" -offvalue "nocase" radiobutton .findex.up -text "Search Up" -variable searchway \ -value "backward" radiobutton .findex.down -text "Search Down" -variable searchway \ -value "forward" button .findex.new -text "New Search" -command {newfind find} button .findex.close -text "Close" -command { newfind find clearin .fin clearin .findreg } pack .findex.exp .findex.match .findex.up .findex.down .findex.new \ .findex.close -in .findex -side left -expand 1 -fill both foreach butt [list .find.next .findex.match .findex.up \ .findex.down .findex.close] { $butt configure -pady 2 } bind .find {set foco .find.enter} bind .find {find_text find} bind .find {findwin {
}} foreach {key star fin} {

\ \ \
} { bind .find.enter $key "dualcodes $star {} $fin" } pack .find .findex -in .findreg -side top -expand 1 -fill both grid .findreg -row 1 -column 0 -columnspan 2 -sticky news } foreach butt [list .find.next .findex.new .findex.close] { $butt configure -bg $::buttback -fg $::buttfore } foreach butt [list .findex.exp .findex.match .findex.up .findex.down] { $butt configure -selectcolor $::regradio } focus .find.enter set foco .find.enter if {$search_for ne ""} { set searchlength [string length $search_for] .find.enter selection range 0 $searchlength } set anytries 0 } # Set search direction and case sensitivity, and search for match # (Variables "present_place" and "findlength" # are set in "proc find_text," below) proc whichway {} { global casematch searchway search_reg present_place countum place switch "$casematch $searchway" { "nocase forward" { set place [.tx search -nocase -forward -regexp \ -count countum $search_reg $present_place end] } "exact forward" { set place [.tx search -forward -regexp \ -count countum $search_reg $present_place end] } "nocase backward" { set place [.tx search -nocase -backward -regexp \ -count countum $search_reg $present_place 1.0] } "exact backward" { set place [.tx search -backward -regexp \ -count countum $search_reg $present_place 1.0] } } } # Actually find some matching text proc find_text {whatfor} { global starting_place present_place search_for search_reg countum \ casematch searchway findway anytries replacelength bojo place \ replace_with expert if {$anytries == 0} { set anytries 1 set starting_place [.tx index insert] set present_place $starting_place set place $starting_place if {$whatfor eq "replace"} { set replacelength [string length $replace_with] .place.yesdo configure -text "Replace This" -command replace_one focus .with.leave bind .rep.enter replace_one bind .with.leave replace_one .place.nodont configure -state normal set bojo ".with.leave" } else { set bojo ".find.enter" } } set search_reg [regup $search_for] whichway if {$place eq ""} { if {$present_place eq $starting_place} { set endmess "No matching text found" } else { if {$searchway eq "forward"} { set finis "end" } else { set finis "beginning" } set endmess "Search completed from line\ [expr int($starting_place)] to $finis" } .fin.is configure -text $endmess grid .fin -row 2 -column 0 -columnspan 2 -sticky news } else { catch {.tx tag remove sel sel.first sel.last} .tx tag add sel $place "$place + $countum chars" .tx see $place if {$searchway eq "forward"} { .tx mark set insert "$place + $countum chars" } else { .tx mark set insert $place } set present_place [.tx index insert] } if {$whatfor eq "find"} { focus .tx set foco .tx } } # Procedure to start searching from scratch: proc newfind {why} { set ::search_for "" set ::anytries 0 clearin .fin if {$why eq "find"} { focus .find.enter } else { clearin .fin set ::replace_with "" set ::replacelength 0 .place.yesdo configure -text "Find First" -command {find_text replace} .place.nodont configure -state disabled set ::starting_place [.tx index insert] bind .rep.enter {find_text replace} bind .with.leave {find_text replace} focus .rep.enter } } # Procedure to prepare search string for use: proc regup {textin} { global expert if {$expert == 1} { set textout [string map "{ } {\\s}" $textin] } else { set textout [string map {"\{" "\\\{" "\}"\ "\\\}" "\\" "\\\\"} $textin] set textout [string map "{ } {\\s} {.} {\\.} {+} {\\+}\ {*} {\\*} {?} {\\?} {|} {\\|} {(} {\\(} {)} {\\)} {^} {\\^}\ {\$} {\\\$} {\[} {\\\[} {\]} {\\\]}" $textout] } return $textout } .filemenu.search add separator ### Search -- Replace (Standard) .filemenu.search add command -label "Replace (Standard)" -underline 0 \ -command "search_replace" -accelerator Ctrl+F2 bind . search_replace # Procedures for replacing text # Set up "Replace" dialog bar: proc search_replace {} { global casematch searchway starting_place foco anytries \ search_for replace_with regexy expert findex autotab oldautotab if {$autotab == 1} { set oldautotab 1 set autotab 0 autotaborno } else { set oldautotab 0 } set findex .replace set searchway forward set starting_place [.tx index insert] clearout if {[winfo exists .replace]} { grid .replace } else { frame .replace frame .rep label .rep.what -text "Replace:" entry .rep.enter -width 90 -bg white -textvariable search_for pack .rep.what .rep.enter -in .rep -side left -expand 1 -fill both frame .with label .with.what -text "With: " entry .with.leave -width 90 -bg white -textvariable replace_with pack .with.what .with.leave -in .with -side left -expand 1 -fill both frame .place button .place.yesdo -text "Find First" -relief groove -border 3 \ -command {find_text replace} button .place.nodont -text "Skip" \ -command {find_text replace} -state disabled button .place.all -text "Replace All" \ -command replace_all checkbutton .place.exp -text "Expert search" -variable expert radiobutton .place.up -text "Up" -variable searchway \ -value "backward" radiobutton .place.down -text "Down" -variable searchway \ -value "forward" checkbutton .place.match -text "Match case" \ -variable casematch -onvalue "exact" -offvalue "nocase" button .place.new -text "New Search" -command {newfind replace} button .place.close -text "Close" -command repdoon foreach w [list .rep.what .with.what .place.yesdo .place.nodont \ .place.all .place.up .place.down .place.match .place.close] { $w configure -padx 4 } foreach butt [list .place.nodont .place.all .place.new .place.close] { $butt configure -pady 2 -border 1 -takefocus 0 } pack .place.yesdo .place.nodont .place.all .place.exp .place.up \ .place.down .place.match .place.new .place.close -in .place \ -side left -expand 1 -fill both pack .rep .with .place -in .replace -side top -expand 1 -fill both bind .rep.enter {find_text replace} bind .with.leave {find_text replace} bind .rep.enter {findwin {
}} bind .with.leave {findwin {
}} foreach {key star fin} {

\ \ \
} { bind .rep.enter $key "dualcodes $star {} $fin" bind .with.leave $key "dualcodes $star {} $fin" } bind .rep.enter {set foco .rep.enter} bind .with.leave {set foco .with.leave} grid .replace -row 1 -column 0 -columnspan 2 -sticky news } foreach butt [list .place.yesdo .place.nodont .place.all \ .place.new .place.close] { $butt configure -bg $::buttback -fg $::buttfore } foreach butt [list .place.exp .place.up .place.down .place.match] { $butt configure -selectcolor $::regradio } focus .rep.enter set foco .rep.enter set anytries 0 } # Procedure to get done with replacing: proc repdoon {} { global autotab oldautotab if {$oldautotab == 1} { set autotab 1 autotaborno } newfind replace clearin .fin clearin .replace } # Replace one instance at a time, with confirmation or disconfirmation proc replace_one {} { global place findlength searchway replacelength countum \ starting_place present_place search_reg replace_with currentfile .tx delete $place "$place + $countum chars" .tx insert $place $replace_with .tx edit separator wmtitle find_text replace } # Replace all instances, without confirmation proc replace_all {} { global replace_with search_for casematch expert selection clear set alltext [.tx get 1.0 end] set search_reg [regup $search_for] if {$casematch eq "nocase"} { set anysubs [regsub -all -nocase $search_reg $alltext\ $replace_with allsub] } else { set anysubs [regsub -all $search_reg $alltext $replace_with allsub] } if {$anysubs > 0} { .tx delete 1.0 end .tx insert 1.0 $allsub set finis "All matching text replaced" } else { set finis "No matching text found" } .fin.is configure -text $finis grid .fin -row 2 -column 0 -columnspan 2 -sticky news } ### Search -- Replace (Multiple) .filemenu.search add command -label "Replace (Multiple)" -underline 9 \ -command multirep -accelerator Ctrl+F3 bind . multirep # Procedure to set up GUI box for multiple replace: proc multirep {} { global m n foco expert casematch set m 1 toplevel .mult wm title .mult "Replace (Multiple)" set n [expr $m-1] grid [label .mult.place($n) -text "Replace: "] \ -row $n -column 0 -sticky news grid [entry .mult.ent($n) -bg $::entback -fg $::entfore -width 60] \ -row $n -column 1 -sticky news if {[lsearch $::entlist ".mult.ent($n)"] < 0} { lappend ::entlist .mult.ent($n) } grid [label .mult.with($m) -text "with: "] \ -row $m -column 0 -sticky news grid [entry .mult.wix($m) -bg $::entback -fg $::entfore -width 60] \ -row $m -column 1 -sticky news if {[lsearch $::entlist ".mult.wix($m)"] < 0} { lappend ::entlist .mult.wix($m) } frame .mult.fr button .mult.more -text "Show More Pairs" -relief groove -border 3 \ -command morepairs checkbutton .mult.expert -text "Expert search" \ -selectcolor $::regradio -variable expert checkbutton .mult.match -text "Match case" -selectcolor $::regradio \ -variable casematch -onvalue exact -offvalue nocase button .mult.replall -text "Replace All" -command replall button .mult.close -text "Close" -takefocus 0 -command { set m 1 set n 0 destroy .mult focus .tx set foco .tx } foreach butt [list .mult.more .mult.replall .mult.close] { $butt configure -pady 2 -takefocus 0 -bg $::buttback -fg $::buttfore } pack .mult.more .mult.expert .mult.match .mult.replall \ .mult.close -in .mult.fr -side left -expand 1 -fill both morepairs focus .mult.ent(0) set foco .mult.ent(0) bind .mult morepairs } # Procedure to add more entry widgets for multiple replace: proc morepairs {} { global m n foco expert incr m 2 set n [expr $m-1] grid forget .mult.fr grid [label .mult.place($n) -text "Replace: "] \ -row $n -column 0 -sticky news grid [entry .mult.ent($n) -bg $::entback -fg $::entfore -width 60] \ -row $n -column 1 -sticky news if {[lsearch $::entlist ".mult.ent($n)"] < 0} { lappend ::entlist .mult.ent($n) } grid [label .mult.with($m) -text "with: "] \ -row $m -column 0 -sticky news grid [entry .mult.wix($m) -bg $::entback -fg $::entfore -width 60] \ -row $m -column 1 -sticky news if {[lsearch $::entlist ".mult.wix($m)"] < 0} { lappend ::entlist .mult.wix($m) } grid .mult.fr -row [expr $m+1] -column 0 -columnspan 2 -sticky news if {$n > 2} { focus .mult.ent($n) set foco .mult.ent($n) } bind .mult {findwin {
}} foreach {key star fin} {

\ \ \
} {bind .mult $key "dualcodes $star {} $fin"} foreach i [range 0 to $m] { if {[winfo exists .mult.ent($i)]} { bind .mult.ent($i) "set foco .mult.ent($i)" } elseif {[winfo exists .mult.wix($i)]} { bind .mult.wix($i) "set foco .mult.wix($i)" } } } # Procedure to perform multiple replace: proc replall {} { global m n foco expert casematch set replist [list] set itall [.tx get 1.0 "end -1c"] foreach e [range 1 to $m 2] { set f [expr $e-1] set rep($f) [.mult.ent($f) get] set rep($e) [.mult.wix($e) get] if {$rep($f) ne ""} { lappend replist $rep($f) $rep($e) } } if {$expert == 0} { if {$casematch eq "exact"} { set newitall [string map "$replist" $itall] } else { set newitall [string map -nocase "$replist" $itall] } } else { set newitall $itall if {$casematch eq "exact"} { foreach e [range 1 to $m 2] { set f [expr $e-1] regsub -all "$rep($f)" $newitall "$rep($e)" newitall } } else { foreach e [range 1 to $m 2] { set f [expr $e-1] regsub -all -nocase "$rep($f)" $newitall "$rep($e)" newitall } } } .tx delete 1.0 "end -1c" .tx insert 1.0 $newitall .tx edit separator wmtitle focus .tx set foco .tx destroy .mult } .filemenu.search add separator # Search -- Line Number .filemenu.search add command -label "Line Number/Word Count" -underline 0 \ -command wordline -accelerator Ctrl+w bind . wordline # Procedure to find out what line number the cursor is on: proc line_number {} { global foco set herenow [$foco index insert] set lineno [expr int($herenow)] return $lineno } # Procedure to count words: proc wordcount {} { set wordsnow [.tx get 1.0 {end -1c}] set wordlist [split $wordsnow] set countnow 0 foreach item $wordlist { if {$item ne ""} { incr countnow } } return $countnow } # Set up "Line Number/Word Count" dialog bar: proc wordline {} { clearout if {[winfo exists .line]} { grid .line } else { frame .line label .line.goto -text "Go to line number: " -pady 2 entry .line.number -width 6 button .line.ok -text "GO" -relief groove -border 3 -command gotoline label .line.word -text "Word count: " -pady 2 label .line.count -relief sunken -width 12 -pady 2 button .line.recount -border 1 -text "Recount" -pady 2 \ -command recount button .line.close -border 1 -text "Close" -pady 2 -command { clearin .line } bind .line.number gotoline pack .line.goto .line.number .line.ok .line.word .line.count \ .line.recount .line.close -in .line \ -side left -expand 1 -fill both grid .line -row 1 -column 0 -columnspan 2 -sticky news } .line.number configure -bg $::entback -fg $::entfore foreach butt [list .line.ok .line.recount .line.close] { $butt configure -bg $::buttback -fg $::buttfore } .line.count configure -bg $::lightback -fg $::lightfore recount } # Procedure to recount words and re-identify line number: proc recount {} { set lineno [line_number] .line.number delete 0 end .line.number insert 0 $lineno set linedigits [string length $lineno] .line.number selection range 0 $linedigits focus .line.number .line.count configure -text [wordcount] } # Procedure to go to another line, identified by number: proc gotoline {} { set newlineno [.line.number get] .tx mark set insert $newlineno.0 .tx see insert focus .tx set foco .tx } ### HTML MENU ### menu .filemenu.html -tearoff 0 .filemenu add cascade -label "HTML" -underline 2 -menu .filemenu.html # HTML -- Plain Text to HTML .filemenu.html add command -label "Plain Text to HTML" -underline 14 \ -command {convert_to_html plain} -accelerator Ctrl+H bind . {convert_to_html plain} .filemenu.html add command -label "Link-Text to HTML" -underline 7 \ -command {convert_to_html link} proc convert_to_html {what} { global converto lincoln linkhead set converto 1 if {$lincoln} { # Show codes, don't display Link-Text: set lincoln 0 unlink .tx } if {$what eq "link"} { set linkhead [.tx search "" 1.0 end] if {$linkhead eq ""} { set linkhead 1.0 } # Find link beginnings and ends: if {$::tko > 8.4} { set linkstars [.tx search -regexp -all \ -count clink "" 1.0 end] set linkends [.tx search -all "" 1.0 end] } else { set ::place 1.0 set ::linkline [list] set ::countline [list] set starlog [findtags "" ::linkline ::countline] set linkstars [lindex $starlog 0] set cti [lindex $starlog end] set ::place 1.0 set ::linkline [list] set ::countline [list] set endlog [findtags "" ::linkline ::countline] set linkends [lindex $endlog 0] } # Make list of links; then temporarily hide them # so they won't be mistaken for their targets: .tx tag configure hide -elide 1 for {set i 0} {$i < [llength $linkstars]} {incr i} { set star [lindex $linkstars $i] ; # Begin link-start tag set starleng [lindex $clink $i] ; # Length of link-start tag set starsplit [split $star "."] set starline [lindex $starsplit 0] ; # Line number in text set starchar [lindex $starsplit end] ; # Position in line set starend $starline.[expr {$starchar + $starleng}] set linkstar [.tx get $star $starend] set linkname [string map "{link } {} {\"} {} {<} {} {>} {}" \ $linkstar] lappend linklist [list $starend "$linkname"] set finis [lindex $linkends $i] .tx tag add hide $star "$finis +7c" } # Search for targets and make a non-duplicative list of them: set targlist [list] set loclist [list] foreach link $linklist { set targ [lindex $link end] if {[lsearch $targlist $targ] == -1} { set linkloc [lindex $link 0] if {[.tx compare $linkloc < $linkhead]} { set target [.tx search -count ct "$targ" $linkhead end] } else { set target [.tx search -count ct "$targ" $linkloc end] if {$target eq ""} { set target [.tx search -backwards -count ct "$targ" \ $linkloc $linkhead] } } if {$target ne ""} { lappend targlist $targ lappend loclist [list $target $ct] } } } # Run backward through the list, # adding anchor codes all the way: set locleng [expr {[llength $loclist] -1}] foreach t [range $locleng to 0] { set targstar [lindex $loclist $t 0] set targleng [lindex $loclist $t end] set targname [lindex $targlist $t] set targend [.tx index "$targstar + $targleng chars"] .tx insert $targend "" .tx insert $targstar "" } } .tx tag delete hide set textutnunc [.tx get 1.0 {end -1c}] outwithold if {$what eq "link"} { set textutnunc [string map { "" ""\ "" "\">" "&" "&"\ "?" "<"\ ">? ">"\ "\"" """\ "" ""\ "" "
"\ "" "
"\ "" ""\ "" ""\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" ""\ "" ""\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ "" "
"\ } $textutnunc] } else { set textutnunc [string map { "&" "&"\ "<" "<"\ ">" ">"\ "\"" """ } $textutnunc] } new_html .tx insert 18.0 $textutnunc\n set lastend [.tx index end] set lastnums [split $lastend .] set lastline [lindex $lastnums 0] set lastbutfour [expr $lastline - 4] .tx mark set insert 18.0 .tx insert 18.0 "

" set lineno [line_number] while {$lineno < $lastbutfour} { set endoline [.tx index "$lineno.0 lineend"] set isthisblank [expr $endoline - $lineno.0] set nextline [expr $lineno + 1] set endonext [.tx index "$nextline.0 lineend"] set isnextblank [expr $endonext - $nextline.0] if {$isthisblank ne 0.0 && $isnextblank eq 0.0} { .tx insert $endoline "

" } if {$isthisblank ne 0.0 && $isnextblank ne 0.0} { .tx insert $nextline.0 "
" } if {$isthisblank eq 0.0 && $isnextblank ne 0.0} { .tx insert $nextline.0 "

" } incr lineno } .tx mark set insert 9.0 .tx edit separator set converto 0 after 1000 wmtitle } .filemenu.html add separator # Procedure to tell whether to put HTML codes into # main text widget or HTML Table Data Entry box: # HTML -- Heading .filemenu.html add command -label "Heading" -underline 0 \ -command headingbox -accelerator Ctrl+F9 bind . headingbox set headsize 1 # Procedure to set up heading selection dialog bar: proc headingbox {} { global headsize selon foco lastfoco autotab oldautotab set lastfoco $foco clearout if {$autotab == 1} { set oldautotab 1 set autotab 0 autotaborno } else { set oldautotab 0 } if {[winfo exists .head]} { grid .head } else { frame .head label .head.text -text "Heading Text: " entry .head.enter -width 50 set selon [catch {.tx get sel.first sel.last}] if {$selon == 0} { .head.enter insert insert [.tx get sel.first sel.last] } label .head.size -text "Heading size:" spinbox .head.spin -width 1 -from 1 -to 6 -textvariable headsize \ -buttonbackground $::buttback button .head.insert -text "Insert" -pady 2 -border 3 \ -relief groove -command headin button .head.close -text "Close" -pady 2 -border 1 -command doonhead bind . headin bind .head {findwin {
}} foreach {key star fin} {

\ \ \
} { bind . $key "dualcodes $star {} $fin" } pack .head.text .head.enter .head.size .head.spin .head.insert \ .head.close -in .head -side left -expand 1 -fill both grid .head -row 1 -column 0 -columnspan 2 -sticky news } foreach ent [list .head.enter .head.spin] { $ent configure -bg $::entback -fg $::entfore } foreach butt [list .head.insert .head.close] { $butt configure -bg $::buttback -fg $::buttfore } focus .head.enter set foco .head.enter bind .head {set foco .head.enter} } # Procedure for inserting heading and codes: proc headin {} { global headsize foco lastfoco set foco $lastfoco set cont [.head.enter get] dualcodes "$cont" .head.enter delete 0 end focus $foco } # Procedure to get done with headings: proc doonhead {} { global autotab oldautotab if {$oldautotab == 1} { set autotab 1 } autotaborno clearin .head } # HTML -- Font .filemenu.html add command -label "Font" -underline 0 \ -command fontbox -accelerator Ctrl+F8 bind . fontbox set html_fontsize 0 set html_fontcolor "" set colorcall "" # Procedure to stop displaying font widgets: proc dumpboxes {} { global foco if {[winfo exists .colo]} {destroy .colo} clearin .font focus $foco } # Procedure to set up font selection dialog bar: proc fontbox {} { global colo html_fontsize html_fontcolor colorcall clearout if {[winfo exists .font]} { grid .font } else { frame .font label .font.size -text "Font size:" spinbox .font.spin -bg white -width 1 -textvariable html_fontsize \ -buttonbackground $::buttback -from "-2" -to 4 label .font.color -text "Font Color:" entry .font.colornum -width 10 -textvariable colo -bg white button .font.select -text "Select Color" -command { if {$colorcall ne ""} {set colorcall ""} wishcolor } button .font.insertcolor -text "Insert Color" \ -command insert_fontcolor button .font.insertsize -text "Insert size" \ -command insert_fontsize button .font.insertboth -text "Insert size + Color" \ -command insert_sizencolor button .font.close -text "Close" -command dumpboxes foreach butt [list .font.select .font.insertcolor .font.insertsize \ .font.insertboth .font.close] { $butt configure -padx 2 -borderwidth 1 } pack .font.size .font.spin .font.color .font.colornum .font.select \ .font.insertcolor .font.insertsize .font.insertboth .font.close \ -in .font -side left -expand 1 -fill both grid .font -row 1 -column 0 -columnspan 2 -sticky news } foreach ent [list .font.spin .font.colornum] { $ent configure -bg $::entback -fg $::entfore } foreach butt [list .font.select .font.insertcolor .font.insertsize \ .font.insertboth .font.close] { $butt configure -bg $::buttback -fg $::buttfore } focus .font.spin } # Procedure to insert font color in HTML code: proc insert_fontcolor {} { global colo html_fontcolor foco set html_fontcolor $colo dualcodes "" {} } # Procedure to insert font size in HTML code: proc insert_fontsize {} { global html_fontsize foco if {$html_fontsize > 0} { set sizz "+$html_fontsize" } elseif {$html_fontsize < 0} { set size "-$html_fontsize" } dualcodes "" {} } # Procedure to insert font size and color in HTML code: proc insert_sizencolor {} { global colo html_fontsize html_fontcolor foco if {$html_fontsize > 0} { set sizz "+$html_fontsize" } elseif {$html_fontsize < 0} { set sizz "-$html_fontsize" } set html_fontcolor $colo dualcodes "" {} } .filemenu.html add separator # HTML -- Anchor .filemenu.html add command -label "Anchor" -underline 0 \ -command "anchorbox" -accelerator Ctrl+F7 bind . anchorbox set lastanchor "" # Procedure to set up anchor insertion dialog bar: proc anchorbox {} { global lastanchor foco lastfoco autotab oldautotab if {$autotab == 1} { set oldautotab 1 set autotab 0 autotaborno } else { set oldautotab 0 } set lastfoco $foco clearout if {[winfo exists .anchor]} { grid .anchor } else { frame .anchor label .anchor.name -text "Anchor name: " entry .anchor.enter -width 64 -textvariable lastanchor if {[catch {.tx get sel.first sel.last}] == 0} { .anchor.enter insert insert [.tx get sel.first sel.last] } button .anchor.insert -text "Insert" -border 3 -relief groove \ -pady 2 -command insert_anchor button .anchor.close -text "Close" -border 1 -pady 2 \ -command anchordoon pack .anchor.name .anchor.enter .anchor.insert .anchor.close \ -in .anchor -side left -expand 1 -fill both bind .anchor {set foco .anchor.enter} grid .anchor -row 1 -column 0 -columnspan 2 -sticky news bind . insert_anchor } .anchor.enter configure -bg $::entback -fg $::entfore foreach butt [list .anchor.insert .anchor.close] { $butt configure -bg $::buttback -fg $::buttfore } focus .anchor.enter set foco .anchor.enter } # Procedure to insert anchor: proc insert_anchor {} { global lastanchor foco lastfoco set foco $lastfoco set cont [.anchor.enter get] dualcodes "" "$cont" } # Procedure to get done with anchors: proc anchordoon {} { global autotab oldautotab if {$oldautotab == 1} { set autotab 1 } autotaborno clearin .anchor } # HTML -- Link .filemenu.html add command -label "Link" -underline 3 \ -command linkbox -accelerator F7 bind . linkbox set linktype "http://www." set textype html # Procedure to set up link entry dialog bar: proc linkbox {} { global linktype lastanchor foco lastfoco autotab oldautotab set lastfoco $foco if {$autotab == 1} { set oldautotab 1 set autotab 0 autotaborno } else { set oldautotab 0 } if {[winfo exists .link]} { grid .link .url.linkent insert 0 $linktype bind . insert_link } else { frame .link frame .url label .url.urlink -text "Link to what? " entry .url.linkent -width 90 .url.linkent insert 0 $linktype pack .url.urlink .url.linkent -in .url \ -side left -expand 1 -fill both frame .show label .show.display -text "Display name: " entry .show.name -width 90 -bg white if {[catch {.tx get sel.first sel.last}] == 0} { .show.name insert insert [.tx get sel.first sel.last] } pack .show.display .show.name -in .show \ -side left -expand 1 -fill both frame .butt button .butt.www -text "WWW" -command { set textype html linkup "http://www." } button .butt.email -text "E-mail" -command { set textype html linkup "mailto:" } button .butt.ftp -text "FTP" -command { set textype html linkup "ftp://" } button .butt.anchor -text "Anchor" -command { set textype html linkup "#" } button .butt.linktext -text "Link-Text" -command { set textype link linkup "" } button .butt.other -text "Other" -command { set textype html linkup "" } button .butt.insert -text "Insert Link" -relief groove -border 3 \ -pady 2 -command insert_link button .butt.close -text "Close" -border 3 -relief groove \ -command linkdoon foreach butt [list .butt.www .butt.email .butt.ftp .butt.anchor \ .butt.linktext .butt.other .butt.close] { $butt configure -pady 0 -border 1 } foreach butt [list .butt.www .butt.email .butt.ftp .butt.anchor \ .butt.linktext .butt.other .butt.insert .butt.close] { pack $butt -in .butt -side left -expand 1 -fill both } bind . insert_link bind .show.name {findwin {
}} foreach {key star fin} {

\ \ \
} { bind .show.name $key "dualcodes $star {} $fin"} bind .url.linkent {set foco .url.linkent} bind .show.name {set foco .show.name} pack .url .show .butt -in .link -side top -expand 1 -fill both grid .link -row 1 -column 0 -columnspan 2 -sticky news } foreach ent [list .url.linkent .show.name] { $ent configure -bg $::entback -fg $::entfore } foreach butt [list .butt.www .butt.email .butt.ftp .butt.anchor \ .butt.linktext .butt.other .butt.close] { $butt configure -bg $::buttback -fg $::buttfore } focus .url.linkent set foco .url.linkent } # Procedure to insert link prefix: proc linkup {prefix} { global linktype textype if {$linktype ne $prefix} { set linktype $prefix .url.linkent delete 0 end .show.name delete 0 end .url.linkent insert 0 $linktype focus .url.linkent } } # Procedure to insert link: proc insert_link {} { global linktype textype foco lastfoco set foco $lastfoco set link_id [.url.linkent get] set link_name [.show.name get] if {$textype eq "html"} { dualcodes "" "$link_name" } else { dualcodes "" "$link_name" } .url.linkent delete 0 end .show.name delete 0 end linkdoon } # Procedure to get done with links: proc linkdoon {} { global autotab oldautotab if {$oldautotab == 1} { set autotab 1 } autotaborno clearin .link } .filemenu.html add separator # HTML -- Image .filemenu.html add command -label "Image" -underline 1 \ -command imagebox -accelerator Ctrl+F11 bind . imagebox # Procedure for setting up image insertion box: proc imagebox {} { global alignimage imagedir image_hspace image_vspace imageheight \ imagewidth imagebordo imagepath imagedir dirurl foco lastfoco if {[info exists imagepath] == 0} { set imagepath relative } if {[info exists alignimage] == 0} { set alignimage left } if {[info exists dirurl] == 0} { set dirurl "" } foreach var [list image_hspace image_vspace imageheight \ imagewidth imagebordo] {set $var 0} set lastfoco $foco if {[winfo exists .image]} {destroy .image} toplevel .image wm title .image "Insert Image Source" grid [label .image.dest -text "Directory URL:" -pady 6] \ -row 0 -column 0 -sticky news grid [entry .image.url -bg white -textvariable dirurl] \ -row 0 -column 1 -columnspan 2 -sticky news if {$imagepath eq "relative"} { foreach widget [list .image.dest .image.url] { $widget configure -state disabled } } else { foreach widget [list .image.dest .image.url] { $widget configure -state normal } } grid [label .image.filename -text "Image file name:" -pady 6] \ -row 1 -column 0 -sticky news grid [entry .image.enter -width 56 -bg white] \ -row 1 -column 1 -columnspan 2 -sticky news frame .image.fr2 button .image.pick -text "Pick Image" -command pickimage label .image.path -text "Path to Image: " -pady 6 radiobutton .image.rel -text "Relative" -variable imagepath \ -value "relative" -selectcolor $::regradio -command { foreach widget [list .image.dest .image.url] { $widget configure -state disabled } focus .image.enter } radiobutton .image.abso -text "Absolute" -variable imagepath \ -value "absolute" -selectcolor $::regradio -command { foreach widget [list .image.dest .image.url] { $widget configure -state normal } focus .image.url } label .image.align -text "Align:" pack .image.pick .image.path .image.rel .image.abso .image.align \ -in .image.fr2 -side left -expand 1 -fill both grid .image.fr2 -row 2 -column 0 -columnspan 2 -sticky news tk_optionMenu .image.lineup alignimage left right top middle bottom grid .image.lineup -row 2 -column 2 -sticky news grid [label .image.optinfo -bg $::lightback -fg $::lightfore \ -text "O P T I O N A L I N F O R M A T I O N :" -pady 6] \ -row 3 -column 0 -columnspan 3 -sticky news grid [label .image.alt -text "Image description:" -pady 6] \ -row 4 -column 0 -sticky news grid [entry .image.altinhere -width 56 -bg white] \ -row 4 -column 1 -columnspan 2 -sticky news frame .image.fr5 label .image.horspace -text "Spacing: Horiz" -pady 6 spinbox .image.horizhere -width 4 -bg white \ -buttonbackground $::buttback \ -textvariable image_hspace -from 0 -to 1000 label .image.vertspace -text " Vert" spinbox .image.vertinhere -width 4 -bg white \ -buttonbackground $::buttback\ -textvariable image_vspace -from 0 -to 1000 label .image.height -text " Height" spinbox .image.heightinhere -width 5 -bg white \ -buttonbackground $::buttback\ -textvariable imageheight -from 0 -to 10000 label .image.width -text " Width" spinbox .image.widthinhere -width 5 -bg white \ -buttonbackground $::buttback \ -textvariable imagewidth -from 0 -to 10000 label .image.bordo -text " Border" spinbox .image.bordohere -width 3 -bg white \ -buttonbackground $::buttback \ -textvariable imagebordo -from 0 -to 100 pack .image.horspace .image.horizhere .image.vertspace .image.vertinhere \ .image.height .image.heightinhere .image.width .image.widthinhere \ .image.bordo .image.bordohere -in .image.fr5 \ -side left -expand 1 -fill both grid .image.fr5 -row 5 -column 0 -columnspan 3 -sticky news frame .image.fr6 button .image.insert -text "Insert" -default active \ -command insert_image button .image.close -text "Close" -default normal -command { focus .tx set foco .tx destroy .image } pack .image.insert .image.close -in .image.fr6 \ -side left -expand 1 -fill both grid .image.fr6 -row 6 -column 0 -columnspan 3 -sticky news bind .image insert_image if {$imagepath eq "relative"} { focus .image.enter set foco .image.enter } else { focus .image.url set foco .image.url } foreach ent [list .image.url .image.enter .image.altinhere] { bind $ent "set foco $ent" } foreach ent [list .image.url .image.enter .image.altinhere \ .image.horizhere .image.vertinhere .image.heightinhere \ .image.widthinhere .image.bordohere ] { $ent configure -bg $::entback -fg $::entfore } foreach butt [list .image.insert .image.close] { $butt configure -bg $::buttback -fg $::buttfore } } # Procedure to pick image file name: proc pickimage {} { global imagepath foco currentfile if {$currentfile ne ""} { set imagedir [file dirname $currentfile] } else { set imagedir [pwd] } set imagefile [tk_getOpenFile -title "Pick Image File" \ -initialdir $imagedir] set imagename [file tail $imagefile] .image.enter insert 0 $imagename focus .image.enter set foco .image.enter } # Procedure to insert image source into HTML code: proc insert_image {} { global alignimage codestart codend image_hspace image_vspace \ imageheight imagewidth imagebordo foco imagepath dirurl lastfoco set foco $lastfoco set img_src [.image.enter get] if {$imagepath eq "absolute" && [regexp "$dirurl" $img_src] == 0} { set dirurl [string trimright $dirurl "/"] set img_src $dirurl/$img_src } set alttext [.image.altinhere get] if {$alttext ne ""} { set alttext " alt=\"$alttext\"" } if {$image_hspace > 0} { set imhup " hspace=\"$image_hspace\"" } else { set imhup "" } if {$image_vspace > 0} { set imvup " vspace=\"$image_vspace\"" } else { set imvup "" } if {$imageheight > 0} { set imhut " height=\"$imageheight\"" } else { set imhut "" } if {$imagewidth > 0} { set imgwid " width=\"$imagewidth\"" } else { set imgwid "" } if {$imagebordo > 0} { set imbord " border=\"$imagebordo\"" } else { set imbord "" } $foco insert insert \ "" $foco edit separator if {$foco eq ".tx"} { wmtitle } foreach var [list image_hspace image_vspace imageheight \ imagewidth imagebordo] {set $var 0} destroy .image } .filemenu.html add separator # HTML -- List .filemenu.html add command -label "List" -underline 2 \ -command html_list -accelerator F11 bind . html_list set listtype 1 set liston 0 set ordo 1 # Procedure to set up dialog bar for list item entry: proc html_list {} { global listtype liston foco lastfoco autotab oldautotab if {$autotab == 1} { set oldautotab 1 set autotab 0 autotaborno } else { set oldautotab 0 } if {[winfo class $foco] eq "Text"} { set lastfoco $foco } else { set lastfoco .tx } if {$liston == 1} {set liston 0} if {[winfo exists .html_list]} { grid .html_list } else { frame .html_list frame .html label .html.item -text "List item: " entry .html.itemhere -width 72 -bg white if {[catch {$foco get sel.first sel.last}] == 0} { .html.itemhere insert insert [$foco get sel.first sel.last] } button .html.insert -text "Insert" -relief groove -border 3 \ -pady 2 -command insert_item button .html.done -text "Done" -border 1 -pady 2 \ -command finish_list pack .html.item .html.itemhere .html.insert .html.done \ -in .html -side left -expand 1 -fill both frame .list label .list.style -text "Style: " radiobutton .list.123 -text "1-2-3" -variable listtype -value 1 radiobutton .list.capa -text "A-B-C" -variable listtype -value A radiobutton .list.abc -text "a-b-c" -variable listtype -value a radiobutton .list.capi -text "I-II-III" -variable listtype -value I radiobutton .list.iii -text "i-ii-iii" -variable listtype -value i radiobutton .list.disc -text "Discs" -variable listtype -value disc radiobutton .list.circle -text "Circles" -variable listtype \ -value circle radiobutton .list.square -text "Squares" -variable listtype \ -value square pack .list.style .list.123 .list.capa .list.abc .list.capi .list.iii \ .list.disc .list.circle .list.square -in .list \ -side left -expand 1 -fill both pack .list .html -in .html_list -side top -expand 1 -fill both grid .html_list -row 1 -column 0 -columnspan 2 -sticky news bind .html_list {set foco .html.itemhere} bind .html.itemhere insert_item bind .html_list {findwin {
}} foreach {key star fin} {

\ \ \
} {bind .html_list $key "dualcodes $star {} $fin"} } .html.itemhere configure -bg $::entback -fg $::entfore foreach butt [list .html.insert .html.done] { $butt configure -bg $::buttback -fg $::buttfore } foreach reg [list .list.123 .list.capa .list.abc .list.capi \ .list.iii .list.disc .list.circle .list.square] { $reg configure -selectcolor $::regradio } focus .html.itemhere set foco .html.itemhere } # Procedure to create list and insert items: proc insert_item {} { global listchoice listtype liston ordo foco lastfoco set list_item [.html.itemhere get] if {[catch {$lastfoco get sel.first sel.last}] == 0} { $lastfoco delete sel.first sel.last } if {$liston == 0} { switch $listtype { 1 - A - a - I - i { set ordo 1 } disc - circle - square { set ordo 0 } } if { $ordo == 1 } { $lastfoco insert insert \ "
    \n\t
  1. $list_item
    2. \n" } else { $lastfoco insert insert \ "
      \n\t
    • $list_item
      • \n" } set liston 1 } else { $lastfoco insert insert "\t
    • $list_item
      • \n" } .html.itemhere delete 0 end $lastfoco edit separator wmtitle focus .html.itemhere set foco .html.itemhere } # Procedure to finish off list: proc finish_list {} { global ordo foco lastfoco autotab oldautotab if {$ordo == 1} { $lastfoco insert insert "
\n\n" } else { $lastfoco insert insert "\n\n" } set liston 0 set foco $lastfoco $foco edit separator if {$foco eq ".tx"} { wmtitle } clearin .html_list if {$oldautotab == 1} { set autotab 1 autotaborno } } # HTML -- Table .filemenu.html add command -label "Table: Create" -underline 0 \ -command tablebox -accelerator F12 bind . tablebox .filemenu.html add command -label "Table: Continue" -underline 8 -command { set rowon 0 set celltype Data .tx insert insert "\n\t" databox } -accelerator Ctrl+F12 bind . { set rowon 0 set celltype Data .tx insert insert "\n\t" databox } # Initialize variables for table attributes: foreach var [list tableon tablesum table_hspace table_vspace tableheight \ tablewidth tablebordo cellpad cellspace] {set $var 0} set tablecolor "" # Procedure to create Table Setup box: proc tablebox {} { global color tablecolor blankrows blankcols tablesum table_hspace \ table_vspace tableheight tablewidth tablebordo cellpad cellspace \ tablecolor celltype foco if { [winfo exists .table] } { destroy .table } toplevel .table wm title .table "HTML Table Setup" grid [button .table.withdata -text "M A K E T A B L E" \ -default active -bg $::buttback -fg $::buttfore -command { get_tablecodes make_table set celltype Header databox destroy .table }] -row 0 -column 0 -columnspan 7 -sticky news grid [button .table.close -text "Close" -default normal \ -bg $::buttback -fg $::buttfore -command { destroy .table focus .tx set foco .tx }] -row 0 -column 7 -columnspan 5 -sticky news grid [label .table.optinfo -bg $::lightback -fg $::lightfore \ -text "O P T I O N A L I N F O R M A T I O N :" -pady 6] \ -row 1 -column 0 -columnspan 11 -sticky news grid [label .table.sum -text "Table summary:" -pady 6] \ -row 2 -column 0 -columnspan 2 -sticky news grid [entry .table.suminhere -width 40] \ -row 2 -column 2 -columnspan 9 -sticky news grid [label .table.horspace -text "Spacing: Horiz" -pady 6] \ -row 3 -column 0 -columnspan 2 -sticky news grid [spinbox .table.horizhere -width 4 \ -buttonbackground $::buttback \ -textvariable table_hspace -from 0 -to 1000] \ -row 3 -column 2 -sticky news grid [label .table.vertspace -text "Vert"] \ -row 3 -column 3 -sticky news grid [spinbox .table.vertinhere -width 4 -bg white \ -buttonbackground $::buttback \ -textvariable table_vspace -from 0 -to 1000] \ -row 3 -column 4 -sticky news grid [label .table.height -text "Height"] \ -row 3 -column 5 -sticky news grid [spinbox .table.heightinhere -width 5 -bg white \ -buttonbackground $::buttback \ -textvariable tableheight -from 0 -to 10000] \ -row 3 -column 6 -sticky news grid [label .table.width -text "Width"] \ -row 3 -column 7 -sticky news grid [spinbox .table.widthinhere -width 5 -bg white \ -buttonbackground $::buttback \ -textvariable tablewidth -from 0 -to 10000] \ -row 3 -column 8 -sticky news grid [label .table.bordo -text "Border"] \ -row 3 -column 9 -sticky news grid [spinbox .table.bordohere -width 3 -bg white \ -buttonbackground $::buttback \ -textvariable tablebordo -from 0 -to 100] \ -row 3 -column 10 -sticky news grid [label .table.cellpad -text "Space inside cells" -pady 6] \ -row 4 -column 0 -columnspan 2 -sticky news grid [spinbox .table.padhere -width 3 -bg white \ -buttonbackground $::buttback \ -textvariable cellpad -from 0 -to 100] \ -row 4 -column 2 -sticky news grid [label .table.cellspace -text "Space between cells"] \ -row 4 -column 3 -columnspan 3 -sticky news grid [spinbox .table.spacehere -width 3 -bg white \ -buttonbackground $::buttback \ -textvariable cellspace -from 0 -to 100] \ -row 4 -column 6 -sticky news grid [label .table.allinpixels -text "(all in pixels)"] \ -row 4 -column 7 -columnspan 4 -sticky news grid [label .table.tablecolor -text "Background color:"] \ -row 5 -column 0 -columnspan 2 -sticky news grid [label .table.colorcode -textvariable color] \ -row 5 -column 2 -columnspan 2 -sticky news grid [button .table.colorsel -text "Select color" -command { if {$colorcall ne ""} {set colorcall ""} wishcolor }] -row 5 -column 4 -columnspan 3 -sticky news grid [button .table.colordesel -text "Deselect color" \ -command { set color "" }] \ -row 5 -column 7 -columnspan 4 -sticky news bind .table { get_tablecodes ; make_table ; databox ; destroy .table } foreach ent [list .table.suminhere .table.horizhere .table.vertinhere \ .table.heightinhere .table.widthinhere .table.bordohere \ .table.padhere .table.spacehere] { $ent configure -bg $::entback -fg $::entfore } foreach butt [list .table.withdata .table.close .table.colorsel \ .table.colordesel] { $butt configure -bg $::buttback -fg $::buttfore } focus .table.suminhere set foco .table.suminhere bind .table.suminhere {set foco .table.suminhere} } # Procedure to get HTML codes for table attributes from user input: proc get_tablecodes {} { global blankcols blankrows color tablecolor table_hspace table_vspace \ tableheight tablewidth tablebordo cellpad cellspace tablesum \ tabhup tabvup tabhut tabwid tabbord tabcol celpa celspa set tablesum [.table.suminhere get] if {$color ne ""} { set tablecolor $color set tabcol " bgcolor=\"$tablecolor\"" } else { set tabcol "" } if {$tablesum ne ""} { set tablesum " summary=\"$tablesum\"" } if {$table_hspace > 0} { set tabhup " hspace=\"$table_hspace\"" } else { set tabhup "" } if {$table_vspace > 0} { set tabvup " vspace=\"$table_vspace\"" } else { set tabvup "" } if {$tableheight > 0} { set tabhut " height=\"$tableheight\"" } else { set tabhut "" } if {$tablewidth > 0} { set tabwid " width=\"$tablewidth\"" } else { set tabwid "" } if {$tablebordo > 0} { set tabbord " border=\"$tablebordo\"" } else { set tabbord "" } if {$cellpad > 0} { set celpa " cellpadding=\"$cellpad\"" } else { set celpa "" } if {$cellspace > 0} { set celspa " cellspacing=\"$cellspace\"" } else { set celspa "" } } # Procedure to insert HTML codes for beginning and end of table: proc make_table {} { global tabcol table_hspace table_vspace horowin vertrowin rowcolor \ tableheight tablewidth tablebordo cellpad cellspace tablesum \ tabhup tabvup tabhut tabwid tabbord celpa celspa .tx insert insert \ "\n\n\n\n" set lineno [expr int([.tx index insert])] .tx mark set insert [expr $lineno-2].0 .tx insert insert "\t" .tx edit separator wmtitle } # Initialize variables for row attributes: set horowalign left set vertrowalign middle set horowin "" set vertrowin "" set rowcolor "" set rowon 0 # Initialize variables for cell attributes: set horcellalign left set vertcellalign middle set horcellin "" set vertcellin "" set rowspannum 1 set colspannum 1 set rowcolor "" set cellcolor "" # Procedure to create HTML Table Data Entry box: proc databox {} { global horowalign vertrowalign horcellalign \ vertcellalign colspannum rowspannum textbox \ color rowcolor cellcolor celltype colorcall fonto foco toplevel .data wm title .data "HTML Table Data Entry" grid [label .data.cellcont -text "C E L L C O N T E N T S :" \ -bg $::lightback -fg $::lightfore -pady 6] \ -row 0 -column 0 -columnspan 6 -sticky news frame .data.but1 button .data.line -text "New Line (F3)" -command { .data.cont insert insert "\n
" .data.cont edit separator .data.cont see insert } button .data.par -text "New Par (F6)" foreach {butt star fin} { {\n

} {

}} { bind .data.par $butt "dualcodes $star {} $fin" } button .data.ital -text "Italic (F8)" -command { dualcodes {} } button .data.bold -text "Bold (F9)" -command { dualcodes {} } set insbutts [list .data.line .data.par .data.ital .data.bold] foreach butt $insbutts { $butt configure -pady 0 -padx 0 -borderwidth 1 \ -bg $::buttback -fg $::buttfore pack $butt -in .data.but1 -side left -expand 1 -fill both } grid .data.but1 -row 1 -column 0 -columnspan 6 -sticky news frame .data.but2 button .data.ins -text "Insert" -command { set openins Insert set foco .data.cont openrece file } bind .data { set openins Insert set foco .data.cont openrece file } button .data.cut -text "Cut" -command { set foco .data.cont cut_text } bind .data { set foco .data.cont cut_text } button .data.copy -text "Copy" -command { set foco .data.cont copy_text } bind .data { set foco .data.cont copy_text } button .data.paste -text "Paste" -command { set foco .data.cont paste_text } bind .data { set foco .data.cont paste_text } bind .data { set foco .data.cont supercut } bind .data { set foco .data.cont supercopy } bind .data {openrece paste} button .data.undo -text "Undo" -command { catch {.data.cont edit undo} } button .data.redo -text "Redo" -command { catch {.data.cont edit redo} } button .data.special -text "Special" -command specialbox set databutts [list .data.ins .data.cut .data.copy .data.paste \ .data.undo .data.redo .data.special] foreach butt $databutts { $butt configure -pady 0 -padx 0 -borderwidth 1 \ -bg $::buttback -fg $::buttfore pack $butt -in .data.but2 -side left -expand 1 -fill both } grid .data.but2 -row 2 -column 0 -columnspan 6 -sticky news frame .data.tx text .data.cont -bg $::textback -fg $::textfore -width 44 \ -height 8 -font $fonto -wrap word -setgrid 1 -undo 1 \ -inactiveselectbackground $::inacback scrollbar .data.roll -width 12 -command ".data.cont yview" .data.cont configure -yscrollcommand ".data.roll set" pack .data.cont .data.roll -in .data.tx \ -side left -expand 1 -fill both grid .data.tx -row 3 -column 0 -columnspan 6 -sticky news grid [label .data.celltype -text "Cell type:"] \ -row 4 -column 0 -sticky news tk_optionMenu .data.cellmenu celltype Header Data grid .data.cellmenu -row 4 -column 1 -sticky news grid [label .data.colspan -text "Column span:"] \ -row 4 -column 2 -sticky news grid [spinbox .data.colspannum -width 3 -bg $::entback -fg $::entfore \ -buttonbackground $::buttback \ -textvariable colspannum -from 1 -to 100] \ -row 4 -column 3 -sticky news grid [label .data.rowspan -text "Row span:"] \ -row 4 -column 4 -sticky news grid [spinbox .data.rowspannum -width 3 -bg $::entback -fg $::entfore \ -buttonbackground $::buttback \ -textvariable rowspannum -from 1 -to 100] \ -row 4 -column 5 -sticky news frame .data.fr1 button .data.enter -text "Enter" -default active \ -command insert_cell button .data.newrow -text "Begin new row" -default normal \ -command newrow button .data.done -text "Done" -default normal -command { if {$rowon == 1} { .tx insert insert "\t\n" } set rowon 0 destroy .data } button .data.close -text "Close" -default normal -command { destroy .data focus .tx set foco .tx } foreach butt [list .data.enter .data.newrow .data.done .data.close] { $butt configure -bg $::buttback -fg $::buttfore pack $butt -in .data.fr1 -side left -expand 1 -fill both } grid .data.fr1 -row 5 -column 0 -columnspan 6 -sticky news grid [label .data.optinfo -bg $::lightback -fg $::lightfore \ -text "O P T I O N A L I N F O R M A T I O N :" -pady 6] \ -row 6 -column 0 -columnspan 6 -sticky news grid [label .data.rowalign -text "Align in row:"] \ -row 7 -column 0 -sticky news grid [label .data.horowalign -text "Horizontal" ] \ -row 7 -column 1 -sticky news tk_optionMenu .data.horowmenu horowalign left center right grid .data.horowmenu -row 7 -column 2 -sticky news grid [label .data.vertrowalign -text "Vertical"] \ -row 7 -column 3 -sticky news tk_optionMenu .data.vertrowmenu vertrowalign \ top middle bottom baseline grid .data.vertrowmenu -row 7 -column 4 -columnspan 2 -sticky news grid [label .data.cellalign -text "Align in cell:"] \ -row 8 -column 0 -sticky news grid [label .data.horcellalign -text "Horizontal" ] \ -row 8 -column 1 -sticky news tk_optionMenu .data.horcellmenu horcellalign left center right grid .data.horcellmenu -row 8 -column 2 -sticky news grid [label .data.vertcellalign -text "Vertical"] \ -row 8 -column 3 -sticky news tk_optionMenu .data.vertcellmenu vertcellalign \ top middle bottom baseline grid .data.vertcellmenu -row 8 -column 4 -columnspan 2 -sticky news frame .data.froth frame .data.frow button .data.rowcolorsel -text "Select row color" -command { set colorcall row wishcolor } button .data.rowcolordesel -text "Deselect row color" -command { set color "" set rowcolor "" } pack .data.rowcolorsel .data.rowcolordesel -in .data.frow \ -side top -expand 1 -fill both frame .data.frell button .data.cellcolorsel -text "Select cell color" -command { set colorcall cell wishcolor } button .data.cellcolordesel -text "Deselect cell color" -command { set color "" set cellcolor "" } pack .data.cellcolorsel .data.cellcolordesel -in .data.frell \ -side top -expand 1 -fill both pack .data.frow .data.frell -in .data.froth -side left -expand 1 -fill both grid .data.froth -row 9 -column 0 -columnspan 6 -sticky news foreach butt [list .data.rowcolorsel .data.rowcolordesel \ .data.cellcolorsel .data.cellcolordesel] { $butt configure -bg $::buttback -fg $::buttfore } bind .data insert_cell bind .data { .data.cont insert insert "\n
" .data.cont edit separator .data.cont see insert } foreach {key star fin} { {\n

} {

} \ \ \
} {bind .data $key "dualcodes $star {} $fin"} bind .data { catch {.data.cont edit redo} } bind .data {.data.cont edit separator} bind .data {.data.cont edit separator} focus .data.cont set foco .data.cont bind .data {set foco .data.cont} } # Procedure to get HTML codes for row attributes from user input # ("left" and "middle" are defaults for # horizontal and vertical alignment of contents): proc get_rowcodes {} { global horowalign vertrowalign vertrowin horowin rowcolor if {$horowalign eq "left"} { set horowin "" } else { set horowin " align=\"$horowalign\"" } if {$vertrowalign eq "middle"} { set vertowin "" } else { set vertrowin " valign=\"$vertrowalign\"" } if {$rowcolor ne ""} { set rowcolor " bgcolor=\"$rowcolor\"" } } # Procedure to get HTML codes for cell attributes from user input: proc get_cellcodes {} { global colspannum rowspannum horcellalign vertcellalign \ horcellin vertcellin cellcolor rowspa colspa if {$rowspannum > 1} { set rowspa " rowspan=\"$rowspannum\"" } else { set rowspa "" } if {$colspannum > 1} { set colspa " colspan=\"$colspannum\"" } else { set colspa "" } if {$horcellalign eq "left"} { set horcellin "" } else { set horcellin " align=\"$horcellalign\"" } if {$vertcellalign == "middle"} { set vertcellin "" } else { set vertcellin " valign=\"$vertcellalign\"" } if {$cellcolor ne ""} { set cellcolor " bgcolor=\"$cellcolor\"" } } # Procedure to insert new data cell in existing row of HTML table: proc insert_cell {} { global codestart codend colspannum rowspannum horowin vertrowin \ horcellin vertcellin rowcolor cellcolor celltype rowon \ colspa rowspa set cellcontents [string trimright [.data.cont get 1.0 end-1c]] if {$rowon == 0} { get_rowcodes get_cellcodes .tx insert insert "\n" set rowon 1 } else { get_cellcodes } if {$celltype eq "Header"} { set star "\t\t" set fin "\n" } else { set star "\t\t" set fin "\n" } .tx insert insert $star$cellcontents$fin .tx edit modified wmtitle set lineno [line_number] set downfour [expr $lineno + 4] .tx see $downfour.0 .data.cont delete 1.0 end focus .data.cont } # Procedure to insert new row in HTML table with data contents: proc newrow {} { global celltype horowin vertrowin rowcolor rowon if {$celltype eq "Header"} {set celltype Data} get_rowcodes if {$rowon == 1} { .tx insert insert \ "\t\n\n\t\n" } else { .tx insert insert "\n\t\n" } if {$rowon == 0} {set rowon 1} set lineno [line_number] .tx see [expr $lineno+3].0 .tx edit separator wmtitle } .filemenu.html add separator # HTML -- Paragraph .filemenu.html add command -label "Paragraph

" -underline 0 -command { dualcodes "

" {}

} -accelerator F6 bind . {dualcodes "

" {} "

"} # HTML -- Line Break .filemenu.html add command -label "Line Break
" -underline 0 -command { .tx insert insert "
" .tx edit separator .tx see insert wmtitle } -accelerator F3 bind . { .tx insert insert "
" .tx edit separator .tx see insert wmtitle } # HTML -- Emphasis .filemenu.html add command -label "Italics " -underline 0 -command { dualcodes {} } -accelerator F8 bind . {dualcodes {} } # HTML -- Strong .filemenu.html add command -label "Bold " -underline 0 -command { dualcodes {} } -accelerator F9 bind . {dualcodes {} } # HTML -- Center .filemenu.html add command -label "Center
" -underline 5 -command { dualcodes
{}
} -accelerator Ctrl+F6 bind . {dualcodes
{}
} ### TCL/TK MENU ### menu .filemenu.tcl -tearoff 0 .filemenu add cascade -label "Tcl/Tk" -underline 0 -menu .filemenu.tcl # Tcl/Tk -- New Script .filemenu.tcl add command -label "New Script" -underline 0 \ -command new_wish -accelerator Ctrl+F5 bind . new_wish proc new_wish {} { set go [readytogo] if {$go == 0} {return} outwithold .tx insert 1.0 "#!/usr/bin/env wish\n\n# " .tx edit separator wmtitle } .filemenu.tcl add separator # Tcl/Tk -- Run Selected Code .filemenu.tcl add command -label "Run Selected Code" -underline 0 \ -command runcode -accelerator F5 bind . runcode proc runcode {} { if {[interp exists testrunner]} {interp delete testrunner} set anysel [catch {.tx get sel.first sel.last} codetorun] if {$anysel == 0} { interp create testrunner load {} Tk testrunner testrunner eval $codetorun } else { tk_messageBox -message "Please select some code to run" \ -title "Select Code" -type ok } } .filemenu.tcl add separator # Tcl/Tk -- Find Closing .filemenu.tcl add command -label "Find Closing" -underline 0 \ -command findclose -accelerator Ctrl+Alt+\[ bind . findclose proc findclose {} { global lev ope clo whence whither here # Find what to search for and where to search from: if {[catch {set ope [.tx get sel.first sel.last]}]} { set ope "" } set whence [.tx index sel.last] set whither "" set lev 1 ; # Opening found, closing not yet found switch $ope { "\{" { set clo "\}" } "\[" { set clo "\]" } "\"" { set clo $ope } default { tk_messageBox -message "Please select an opening\ brace ( \{ ), bracket ( \[ ), or quote ( \" )" -type ok return } } set here $whence findmatch if {$lev == 0 && $whither ne ""} { .tx tag add sel $whence $whither } else { tk_messageBox -message "Closing not found" -type ok } } proc findmatch {} { global lev ope clo whence whither here if {$clo eq $ope} { set whereat [.tx search $clo $whence end] } else { set up [.tx search $ope $here end] set down [.tx search $clo $here end] if {$up eq ""} { set whichendup down set whereat $down } if {$down eq ""} { set whereat "" } if {$up ne "" && $down ne ""} { if {[.tx compare $up > $down]} { set whichendup down set whereat $down } else { set whichendup up set whereat $up } } } if {$whereat ne ""} { set whatbefore [.tx get "$whereat -1c"] if {$whatbefore eq "\\"} { set here [.tx index "$whereat +1c"] findmatch } else { if {$clo eq $ope} { set whither [.tx index "$whereat +1c"] set lev 0 return } else { set here [.tx index "$whereat +1c"] if {$whichendup eq "up"} { incr lev } else { incr lev -1 } } } } if {$lev == 0} { set whither $here return } elseif {$whereat ne ""} { findmatch } } .filemenu.tcl add separator # Tcl/Tk -- Matching Braces { } .filemenu.tcl add command -label "Curly Braces \{ \}" -underline 0 -command { dualcodes "{" {} "}" } -accelerator Ctrl+\{ bind . {dualcodes "{" {} "}"} bind . { .tx mark set insert "[.tx index insert] lineend" .tx insert insert " " .tx insert insert "\{\}" .tx mark set insert "insert -1c" selection clear } .filemenu.tcl add command -label "Next Braces" -underline 2 -command { .tx mark set insert "[.tx index insert] lineend" .tx insert insert " " .tx insert insert "\{\}" .tx mark set insert "insert -1c" selection clear } -accelerator Shift+Home .filemenu.tcl add command -label "Leave Braces" -underline 0 -command { autotab stop } -accelerator Shift+Enter .filemenu.tcl add separator # Tcl/Tk -- Matching Brackets [ ] .filemenu.tcl add command -label "Square Brackets \[ \]" \ -underline 0 -command { dualcodes {[} {} {]} } -accelerator Ctrl+\[ bind . {dualcodes {[} {} {]}} # Tcl/Tk -- Matching Angle Brackets < > .filemenu.tcl add command -label "Angle Brackets < >" \ -underline 0 -command { dualcodes {<} {} {>} } -accelerator Ctrl+< bind . {dualcodes {<} {} {>}} # Tcl/Tk -- Matching Parentheses ( ) .filemenu.tcl add command -label "Parentheses ( )" \ -underline 0 -command { dualcodes {(} {} {)} } -accelerator Ctrl+( bind . {dualcodes {(} {} {)}} # Tcl/Tk -- Matching Quotes " " .filemenu.tcl add command -label "Quotes \" \"" \ -underline 0 -command { dualcodes {"} {} {"} } -accelerator Ctrl+\" bind . {dualcodes {"} {} {"}} ### DISPLAY MENU ### menu .filemenu.display -tearoff 0 .filemenu add cascade -label "Display" -underline 0 -menu .filemenu.display ### Display -- Format/Window size .filemenu.display add command -label "Format/Window Size" -underline 1 \ -command formato # Procedures to format text with newlines: proc formato {} { global texwid texhi oldwid oldhi formawid set oldwid $texwid ; set oldhi $texhi clearout if {[winfo exists .forma]} { grid .forma } else { frame .forma label .forma.hi -text "Height: " spinbox .forma.disphi -from 1 -to 100 -textvariable texhi \ -buttonbackground $::buttback -width 3 label .forma.wid -text "Window width: " spinbox .forma.dispwid -from 20 -to 200 -textvariable texwid \ -buttonbackground $::buttback -width 3 label .forma.form -text "Format to width: " spinbox .forma.formawid -from 20 -to 200 -textvariable formawid \ -buttonbackground $::buttback -width 3 button .forma.chug -text "Resize window" -command { .tx configure -height $texhi -width $texwid wm geometry . {} savefig } button .forma.ok -text "Format" -command {formatit show} button .forma.close -text "Close" -command { set texwid $oldwid set texhi $oldhi clearin .forma } pack .forma.hi .forma.disphi .forma.wid .forma.dispwid \ .forma.form .forma.formawid .forma.chug .forma.ok .forma.close \ -in .forma -side left -expand 1 -fill both grid .forma -row 1 -column 0 -columnspan 2 -sticky news } foreach spin [list .forma.disphi .forma.dispwid .forma.formawid] { $spin configure -bg $::entback -fg $::entfore } foreach butt [list .forma.chug .forma.ok .forma.close] { $butt configure -bg $::buttback -fg $::buttfore } } proc formatit {whattodo} { global formawid texwid wordwrap printorshow clearin .forma if {[winfo exists .tinga] == 0} { grid [label .tinga -text "Formatting ... may take a while for\ long text .... Please wait"] \ -row 1 -column 0 -columnspan 2 -sticky news } if {$whattodo eq "print"} { set printout [formanew print] destroy .tinga return $printout } else { .tx configure -width $formawid -wrap word wm geometry . {} after 100 { formanew show destroy .tinga .tx configure -width $texwid -wrap $wordwrap wm geometry . {} } } } proc formanew {whattodo} { global formawid # Identify beginning and end of text to format, and # omit needless newlines: omitneedless plus if {[.tx tag ranges sel] eq ""} { set selon 1.0 set seloff [.tx index end] } else { set selon [.tx index sel.first] set seloff [.tx index sel.last] } set texin [expr int($selon)] set texend [expr int($seloff)] # Initialize variable to hold output: set formatext "" # Dig in and format text: for {set i $texin} {$i <= $texend} {incr i} { # Get text to newline: set endolin [.tx index $i.end] set endochar [lindex [split $endolin "."] end] set whatline [.tx get $i.0 $endolin] # If line is blank, insert only newline into output: if {[string trim $whatline] eq ""} { append formatext "\n" continue } # If not, then find out where line is wrapped: for {set c 1} {$c <= $endochar} {incr c} { .tx see $i.$c set ceemin [expr {$c-1}] set boxie [.tx get $i.$ceemin] # Get y coordinates of bounding boxes for adjoining characters: set pixy [lindex [.tx bbox $i.$ceemin] 1] set nexy [lindex [.tx bbox $i.$c] 1] # If y coordinate of bounding box is greater than for # preceding character, line has been wrapped, so # insert preceding character plus newline into output: if {$nexy > $pixy} { append formatext $boxie\n .tx see $i.$c } else { # Otherwise, insert only the preceding character: append formatext $boxie } } # Replicate existing newline from text widget: if {$i < $texend} { append formatext "\n" } } if {$whattodo eq "print"} { return $formatext } else { .tx delete $selon $seloff .tx insert $selon $formatext .tx edit separator after 100 wmtitle } } .filemenu.display add command -label "Omit Needless Newlines" -underline 5 \ -command newlino ### Procedures to omit needless newlines: proc newlino {} { global reunito parsep clearout if {[winfo exists .need]} { grid .need } else { frame .need radiobutton .need.unite -text "Reunite broken words" \ -variable reunito -value 1 radiobutton .need.replace -text "No broken words" \ -variable reunito -value 0 checkbutton .need.par -text "Keep paragraphs separate" \ -variable parsep button .need.ok -text "Eject needless newlines" -command { omitneedless only clearin .need } button .need.close -text "Close" -pady 0 -border 1 \ -command { clearin .need } pack .need.unite .need.replace .need.par .need.ok \ .need.close -in .need -side left -expand 1 -fill both grid .need -row 1 -column 0 -columnspan 2 -sticky news } foreach reg [list .need.unite .need.replace .need.par] { $reg configure -selectcolor $::regradio -takefocus 0 } foreach butt [list .need.ok .need.close] { $butt configure -bg $::buttback -fg $::buttfore } focus .need } proc omitneedless {andwhat} { global reunito parsep if {[.tx tag ranges sel] eq ""} { set selon 1.0 set seloff [.tx index end] set selmore 0 } else { set selon [.tx index sel.first] set seloff [.tx index sel.last] set selmore 1 } set texin [expr int($selon)] set texend [expr int($seloff)] set texauld [.tx get $selon $seloff] switch "$reunito $parsep" { "1 1" { set texnoo [string map "{\n\n} {\n\n} {\n\t} {\n\t} {\n} {}"\ $texauld] } "1 0" { set texnoo [string map "{\n} {}" $texauld] } "0 1" { set texnoo [string map "{\n\n} {\n\n} {\n\t} {\n\t}\ { \n} { } {\n} { }" $texauld] } "0 0" { set texnoo [string map "{ \n} { } {\n} { }" $texauld] } } .tx delete $selon $seloff .tx insert $selon $texnoo if {$selmore == 1 && $andwhat eq "plus"} { .tx tag add sel $selon [.tx index insert] } .tx edit separator after 100 wmtitle } .filemenu.display add separator ### Display -- HTML in Browser .filemenu.display add command -label "HTML in Browser" -underline 0 \ -command {browsier $currentfile} proc browsier {fil} { global env currentfile if {$fil eq ""} { tk_messageBox -message "Please save HTML file before trying\ to display it in a browser" -type ok return } if {$env(BROWSER) ne ""} { if {[catch {eval exec $env(BROWSER) $currentfile &} outage]} { tk_messageBox -message $outage -type ok } } else { browbox } } ### Display -- Change Browser .filemenu.display add command -label "Change Browser" -underline 7 \ -command browbox proc browbox {} { global env clearout if {[winfo exists .brow]} { grid .brow .brow.ent delete 0 end .brow.ent insert 0 $env(BROWSER) .brow.ent selection range 0 end focus .brow.ent } else { frame .brow label .brow.blab -bg $::headback -fg $::headfore \ -text "Please designate a browser: " entry .brow.ent -bg $::entback -fg $::entfore .brow.ent insert 0 $env(BROWSER) .brow.ent selection range 0 end button .brow.ok -bg $::buttback -fg $::buttfore -text "OK" -command { set env(BROWSER) [.brow.ent get] clearin .brow } button .brow.close -bg $::buttback -fg $::buttfore -text "Close" \ -command {clearin .brow} pack .brow.blab .brow.ent .brow.ok .brow.close -in .brow \ -side left -expand 1 -fill both grid .brow -row 1 -column 0 -columnspan 2 -sticky news focus .brow.ent } } .filemenu.display add separator ### Display -- Colors .filemenu.display add command -label "Colors" -underline 0 -command colodisp # List of widgets (to add to lists originally set # by WISH Color Picker Plus): # Regular buttons: foreach butt [list .rece.find .rece.open .rece.all .rece.whole \ .rece.unlist .rece.close .prin.ok .prin.close .forma.chug .forma.ok \ .forma.close .need.ok .need.close .fin.clo .find.next .findex.new \ .findex.close .place.yesdo .place.nodont .place.all .place.new \ .place.close .mult.more .mult.replall .mult.close .line.ok \ .line.recount .line.close .head.insert .head.close .font.select \ .font.insertcolor .font.insertsize .font.insertboth .font.close \ .anchor.insert .anchor.close .butt.www .butt.email .butt.ftp \ .butt.anchor .butt.other .butt.insert .butt.close .image.pick \ .image.insert .image.close .html.insert .html.done .table.withdata \ .table.close .table.colorsel .table.colordesel .data.line \ .data.par .data.ital .data.bold .data.undo .data.redo .data.special \ .data.enter .data.newrow .data.done .data.close .data.rowcolorsel \ .data.rowcolordesel .data.cellcolorsel .data.cellcolordesel \ .see.ins .see.close .fontshow.ok .fontshow.close] { lappend buttlist $butt } # Mini-toolbar buttons: foreach mini $miniline { lappend minilist $mini } # Listboxes: foreach lub [list .rece.list .fontshow.list] { lappend lublist $lub } # Text widgets: foreach tex [list .tx .see.whole .data.cont] { lappend texlist $tex } # Entry widgets and spinboxes: foreach ent [list .rece.ent .rece.spin .prin.spin .forma.disphi \ .forma.dispwid .forma.formawid .find.enter .rep.enter .with.leave \ .line.number .head.enter .head.spin .font.spin .font.colornum \ .anchor.enter .url.linkent .show.name .image.url .image.altinhere \ .image.horizhere .image.vertinhere .image.heightinhere .image.widthinhere \ .image.bordohere .html.itemhere .table.suminhere .table.horizhere \ .table.vertinhere .table.heightinhere .table.widthinhere .table.bordohere \ .table.padhere .table.spacehere .data.colspannum .data.rowspannum \ .fontshow.spin] { lappend entlist $ent } # Emphasized labels: foreach head [list] { lappend headlist $head } # Light labels: foreach light [list .rece.found .line.count .image.optinfo .table.optinfo \ .data.cellcont .data.optinfo .fontshow.lab] { lappend lightlist $light } # Radiobuttons and checkbuttons: foreach reg [list .rece.new .need.unite .need.replace .need.par \ .findex.exp .findex.match .findex.up .findex.down .place.exp \ .place.up .place.down .place.match .mult.expert .mult.match \ .image.rel .image.abso .list.123 .list.capa .list.abc .list.capi \ .list.iii .list.disc .list.circle .list.square] { lappend regradiolist $reg } # Spinbox buttons: foreach spin [list .rece.spin .prin.spin .head.spin .font.spin \ .image.horizhere .image.vertinhere .image.heightinhere \ .image.widthinhere .image.bordohere .table.horizhere \ .table.vertinhere .table.heightinhere .table.widthinhere \ .table.bordohere .table.padhere .table.spacehere \ .data.colspannum .data.rowspannum .fontshow.spin .forma.disphi \ .forma.dispwid .forma.formawid] { lappend spinlist $spin } # Procedure to set up GUI box for configuring color display: proc colodisp {} { global color red green blue whatfig whatbutt colorlist \ winback winfore selback selfore buttback buttfore miniback minifore \ listback listfore textback textfore inacback linktex entback \ entfore headback headfore lightback lightfore regradio wishcolorplus ; # This does all the work--from WISH Color Picker Plus wm title .colo "WISH Supernotepad : WISH Color Picker Plus" } ### Display -- Font .filemenu.display add command -label "Font" -underline 0 -command fontshow # List available fonts: set fontlist [lsort -dictionary [font families]] # Procedure to make font selection box: proc fontshow {} { global fontlist fontgrip fonto siz fontaine toplevel .fontshow wm title .fontshow "WISH Supernotepad: Choose Font" set fontgrip $fonto grid [listbox .fontshow.list -bg $::listback -fg $::listfore -height 12 \ -width 52 -selectmode single -listvariable fontlist] \ -row 0 -column 0 -sticky news grid [scrollbar .fontshow.roll -width 12 -command ".fontshow.list yview"] \ -row 0 -column 1 -rowspan 2 -sticky news .fontshow.list configure -yscrollcommand ".fontshow.roll set" set siz 14 bind .fontshow.list { after 10 { set fontgrip [.fontshow.list get [.fontshow.list curselection]] set fontaine [list $fontgrip $siz] .fontshow.lab configure -text "$fontgrip" -font "$fontaine" } } bind .fontshow.list fontok bind .fontshow.list { set clixel %y set clickline [.fontshow.list nearest $clixel] .fontshow.list selection set $clickline set fontgrip [.fontshow.list get [.fontshow.list curselection]] set fontaine [list $fontgrip $siz] .fontshow.lab configure -text "$fontgrip" -font "$fontaine" fontok } frame .fontshow.butts label .fontshow.lab -bg $::lightback -fg $::lightfore \ -text "$fonto" -font "$fontaine" spinbox .fontshow.spin -textvariable siz -width 2 -from 8 -to 48 \ -buttonbackground $::buttback \ -bg $::entback -fg $::entfore -command { set fontaine [list $fontgrip $siz] .fontshow.lab configure -font "$fontaine" } button .fontshow.ok -text "OK" -bg $::buttback -fg $::buttfore \ -relief groove -border 3 -command fontok button .fontshow.close -text "Close" -bg $::buttback -fg $::buttfore \ -command {destroy .fontshow} pack .fontshow.lab .fontshow.spin .fontshow.ok .fontshow.close \ -in .fontshow.butts -side left -expand 1 -fill both grid .fontshow.butts -row 1 -column 0 -sticky news bind .fontshow fontok focus .fontshow.spin } # Procedure to apply and save new default font: proc fontok {} { global t fontgrip fonto siz fontaine linkup set fonto $fontgrip set fontaine [list $fonto $siz] .tx configure -font "$fontaine" $t tag configure bold -font "[list $::fonto $::siz bold]" $t tag configure ital -font "[list $::fonto $::siz italic]" $t tag configure bi -font "[list $::fonto $::siz bold italic]" $t tag configure cent -justify center $t tag configure boldcent -font "[list $::fonto $::siz bold]" \ -justify center $t tag configure italcent -font "[list $::fonto $::siz italic]" \ -justify center $t tag configure bicent -font "[list $::fonto $::siz bold italic]" \ -justify center savefig destroy .fontshow } .filemenu.display add separator ### Display -- Link-Text .filemenu.display add checkbutton -label "Link-Text" -underline 0 \ -variable lincoln -accelerator Ctrl+Alt+l -command linkuporno bind .tx { if {$lincoln} { set lincoln 0 unlink .tx } else { set lincoln 1 linktext .tx } } # Procedure to put Link-Text tags in or take them out: proc linkuporno {} { global lincoln if {$lincoln} { linktext .tx } else { unlink .tx } } # Procedure to find markup tags with Tk 8.4, which doesn't have # the "-all" flag for text-widget searches as Tk 8.5 does: proc findtags {what lister counter} { set ::present_place $::place catch {set ::place [.tx search -regexp \ -count countum "$what" "$::present_place +1c" end]} if {$::place ne ""} { lappend $lister $::place lappend $counter $countum findtags $what } else { return [list [set $lister] [set $counter]] } } # Procedure to make clickable links, hide markup tags, # and show text as bold, italic, and/or centered: proc linktext {t} { global linklist linkex linkhead # Configure tag to hide things: $t tag configure hide -elide 1 # Find end of opening "link section" of file, # beginnings and ends of all links, and # beginnings of bold, italic, and/or center tags: set linkhead [$t search "" 1.0 end] if {$linkhead ne ""} { $t tag add hide $linkhead "$linkhead +14c" } if {$::tko > 8.4} { # First find angle quotes (?) used to disguise angle brackets # that are *not* to be interpreted as designating tags, # and whip up a quick disguise: set angstars [$t search -all "?" 1.0 end] set angends [$t search -all ">? 1.0 end] $t tag configure ang -elide 1 foreach star $angstars { $t tag add hide $star $t tag add ang "$star +1c" } foreach end $angends { $t tag add ang $end $t tag add hide "$end +1c" } # Find link beginnings and ends: set linkstars [$t search -regexp -all \ -count clink "" 1.0 end] set linkends [$t search -all "" 1.0 end] # Find tag beginnings and ends: set tagstars [$t search -regexp -all -count ctag { ||||||
} 1.0 end] # Now reveal the non-tag-designating angle brackets: $t tag configure ang -elide 0 } else { # Delete this clunky code if you don't need Tk 8.4 any more set ::place 1.0 set ::angline [list] set starlog [findtags "?<" ::angline] set angstars [lindex $starlog 0] set :: place 1.0 set ::angline [list] set endlog [findtags "\>? ::angline] set angends [lindex $endlog 0] $t tag configure ang -elide 1 foreach star $angstars { $t tag add hide $star $t tag add ang "$star +1c" } foreach end $angends { $t tag add ang $end $t tag add hide "$end +1c" } set ::place 1.0 set ::linkline [list] set ::countline [list] set starlog [findtags "" ::linkline ::countline] set linkstars [lindex $starlog 0] set cti [lindex $starlog end] set ::place 1.0 set ::linkline [list] set ::countline [list] set endlog [findtags "" ::linkline ::countline] set linkends [lindex $endlog 0] set ::place 1.0 set ::taglist [list] set ::tagcount [list] set startag [findtags { ||||||
} ::taglist ::tagcount] set tagstars [lindex $startag 0] set ctag [lindex $startag end] $t tag configure ang -elide 0 unset ::linkline ::countlist ::boldlist ::bountlist ::angline } # Embolden, italicize, and/or center: $t tag configure bold -font "[list $::fonto $::siz bold]" $t tag configure ital -font "[list $::fonto $::siz italic]" $t tag configure bi -font "[list $::fonto $::siz bold italic]" $t tag configure cent -justify center $t tag configure boldcent -font "[list $::fonto $::siz bold]" \ -justify center $t tag configure italcent -font "[list $::fonto $::siz italic]" \ -justify center $t tag configure bicent -font "[list $::fonto $::siz bold italic]" \ -justify center for {set b 0} {$b < [llength $tagstars]} {incr b} { set bar [lindex $tagstars $b] ; # Begin starting tag set barsplit [split $bar "."] set barline [lindex $barsplit 0] ; # Line number in text set barchar [lindex $barsplit end] ; # Position in line set tagoff [$t search ">" $bar end] $t tag add hide $bar "$tagoff +1c" set whattag [$t get "$bar +1c" $tagoff] switch $whattag { b { set tagend [$t search "" $tagoff end] $t tag add hide $tagend "$tagend +4c" $t tag add bold $tagoff $tagend } i { set tagend [$t search "" $tagoff end] $t tag add hide $tagend "$tagend +4c" $t tag add ital $tagoff $tagend } c { set tagend [$t search "" $tagoff end] $t tag add hide $tagend "$tagend +4c" $t tag add cent $tagoff $tagend } center { set tagend [$t search "
" $tagoff end] $t tag add hide $tagend "$tagend +9c" $t tag add cent $tagoff $tagend } bi - ib { set tagend [$t search -regexp {|} $tagoff end] $t tag add hide $tagend "$tagend +5c" $t tag add bi $tagoff $tagend } bc - cb { set tagend [$t search -regexp {|} $tagoff end] $t tag add hide $tagend "$tagend +5c" $t tag add boldcent $tagoff $tagend } ic - ci { set tagend [$t search -regexp {|} $tagoff end] $t tag add hide $tagend "$tagend +5c" $t tag add italcent $tagoff $tagend } bic - ibc - bci - cbi - icb - cib { set tagend [$t search -regexp { ||||| } $tagoff end] $t tag add hide $tagend "$tagend +6c" $t tag add bicent $tagoff $tagend } } } # Fix the links up to work: $t configure -cursor top_left_arrow for {set i 0} {$i < [llength $linkstars]} {incr i} { set star [lindex $linkstars $i] ; # Begin link-start tag set starleng [lindex $clink $i] ; # Length of link-start tag set starsplit [split $star "."] set starline [lindex $starsplit 0] ; # Line number in text set starchar [lindex $starsplit end] ; # Position in line # End of link-start tag: set starend $starline.[expr {$starchar + $starleng}] # Content of link-start tag: set linkstar [$t get $star $starend] set linkname [string trim $linkstar "<>"] ; # Link name $t tag add hide $star $starend # Add tag for clickable link between link-start and link-end tags: set finis [lindex $linkends $i] $t tag add $linkname $starend $finis lappend linklist "$linkname" # And one to hide the link-end tag: $t tag add hide $finis "$finis +7c" # Get clickable tag to look right and do things: $t tag configure $linkname -foreground blue -underline 1 $t tag bind $linkname "linkfind $t" } } # Procedure to search for link name in text: proc linkfind {t} { global linkhead # See where clicked link is: set clickpos [$t index insert] # Verify that it's really a link: set tagnames [$t tag names $clickpos] set tagplace [lsearch $tagnames "link *"] if {$tagplace > -1} { # If so, strip off everything but its name: set tagname [lindex $tagnames $tagplace] set searchname [string map "{link } {} {\"} {}" $tagname] # And find where the name appears in the text: if {$linkhead ne ""} { set target [$t search "$searchname" $linkhead end] } else { set tagend [lindex [$t tag range "$tagname"] end] set target [$t search "$searchname" $tagend end] if {$target eq ""} { set target [$t search -backwards "$searchname" $tagend end] } } if {$target ne ""} { $t see $target } else { tk_messageBox -message "Link \"$searchname\" not found" -type ok } } } # Procedure to undo Link-Text display: proc unlink {t} { global linklist $t tag delete bold ital bi cent boldcent italcent bicent hide ang foreach link $linklist { $t tag delete "$link" } $t configure -cursor xterm } .filemenu.display add separator ### Display -- Word Wrap .filemenu.display add checkbutton -variable wordwrap \ -label "Word wrap" -onvalue word -offvalue none \ -underline 0 -selectcolor blue -command wraponoroff proc wraponoroff {} { global wordwrap if {$wordwrap eq "none"} { .tx configure -wrap none } else { .tx configure -wrap word } } ### HELP MENU ### menu .filemenu.help -tearoff 0 .filemenu add cascade -label "Help" -underline 0 -menu .filemenu.help set helpfile [file join $docdir superhelp_link.txt] ; # User Help Guide set licfile [file join $docdir mule_license.txt] ; # License ### Help -- About WISH Supernotepad .filemenu.help add command -label "About WISH Supernotepad" \ -underline 0 -command { tk_messageBox -message "WISH Supernotepad $version\n\ by David McClamrock\n \n\n\ Based on Tk NotePad 0.5.0\n by Joseph Acosta\n\ and \"textedit.tcl\"\n by Eric Foster-Johnson\n"\ -title "About WISH Supernotepad" -type ok } .filemenu.help add separator ### Help -- User Help .filemenu.help add command -label "User Help" -underline 0 -command superhelp # Procedure for setting up user help display proc superhelp {} { global fonto siz set oldfonto $fonto set oldsiz $siz uhelp ; # Set up user help window wm title .uhelp "WISH Supernotepad - User Help" # set helplink [open $::helpfile r] set helplink [open /home/david/9.com/wish/suite/superhelp_link.txt r] set helpcontents [read $helplink] close $helplink .uhelp.tx insert 1.0 $helpcontents linktext .uhelp.tx ; # Show links in text set fonto $oldfonto set siz $oldsiz .uhelp.tx see 1.0 } # Procedure for making user help window # (Color variables come from WISH Color Picker Plus) proc uhelp {} { global helpfont helpsiz fonto siz set fonto $helpfont set siz $helpsiz toplevel .uhelp wm title .uhelp "WISH User Help" frame .uhelp.fr0 button .uhelp.find -text "Find (F2)" -bg $::buttback -fg $::buttfore \ -command findhelp entry .uhelp.lookup -width 40 -bg $::entback -fg $::entfore pack .uhelp.find .uhelp.lookup -in .uhelp.fr0 \ -side left -expand 1 -fill both grid .uhelp.fr0 -sticky news frame .uhelp.fr1 text .uhelp.tx -width 65 -height 25 -bg $::textback -fg $::textfore \ -font "[list $helpfont $helpsiz]" -wrap word -cursor top_left_arrow scrollbar .uhelp.scrolly -width 12 -command ".uhelp.tx yview" .uhelp.tx configure -yscrollcommand ".uhelp.scrolly set" .uhelp.tx tag configure bold -font "[list $helpfont $helpsiz bold]" .uhelp.tx tag configure ital -font "[list $helpfont $helpsiz italic]" .uhelp.tx tag configure bi -font "[list $helpfont $helpsiz bold italic]" .uhelp.tx tag configure boldcent -font "[list $helpfont $helpsiz bold]" \ -justify center .uhelp.tx tag configure italcent -font "[list $helpfont $helpsiz italic]" \ -justify center .uhelp.tx tag configure bicent -font "[list $helpfont $helpsiz\ bold italic]" -justify center pack .uhelp.tx .uhelp.scrolly -in .uhelp.fr1 \ -side left -expand 1 -fill both grid .uhelp.fr1 -sticky news frame .uhelp.fr2 button .uhelp.big -text "Bigger" -command {fontsize big} button .uhelp.small -text "Smaller" -command {fontsize small} button .uhelp.close -text "Close" -command {destroy .uhelp} foreach butt [list .uhelp.big .uhelp.small .uhelp.close] { $butt configure -bg $::buttback -fg $::buttfore } pack .uhelp.big .uhelp.small .uhelp.close -in .uhelp.fr2 \ -side left -expand 1 -fill both grid .uhelp.fr2 -sticky news bind .uhelp findhelp focus .uhelp.lookup } # Procedure for changing font size in user help display: proc fontsize {how} { global helpfont helpsiz set sizzes [list 10 12 14 18 24] set siznow [lsearch $sizzes $helpsiz] if {$how eq "big" && $siznow < 4} { set helpsiz [lindex $sizzes [expr {$siznow+1}]] } if {$how eq "small" && $siznow > 0} { set helpsiz [lindex $sizzes [expr {$siznow-1}]] } if {$helpsiz == 10} { .uhelp.small configure -state disabled } else { .uhelp.small configure -state normal } if {$helpsiz == 24} { .uhelp.big configure -state disabled } else { .uhelp.big configure -state normal } .uhelp.tx configure -font "[list $helpfont $helpsiz]" .uhelp.tx tag configure bold -font "[list $helpfont $helpsiz bold]" .uhelp.tx tag configure ital -font "[list $helpfont $helpsiz italic]" .uhelp.tx tag configure bi -font "[list $helpfont $helpsiz bold italic]" .uhelp.tx tag configure boldcent -font "[list $helpfont $helpsiz bold]" \ -justify center .uhelp.tx tag configure italcent -font "[list $helpfont $helpsiz italic]" \ -justify center .uhelp.tx tag configure bicent -font "[list $helpfont $helpsiz\ bold italic]" -justify center } # Procedure for searching for user help text proc findhelp {} { set startout [.uhelp.tx index insert] set wherenow $startout set look_for [.uhelp.lookup get] set stringlength [string length $look_for] set foundit [.uhelp.tx search -nocase -forward $look_for \ $wherenow end] if {$foundit == ""} { set wherenow $startout tk_messageBox -message "Not Found" \ -title "Not Found" -type ok } else { catch {.uhelp.tx tag remove sel sel.first sel.last} .uhelp.tx tag add sel $foundit "$foundit + $stringlength chars" .uhelp.tx mark set insert "$foundit + $stringlength chars" .uhelp.tx see insert focus .uhelp.tx } } ### GET GOING ### # At last, make the menu visible: . configure -menu .filemenu # Open file from the command line, if you wish: if {[info exists argv]} { if {[file readable [lindex $argv 0]]} { set newfile [lindex $argv 0] inwithnew .tx mark set insert 1.0 set currentfile $newfile saverece .tx edit separator wmtitle } } ====== ---- [Category Editor Utility] [Category Word and Text Processing]