"Fossies" - the Fresh Open Source Software Archive 
Member "ding-1.9/ding" (22 Dec 2020, 209377 Bytes) of package /linux/privat/ding-1.9.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Bash source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
See also the latest
Fossies "Diffs" side-by-side code changes report for "ding":
1.8.1_vs_1.9.
1 #!/bin/sh
2 # the next line restarts using wish \
3 exec wish "$0" "$@"
4
5 # This is "ding",
6 # * A dictionary lookup program,
7 # * DIctionary Nice Grep,
8 # * A Front-End to [ae]grep, ispell, dict, ...
9 # * Ding {n} :: thing
10 #
11 # Copyright (c) Frank Richter <frank.richter@hrz.tu-chemnitz.de> 1999 - 2020
12 # GNU public license
13 # Ding comes with ABSOLUTELY NO WARRANTY.
14 #
15
16 set pinfo(pname) {Ding: Dictionary Lookup}
17 set pinfo(version) {1.9}
18 set pinfo(homepage) {https://www-user.tu-chemnitz.de/~fri/ding/}
19
20 set ding_usage(en) \
21 " word\tStart seaching this word
22 -x or --selection\tStart searching for selected word (X selection)
23 -m or --mini\tStart with minimal size (search form only)\n
24 -r or --remote\tStart search in an already running program
25 -R or --remote-new\tStart search in an already running program
26 \tor start a new program\n
27 --noconf\tDo not save preferences
28 -D # or --debug #\tStart with debug output, # = number (1..15)\n
29 These options may be combined, such as:
30 $argv0 -R -x\tStart searching for selected word in an already
31 \trunning program or start a new program\n"
32
33 set ding_usage(de) "
34 Suchwort\tStarte Suche nach Suchwort
35 -x oder --selection\tStarte Suche mit markiertem Text
36 -m oder --mini\tStarte in Mini-Größe (nur Sucheingabe)\n
37 -r oder --remote\tStarte Suche in bereits laufendem Programm
38 -R oder --remote-new\tStarte Suche in bereits laufendem Programm
39 \toder starte neues Programm\n
40 --noconf\tKein Speichern der Einstellungen
41 -D # oder --debug #\tDebug-Ausschriften, # = Zahl (1..15)\n
42 Die Optionen können natürlich kombiniert werden, z.B.:
43 $argv0 -R -x\tStarte Suche nach markiertem Wort in bereits
44 \tlaufendem Programm oder starte neues Programm\n"
45
46 proc Usage {} {
47 global pinfo argv0 env ding_usage
48 puts "\n$pinfo(pname) version $pinfo(version)"
49
50 if {[info exists env(LANG)] && [info exists ding_usage([string range $env(LANG) 0 1])]} {
51 puts "Usage: $argv0 \[Optionen\] \[Suchwort\]"
52 puts $ding_usage([string range $env(LANG) 0 1])
53 puts "Siehe WWW-Homepage: $pinfo(homepage)"
54 } else {
55 puts "Usage: $argv0 \[options\] \[word\]"
56 puts $ding_usage(en)
57 puts "See WWW homepage: $pinfo(homepage)"
58 }
59 }
60
61 if { ![info exists tk_version] } {
62 Usage
63 exit
64 }
65
66 if {$tk_version < 8.3} {
67 tk_messageBox -type ok -icon error -message {
68 Sorry, wish version >= 8.3 is required. Try to install a newer Tk version.
69
70 Die Version von Tcl/Tk ist zu alt, bitte Version 8.3 oder höher installieren.
71
72 Exiting ...}
73 exit
74 }
75
76 set param(isunix) [expr {$tcl_platform(platform) == {unix}}]
77 set param(iswin) [expr {$tcl_platform(platform) == {windows}}]
78
79 # Config options you may want to change:
80 # Startup file
81 set param(rcfile) [expr {$param(isunix) == 1 ? "$env(HOME)/.dingrc" : "[file dirname argv0]/dingrc.tcl"}]
82 set param(noticefile) [expr {$param(isunix) == 1 ? "$env(HOME)/.dingnotice.txt" : "[file dirname argv0]/dingntc.txt"}]
83
84 # The default search methods
85 # The provided German-English dictionary:
86 set default_searchmeth(0,name) {Dictionary}
87 set default_searchmeth(0,grepcmds) {tre-agrep agrep egrep internal_search}
88 set default_searchmeth(0,dictfile) [expr {$param(isunix) ? "/usr/share/dict/de-en.txt" : "[file dirname argv0]/de-en.txt"}]
89 set default_searchmeth(0,separator) { :: }
90 set default_searchmeth(0,language1) {Deutsch}
91 set default_searchmeth(0,language2) {English}
92 set default_searchmeth(0,foldedresult) 1
93
94 # spell checker
95 set default_searchmeth(1,name) {Spell check}
96 set default_searchmeth(1,grepcmds) {hunspell ispell aspell}
97 set default_searchmeth(1,language1) "English spell check"
98 set default_searchmeth(1,grepopts) "-B -d en_US -a"
99 # --encoding utf-8
100
101 # spell checker
102 set default_searchmeth(2,name) {Rechtschreibung}
103 set default_searchmeth(2,grepcmds) {hunspell ispell aspell}
104 set default_searchmeth(2,language1) "Deutsche Rechtschreibprüfung"
105 set default_searchmeth(2,grepopts) "-B -d de_DE -a"
106
107 # dict - english ditionary
108 set default_searchmeth(3,name) {English}
109 set default_searchmeth(3,grepcmds) {dict}
110 set default_searchmeth(3,language1) "English Dictionary"
111
112 # Fortunes
113 set default_searchmeth(4,name) {Epigram}
114 set default_searchmeth(4,grepcmds) {/usr/bin/fortune}
115 set default_searchmeth(4,language1) "Random English adage/epigram"
116 set default_searchmeth(4,grepopts) ""
117 set default_searchmeth(4,minlength) 0
118
119 # check for these search commands
120 set default_grepcmds(tre-agrep) "-h"
121 set default_grepcmds(agrep) "-h"
122 set default_grepcmds(egrep) "-h -a"
123 set default_grepcmds(dict) ""
124 set default_grepcmds(hunspell) "-B -S -a"
125 set default_grepcmds(ispell) "-B -S -a"
126 set default_grepcmds(aspell) "-B -S -a"
127 set default_grepcmds(/usr/bin/fortune) ""
128 set default_grepcmds(internal_search) ""
129
130 set default_searchopts(minlength) 2
131 set default_searchopts(maxlength) 30
132 set default_searchopts(maxresults) 200
133 set default_searchopts(shapedresult) 1
134 set default_searchopts(foldedresult) 0
135
136 set default(maxhistory) 50
137 set default(autosave) 1
138 set default(hilite) 1
139 set default(raise) 0
140 set default(params_as_menu) 0
141 set default(show_menu) 1
142 set default(umlaut_buttons) 0
143 set default(show_result) 1
144 set default(show_status) 1
145 set default(bcolor) [expr {$param(isunix) ? [. cget -background] : "#C0C0C0"}]
146 set default(fcolor) "#000000"
147
148 set default(showBalloons) 1
149 set default(balloonDelay) 800
150 array set balloonHelp {}
151 set gparam(balloonBackground) LightGoldenrodYellow
152 set default(autosearch) 0
153 set default(autosearchDelay) 1000
154 # set default(automin) 0
155 set default(autominDelay) 8000
156 set default(search_prop) 0
157 set default(win_prop) 0
158
159 if {$param(isunix)} {
160 # set lfont "-*-Helvetica-Medium-R-Normal--*-100-*-*-*-*-*-*"
161 # set bfont "-*-Helvetica-Bold-R-Normal--*-100-*-*-*-*-*-*"
162 # set sfont "-*-Helvetica-Medium-R-Normal--*-100-*-*-*-*-*-*"
163 # set default_tfont "-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*"
164 set default(lfont) {helvetica 12 normal}
165 set param(bfont) {helvetica 12 bold}
166 set param(ifont) {helvetica 12 "" italic}
167 set param(sfont) {helvetica 10 normal}
168 set default(tfont) {fixed 14 normal}
169 set default(ipafont) {lucidatypewriter 14 normal}
170
171 # Font selection
172 # show all avail. font families
173 # set param(tfonts) {}
174 # or show only this subset:
175 set param(tfonts) {courier fixed lucida helvetica times terminal bitstream* dejavu* liberation* lucida* luxi* nimbus* urw*}
176 } else {
177 set default(lfont) {Arial 10 normal}
178 set param(bfont) {Arial 10 bold}
179 set param(ifont) {Arial 10 "" italic}
180 set param(sfont) {Arial 8 normal}
181 set default(tfont) {Arial 10 normal}
182 # set default(tfont) {Courier 10 normal}
183
184 # Font selection
185 # show all avail. font families
186 set param(tfonts) {}
187 # or show only this subset:
188 # set param(tfonts) {Arial System Times Courier Verdana}
189 }
190
191 set param(tfont) $default(tfont)
192 set param(lfont) $default(lfont)
193 set param(ipafont) $default(ipafont)
194
195 set opts(case) 0
196 set opts(word) 0
197 set opts(regex) 0
198 set opts(errors) 0
199
200 ### don't change from here unless you know what you're doing .-)
201 # set defaults
202 set param(showBalloons) $default(showBalloons)
203 set param(balloonDelay) $default(balloonDelay)
204 set param(autosearch) $default(autosearch)
205 set param(autosearchDelay) $default(autosearchDelay)
206 set param(autosearch_active) 0
207 set param(autosearch_onchage_active) 0
208 # set param(automin) $default(automin)
209 set param(autominDelay) $default(autominDelay)
210 set param(autosave) $default(autosave)
211 set param(hilite) $default(hilite)
212 set param(raise) $default(raise)
213
214 set param(bcolor) $default(bcolor)
215 set param(fcolor) $default(fcolor)
216 set param(maxhistory) $default(maxhistory)
217 set param(params_as_menu) $default(params_as_menu)
218 set param(show_menu) $default(show_menu)
219 set param(umlaut_buttons) $default(umlaut_buttons)
220 set param(show_result) $default(show_result)
221 set param(show_status) $default(show_status)
222 set param(search_prop) $default(search_prop)
223 set param(win_prop) $default(win_prop)
224 set param(check_selection_active) 0
225
226 set curhistory 0
227 set inshistory 0
228 array set history_result {}
229 array set history_query {}
230 array set history_pos {}
231 array set history_fold {}
232
233 set pinfo(authormail) {frank.richter@hrz.tu-chemnitz.de}
234 set pinfo(author) "Frank Richter <$pinfo(authormail)>"
235 set pinfo(copyright) "Copyright (c) 1999 - 2020 $pinfo(author)"
236
237 set proc(pid) -1
238 set proc(pipe) {}
239 set proc(processlist) {}
240 set lines {}
241 set sigchld 0
242
243 # interface language settings
244 set languages(en) {English}
245 set languages(de) {Deutsch}
246 set default(language) {en}
247 set gparam(lang) $default(language)
248 set defaultcursor [. cget -cursor]
249
250 # Debug level
251 # 1 - main functions 2 - trace 4 - external process 8 - util
252 set param(debug) 0
253 # set param(debug) 15
254
255 # correction of height for some window managers
256 set param(add_geom_height) 0
257
258
259 # English messages
260 set s(en)(file) "File"
261 set s(en)(newwin) "New window"
262 set s(en)(quit) "Quit"
263 set s(en)(save) "Save"
264 set s(en)(saveall) "Save all"
265 set s(en)(mail) "Send corrections"
266 set s(en)(options) "Preferences"
267 set s(en)(params) "Search options"
268 set s(en)(soptions) "Search preferences..."
269 set s(en)(general) "General preferences..."
270 set s(en)(saveopts) "Save preferences"
271 set s(en)(help) "Help"
272 set s(en)(khelp) "Keys"
273 set s(en)(abbhelp) "Abbreviations"
274 set s(en)(cmdline) "Start options"
275 set s(en)(about) "About"
276 set s(en)(ctl) "Ctrl"
277 set s(en)(shift) "Shift"
278 set s(en)(space) "Space"
279 set s(en)(up) "Up"
280 set s(en)(down) "Down"
281 set s(en)(noback) "No previous search results."
282 set s(en)(noforw) "No more search results."
283 set s(en)(query) "Search word:"
284 set s(en)(searchmeth) "Search methods"
285 set s(en)(configured) "Configured"
286 set s(en)(search) "Search"
287 set s(en)(searchhelp) "Click left: Start search method\nClick middle: Search in result"
288 set s(en)(clear) "Clear"
289 set s(en)(clearhelp) "Erase search word, also with Esc key"
290 set s(en)(minimize) "Minimize window"
291 set s(en)(normalsize) "Show full window"
292 set s(en)(word)(0) "full words"
293 set s(en)(word)(1) "partial search"
294 set s(en)(case)(0) "ignore case"
295 set s(en)(case)(1) "exact case"
296 set s(en)(errors) "errors"
297 set s(en)(error) "error"
298 set s(en)(closestmatch) "best match"
299 set s(en)(regex)(0) "simple search"
300 set s(en)(regex)(1) "reg. expression"
301 set s(en)(cmd) "Search with"
302 set s(en)(bbhistory) "Previous results"
303 set s(en)(bfhistory) "Next results"
304 set s(en)(bwords) "Search for full words\nor partial matches?"
305 set s(en)(bcase) "Search case insensitive or sensitive?"
306 set s(en)(berrors) "Try error correction?"
307 set s(en)(bregex) "Simple patterns with *\nor regular expressions?"
308 set s(en)(color) "Select color"
309 set s(en)(results) "results"
310 set s(en)(result) "result"
311 set s(en)(noresults) "No results for"
312 set s(en)(notfound) "Search word not found"
313 set s(en)(correct) "Correctly spelled, no suggestions"
314 set s(en)(suggestion) "Suggestions"
315 set s(en)(nosuggestion) "Spelling is wrong or unknown, no suggestions"
316 set s(en)(root) "word root"
317 set s(en)(searcho) "Set search options"
318 set s(en)(searchm) "Set search methods"
319 set s(en)(apply) "Apply"
320 set s(en)(default) "Default"
321 set s(en)(cancel) "Cancel"
322 set s(en)(dictfile) "Dictionary file"
323 set s(en)(nodictfile) "No Dictionary file found! See Preferences | Search prefences ..."
324 set s(en)(new) "New"
325 set s(en)(edit) "Change"
326 set s(en)(delete) "Delete"
327 set s(en)(hilite) "Highlight text in result window when mouse over"
328 set s(en)(raise) "Bring window on top when search finished"
329 set s(en)(automin) "Minimize window automatically"
330 set s(en)(autosave) "Save options whenever changed"
331 set s(en)(lang) "Language"
332 set s(en)(sep) "Separator"
333 set s(en)(maxresults) "Max. number of results"
334 set s(en)(minlength) "Min. length of search word"
335 set s(en)(maxlength) "Max. length of search word"
336 set s(en)(params_as_menu) "Show search parameters"
337 set s(en)(show_menu) "Show menu bar"
338 set s(en)(show_menu_desc) "To bring menu back click with right mouse button"
339 set s(en)(hide_menu) "Hide menu bar"
340 set s(en)(umlaut_buttons) "Show umlaut buttons"
341 set s(en)(show_result) "Show search form only "
342 set s(en)(show_status) "Show status line"
343 set s(en)(hide_status) "Hide status line"
344 set s(en)(fg) "Foreground color..."
345 set s(en)(bg) "Background color..."
346 set s(en)(change) "Swap"
347 set s(en)(maxhistory) "Remember how many results"
348 set s(en)(balloon) "Show balloon help"
349 set s(en)(after) "after"
350 set s(en)(ms) "msec"
351 set s(en)(autosearch) "Start searching automatically"
352 set s(en)(mailtitle) "Send e-mail to"
353 set s(en)(send) "Send e-mail"
354 set s(en)(notext) "No text for your e-mail?\nNo message sent."
355 set s(en)(nomail) "Please send your suggestions with a mail program to"
356 set s(en)(notice) "Write a notice"
357 set s(en)(attachnotice) "Include notices"
358 set s(en)(nosave) "No search results to save!"
359 set s(en)(tooshort) "Search word too short!"
360 set s(en)(toolong) "Search word too long!"
361 set s(en)(more) "(found more, max limit reached)"
362 set s(en)(tfont) "Result font"
363 set s(en)(lfont) "Other font"
364 set s(en)(larger_font) "Increase font size"
365 set s(en)(smaller_font) "Decrease font size"
366 set s(en)(default_font) "Default font size"
367 set s(en)(defaultdict) "De <-> En"
368 set s(en)(shaped) "Results shaped"
369 set s(en)(folded) "Results folded"
370 set s(en)(name) "Name"
371 set s(en)(grepcmd) "Search command"
372 set s(en)(grepopts) "Options"
373 set s(en)(noagrep) "The \"agrep\" command wasn't found on your system.
374 Some functions won't be available for searching.\n
375 As a recommendation - install agrep.
376 You'll find it in a special agrep package or within the Glimpse package.\n
377 We will use for now: "
378 set s(en)(changes_later) "Some changes will come into effect after program restart."
379 set s(en)(kill) "Search process was stopped."
380 set s(en)(nokill) "Couldn't stop search process."
381 set s(en)(namerequired) "Please give a name to this search method."
382 set s(en)(props) "Search behaviour"
383 set s(en)(change_props) "Change search behaviour"
384 set s(en)(onrequest) "Search on input / middle mouse button"
385 set s(en)(onmouseover) "Search on mouse over"
386 set s(en)(onselection) "Search on new text selection"
387 set s(en)(min_none) "Don't minimize window automatically"
388 set s(en)(min_focus_delay) "Minimize window delayed"
389 set s(en)(min_focus) "Minimize window when mouse out"
390 set s(en)(clipboard_copy_line) "Copy current line to clipboard"
391 set s(en)(clipboard_copy_all) "Copy current result to clipboard"
392
393 # German messages
394 set s(de)(file) "Datei"
395 set s(de)(newwin) "Neues Fenster"
396 set s(de)(quit) "Beenden"
397 set s(de)(save) "Speichern"
398 set s(de)(saveall) "Alles speichern"
399 set s(de)(mail) "Korrektur senden"
400 set s(de)(options) "Einstellungen"
401 set s(de)(params) "Suchparameter"
402 set s(de)(soptions) "Suchmethoden..."
403 set s(de)(general) "Allgemein..."
404 set s(de)(saveopts) "Einstellungen speichern"
405 set s(de)(help) "Hilfe"
406 set s(de)(khelp) "Tastatur"
407 set s(de)(abbhelp) "Abkürzungen"
408 set s(de)(cmdline) "Startoptionen"
409 set s(de)(about) "Info"
410 set s(de)(ctl) "Strg"
411 set s(de)(shift) "Umschalt"
412 set s(de)(space) "Leer"
413 set s(de)(up) "Hoch"
414 set s(de)(down) "Runter"
415 set s(de)(noback) "Keine früheren Suchergebnisse."
416 set s(de)(noforw) "Keine weiteren Suchergebnisse."
417 set s(de)(query) "Suchwort:"
418 set s(de)(searchmeth) "Suchmethoden"
419 set s(de)(configured) "Eingestellte"
420 set s(de)(search) "Suche"
421 set s(de)(searchhelp) "Klick links: Suchmethode starten\nKlick mittel: Suche in Ergebnis"
422 set s(de)(clear) "Löschen"
423 set s(de)(clearhelp) "Lösche Suchwort, auch mit Esc-Taste"
424 set s(de)(minimize) "Fenster minimieren"
425 set s(de)(normalsize) "Volles Fenster anzeigen"
426 set s(de)(word)(0) "ganze Wörter"
427 set s(de)(word)(1) "Teilsuche"
428 set s(de)(case)(0) "Groß/klein egal"
429 set s(de)(case)(1) "Groß/klein exakt"
430 set s(de)(errors) "Fehler"
431 set s(de)(error) "Fehler"
432 set s(de)(closestmatch) "bis Treffer"
433 set s(de)(regex)(0) "einfache Suche"
434 set s(de)(regex)(1) "reg. Ausdrücke"
435 set s(de)(cmd) "Suche mit"
436 set s(de)(bbhistory) "Frühere Suchergebnisse"
437 set s(de)(bfhistory) "Weitere Suchergebnisse"
438 set s(de)(bwords) "Suche nach vollständigen Wörtern\noder Muster in Wörtern?"
439 set s(de)(bcase) "Unterscheidung Groß-/Kleinschreibweise?"
440 set s(de)(berrors) "Versuche Fehlerkorrektur?"
441 set s(de)(bregex) "Einfache Muster mit * oder\nkomplexe reguläre Ausdrücke?"
442 set s(de)(color) "Farbauswahl"
443 set s(de)(results) "Ergebnisse"
444 set s(de)(result) "Ergebnis"
445 set s(de)(noresults) "Kein Ergebnis für"
446 set s(de)(notfound) "Suchbegriff nicht gefunden"
447 set s(de)(correct) "Richtige Schreibweise, keine Vorschläge"
448 set s(de)(suggestion) "Vorschläge"
449 set s(de)(nosuggestion) "Falsche oder unbekannte Schreibweise, keine Vorschläge"
450 set s(de)(root) "Wortstamm"
451 set s(de)(searcho) "Suchmethoden einstellen"
452 set s(de)(searchm) "Suchmethoden festlegen"
453 set s(de)(apply) "Übernehmen"
454 set s(de)(default) "Standard"
455 set s(de)(cancel) "Abbrechen"
456 set s(de)(dictfile) "Wörterbuch-Datei"
457 set s(de)(nodictfile) "Keine Wörterbuch-Datei gefunden! Siehe Einstellungen | Suchmethoden"
458 set s(de)(new) "Neu"
459 set s(de)(edit) "Ändern"
460 set s(de)(delete) "Entfernen"
461 set s(de)(lang) "Sprache"
462 set s(de)(sep) "Trennzeichen"
463 set s(de)(maxresults) "Maximalanzahl von Ergebnissen"
464 set s(de)(minlength) "Minimale Länge des Suchwortes"
465 set s(de)(maxlength) "Maximale Länge des Suchwortes"
466 set s(de)(params_as_menu) "Suchparameter anzeigen"
467 set s(de)(show_menu) "Menüleiste anzeigen"
468 set s(de)(show_menu_desc) "Menüleiste wiederherstellen mit rechter Maustaste"
469 set s(de)(hide_menu) "Menüleiste verbergen"
470 set s(de)(umlaut_buttons) "Umlautknöpfe anzeigen"
471 set s(de)(show_result) "Nur Suchmaske anzeigen"
472 set s(de)(show_status) "Statuszeile anzeigen"
473 set s(de)(hide_status) "Statuszeile verbergen"
474 set s(de)(fg) "Vordergrundfarbe..."
475 set s(de)(bg) "Hintergrundfarbe..."
476 set s(de)(change) "Vertauschen"
477 set s(de)(maxhistory) "Merken wievieler Ergebnisse"
478 set s(de)(balloon) "Hilfen anzeigen"
479 set s(de)(after) "nach"
480 set s(de)(ms) "ms"
481 set s(de)(autosearch) "Suche automatisch beginnen"
482 set s(de)(automin) "Fenster automatisch minimieren"
483 set s(de)(hilite) "Ergebniszeile unter Mauszeiger hervorheben"
484 set s(de)(raise) "Fenster in Vordergrund heben, wenn Suche fertig"
485 set s(de)(autosave) "Einstellungen bei Änderung sofort speichern"
486 set s(de)(mailtitle) "Sende E-Mail an"
487 set s(de)(send) "E-Mail absenden"
488 set s(de)(notext) "Kein Text in der E-Mail?\nKeine Nachricht gesendet."
489 set s(de)(nomail) "Bitte senden Sie Ihre E-Mail mit einem Mail-Programm
490 an"
491 set s(de)(notice) "Notiz schreiben"
492 set s(de)(attachnotice) "Notizen einlesen"
493 set s(de)(nosave) "Noch keine Suchergebnisse zum Abspeichern."
494 set s(de)(tooshort) "Suchbegriff zu kurz!"
495 set s(de)(toolong) "Suchbegriff zu lang!"
496 set s(de)(more) "(weitere vorhanden, Suche abgebrochen)"
497 set s(de)(tfont) "Schriftart für Resultat"
498 set s(de)(lfont) "Sonstige Schriftart"
499 set s(de)(larger_font) "Schrift vergrößern"
500 set s(de)(smaller_font) "Schrift verkleinern"
501 set s(de)(default_font) "Standard-Schriftgröße"
502 set s(de)(defaultdict) "De <-> En"
503 set s(de)(shaped) "Resultate farblich abgesetzt"
504 set s(de)(folded) "Resultate eingeklappt"
505 set s(de)(name) "Name"
506 set s(de)(grepcmd) "Such-Kommando"
507 set s(de)(grepopts) "Optionen"
508 set s(de)(noagrep) "Das Kommando \"agrep\" wurde in Ihrem System nicht gefunden.
509 Dadurch stehen einige Funktionen nicht zur Verfügung.\n
510 Empfehlung: agrep installieren!
511 Sie finden es in einem speziellen agrep-Paket oder im glimpse-Paket.\n
512 Jetzt wird verwendet: "
513 set s(de)(changes_later) "Einige Änderungen werden erst nach Neustart des Programmes sichtbar."
514 set s(de)(kill) "Suchvorgang wurde gestoppt."
515 set s(de)(nokill) "Suchvorgang konnte nicht gestoppt werden."
516 set s(de)(namerequired) "Bitte dieser Suchmethode einen Namen geben."
517 set s(de)(props) "Suchverhalten"
518 set s(de)(change_props) "Ändere Suchverhalten"
519 set s(de)(onrequest) "Suche erst nach Eingabe/mittl. Maustaste"
520 set s(de)(onmouseover) "Suche sobald Maus über Fenster"
521 set s(de)(onselection) "Suche sofort bei neuer Textauswahl"
522 set s(de)(min_none) "Fenster nicht automatisch minimieren"
523 set s(de)(min_focus_delay) "Fenster verzögert minimieren"
524 set s(de)(min_focus) "Fenster sofort minimieren, wenn Fokus woanders"
525 set s(de)(clipboard_copy_line) "Aktuelle Zeile in Zwischenablage"
526 set s(de)(clipboard_copy_all) "Suchergebnis in Zwischenablage"
527
528 # Debug procedure
529 proc debug {level s} {
530 # levels:
531 # 1 - main function tracing (begin, parameters, end)
532 # 2 - minor function tracing
533 # 4 - communication with external programs
534 # 8 - others ...
535 global param
536 if [expr $param(debug) & $level] {
537 set time [clock format [clock seconds] -format "%T"]
538 puts stderr "$time $level $s"
539 }
540 }
541
542 if {$param(iswin) == 1} {
543 set l [registry get {HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\Language} Default]
544 if {$l == "0407"} { # DE
545 set default(language) "de"
546 set gparam(lang) "de"
547 }
548 } elseif {$param(isunix) == 1} {
549 # if Shell variable LANG set AND we've defined this language,
550 # set this as default
551 if [info exists env(LANG)] {
552 foreach l [array names languages] {
553 if [string match "$l*" $env(LANG)] {
554 set default(language) $l
555 set gparam(lang) $l
556 break
557 }
558 }
559 # check for UTF-8, as in "de_DE.UTF-8"
560 # regsub {\.UTF-8} $env(LANG) {} env(LANG)
561 # puts stderr "LANG is $env(LANG)"
562 }
563 }
564
565 proc errorBox {msg} {
566 tk_messageBox -message $msg -type ok -icon error
567 }
568
569 # for flag -remote: send a command to a running ding
570 proc remote {query} {
571 debug 1 "remote $query"
572
573 # my own application name
574 regsub { .*} [tk appname] {} myname
575 debug 8 " myname = $myname"
576
577 # find an alway running application ...
578 foreach i [lsort [winfo interps]] {
579 if [string match "${myname}*" $i] {
580 debug 4 " send $i querydictsearch $query"
581 set result [catch [list send $i [concat querydictsearch [list $query]]] msg]
582 if {$result != 0} {
583 # error - try next
584 debug 4 " returns: $result"
585 } else {
586 # ok
587 return 0
588 }
589 }
590 }
591 # error
592 return 1
593 }
594
595 ############### main
596
597 # check command line parameters
598 set mini 0
599 set gparam(noconf) 0
600 set remote 0
601 set new 0
602 set query {}
603 set last_selection {}
604
605 for {set a 0} {$a < $argc} {incr a} {
606 set arg [lindex $argv $a]
607 if {([string compare $arg "--help"] == 0) ||
608 ([string compare $arg "-h"] == 0)} {
609 Usage
610 exit
611 } elseif {([string compare $arg "--remote"] == 0) ||
612 ([string compare $arg "-r"] == 0)} {
613 set remote 1
614 } elseif {([string compare $arg "--remote-new"] == 0) ||
615 ([string compare $arg {-R}] == 0)} {
616 set remote 1
617 set new 1
618 } elseif {([string compare $arg {--selection}] == 0) ||
619 ([string compare $arg {-x}] == 0)} {
620 # first search with current X selection
621 if {$param(isunix)} {
622 catch {set q [selection get]}
623 } else {
624 catch {set q [selection get -selection CLIPBOARD]}
625 }
626 if {[info exists q] && [string length $q] > 0} {
627 if {$opts(regex) == 0} { # replace regex characters
628 regsub -all {[*|\]\[]} $q {} q
629 }
630 if {[string length $q] > 0} {
631 set query $q
632 set last_selection $q
633 }
634 }
635 } elseif {([string compare $arg "--mini"] == 0) ||
636 ([string compare $arg "-m"] == 0)} {
637 set mini 1
638 } elseif {([string compare $arg "--noconf"] == 0)} {
639 set gparam(noconf) 1
640 set param(autosave) 0
641 } elseif {([string compare $arg "--debug"] == 0) ||
642 ([string compare $arg "-D"] == 0)} {
643 incr a
644 if {$a < $argc} {
645 set param(debug) [lindex $argv $a]
646 }
647 } elseif {! [string match {-*} $arg]} {
648 # argument is a search query
649 set query "$query $arg"
650 }
651 }
652
653 debug 1 "end of argument parsing: remote = $remote new = $new, query = $query, mini = $mini"
654 if {$remote} {
655 # send a command to a running ding
656 set ret 1
657 if [string length $query] {
658 set ret [remote $query]
659 }
660 debug 1 "remote exit $ret"
661 # if send was ok or no new window -> exit
662 if {($ret == 0) || (! $new)} {
663 exit $ret
664 }
665 }
666
667 # read user's config file if existing
668 if [file readable $param(rcfile)] {
669 set err [catch "source $param(rcfile)" errmsg]
670 if $err {
671 errorBox "Error in config file $param(rcfile):\n$errmsg"
672 exit
673 }
674 }
675
676 # check if we have tkTable extension
677 if {0} {
678 if {[string match {} [info commands table]] &&
679 [catch {package require Tktable} err] &&
680 [catch {load [file join [pwd] Tktable[info sharedlibextension]]} err]} {
681 debug 1 "No tkTable: $err"
682 set hastable 0
683 } else {
684 debug 1 "Tktable v[package provide Tktable] loaded"
685 set hastable 1
686 }
687 }
688
689 array set avail_cmds {}
690
691 proc cmd_avail {cmd} {
692 global env param avail_cmds
693
694 debug 2 "cmd_avail $cmd"
695 if [string match "internal_*" $cmd] {
696 return 1
697 } elseif {[llength [array get avail_cmds $cmd]] > 1} {
698 # found earlier
699 return 1
700 } elseif {$param(isunix)} {
701 if {[string index $cmd 0] == "/" && [file isfile $cmd] && [file executable $cmd]} {
702 debug 8 "Found $cmd"
703 set avail_cmds($cmd) 1
704 return 1
705 }
706 if {[llength [array get env PATH]] < 1} {
707 return 0
708 }
709 foreach p [split $env(PATH) :] {
710 if {[file isfile "$p/$cmd"] && [file executable "$p/$cmd"]} {
711 debug 8 "Found $p/$cmd"
712 set avail_cmds($cmd) 1
713 return 1
714 }
715 }
716 } else {
717 if {[file executable $cmd] || [file executable "$cmd.exe"]} {
718 # errorBox "Found $cmd.exe"
719 return 1
720 }
721 }
722 return 0
723 }
724
725 # check available search commands
726 set gparam(grepcmd) {}
727 foreach c [array names default_grepcmds] {
728 if [cmd_avail $c] {
729 if {$gparam(grepcmd) == ""} { # default search cmd
730 set gparam(grepcmd) $c
731 }
732 debug 2 "--- $c $default_grepcmds($c)"
733 set grepcmds($c) "$default_grepcmds($c)"
734 }
735 }
736
737 set cmds 0
738
739 # 1.0 options - no prog_version used
740 # do backward compatibility
741
742 if { ! [info exists ding_version]} {
743 # 1.0 options - no prog_version used
744 # or new user
745 set searchmeth(0,name) [set s(en)(defaultdict)]
746 set searchmeth(0,type) 0
747 foreach i [array names default_searchopts] {
748 set searchmeth(0,$i) $default_searchopts($i)
749 }
750 if [info exists dictfile] {
751 set searchmeth(0,dictfile) $dictfile
752 } else {
753 set searchmeth(0,dictfile) $default_searchmeth(0,dictfile)
754 }
755 set searchmeth(0,dictfiles) [glob -nocomplain $searchmeth(0,dictfile)]
756 if [info exists language1] {
757 set searchmeth(0,language1) $language1
758 } else {
759 set searchmeth(0,language1) $default_searchmeth(0,language1)
760 }
761 if [info exists language2] {
762 set searchmeth(0,language2) $language2
763 } else {
764 set searchmeth(0,language2) $default_searchmeth(0,language2)
765 }
766 if [info exists separator] {
767 set searchmeth(0,separator) $separator
768 } elseif [info exists default_searchmeth(0,separator)] {
769 set searchmeth(0,separator) $default_searchmeth(0,separator)
770 } else {
771 set searchmeth(0,separator) {}
772 }
773 if [info exists maxlength] {
774 set searchmeth(0,maxlength) $maxlength
775 } elseif [info exists default_searchmeth(0,maxlength)] {
776 set searchmeth(0,maxlength) $default_searchmeth(0,maxlength)
777 }
778 if [info exists maxresults] {
779 set searchmeth(0,maxresults) $maxresults
780 } elseif [info exists default_searchmeth(0,maxresults)] {
781 set searchmeth(0,maxresults) $default_searchmeth(0,maxresults)
782 }
783 if [info exists minlength] {
784 set searchmeth(0,minlength) $minlength
785 } elseif [info exists default_searchmeth(0,minlength)] {
786 set searchmeth(0,minlength) $default_searchmeth(0,minlength)
787 }
788 set searchmeth(0,shapedresult) $default_searchopts(shapedresult)
789 set searchmeth(0,foldedresult) $default_searchmeth(0,foldedresult)
790 if [info exists grepcmd] {
791 set searchmeth(0,grepcmd) $grepcmd
792 } else {
793 # evtl. spezifisches grep cmd
794 foreach c $default_searchmeth(0,grepcmds) {
795 if [info exists grepcmds($c)] {
796 set searchmeth(0,grepcmd) $c
797 break
798 }
799 }
800 }
801 if [info exists grepopts] {
802 set searchmeth(0,grepopts) $grepopts
803 } else {
804 set searchmeth(0,grepopts) "$grepcmds($searchmeth(0,grepcmd))"
805 }
806
807 set searchmeth(0,avail) 1
808 set searchmpos 0
809
810 # Enable other available search methods
811 for {set m 1} {[info exists default_searchmeth($m,name)]} {incr m} {
812 foreach c $default_searchmeth($m,grepcmds) {
813 if [info exists grepcmds($c)] {
814 set searchmeth($m,name) $default_searchmeth($m,name)
815 set searchmeth($m,type) $m
816 set searchmeth($m,grepcmd) $c
817 if [info exists default_searchmeth($m,grepopts)] {
818 set searchmeth($m,grepopts) $default_searchmeth($m,grepopts)
819 } else {
820 set searchmeth($m,grepopts) $grepcmds($c)
821 }
822 foreach i [array names default_searchopts] {
823 set searchmeth($m,$i) $default_searchopts($i)
824 }
825 if [info exists default_searchmeth($m,dictfile)] {
826 set searchmeth($m,dictfile) $default_searchmeth($m,dictfile)
827 } else {
828 set searchmeth($m,dictfile) {}
829 }
830 set searchmeth($m,dictfiles) [glob -nocomplain $searchmeth($m,dictfile)]
831 if [info exists default_searchmeth($m,language1)] {
832 set searchmeth($m,language1) $default_searchmeth($m,language1)
833 } else {
834 set searchmeth($m,language1) {}
835 }
836 if [info exists default_searchmeth($m,language2)] {
837 set searchmeth($m,language2) $default_searchmeth($m,language2)
838 } else {
839 set searchmeth($m,language2) {}
840 }
841 if [info exists default_searchmeth($m,separator)] {
842 set searchmeth($m,separator) $default_searchmeth($m,separator)
843 } else {
844 set searchmeth($m,separator) {}
845 }
846 if [info exists default_searchmeth($m,maxlength)] {
847 set searchmeth($m,maxlength) $default_searchmeth($m,maxlength)
848 }
849 if [info exists default_searchmeth($m,maxresults)] {
850 set searchmeth($m,maxresults) $default_searchmeth($m,maxresults)
851 }
852 if [info exists default_searchmeth($m,minlength)] {
853 set searchmeth($m,minlength) $default_searchmeth($m,minlength)
854 }
855 if [info exists default_searchmeth($m,shapedresult)] {
856 set searchmeth($m,shapedresult) $default_searchmeth($m,shapedresult)
857 }
858 if [info exists default_searchmeth($m,foldedresult)] {
859 set searchmeth($m,foldedresult) $default_searchmeth($m,foldedresult)
860 }
861 set searchmeth($m,avail) 1
862 lappend searchmpos $m
863
864 break
865 }
866 }
867 }
868
869 if [info exists maxhistory] {
870 set param(maxhistory) $maxhistory
871 }
872 if [info exists fcolor] {
873 set param(fcolor) $fcolor
874 }
875 if [info exists bcolor] {
876 set param(bcolor) $bcolor
877 }
878 if [info exists tfont] {
879 set param(tfont) $tfont
880 }
881 if [info exists lang] {
882 set gparam(lang) $lang
883 }
884
885 } else {
886 if {$searchmpos == ""} {
887 set searchmpos 0
888 }
889 foreach i $searchmpos {
890 if [cmd_avail $searchmeth($i,grepcmd)] {
891 incr cmds
892 set searchmeth($i,avail) 1
893 } else {
894 set searchmeth($i,avail) 0
895 }
896
897 if {! [info exists searchmeth($i,foldedresult)]} {
898 set fold [expr {[info exists default_searchmeth($i,foldedresult)] ? $default_searchmeth($i,foldedresult) : $default_searchopts(foldedresult)}]
899 debug 2 "set searchmeth($i,foldedresult) to $fold"
900 set searchmeth($i,foldedresult) $fold
901 }
902
903 # Change path of default ger-eng.txt when upgrading from version 1.1
904 if {$searchmeth($i,dictfile) == {/usr/dict/ger-eng.txt} &&
905 $ding_version == {1.1}} {
906 set searchmeth($i,dictfile) $default_searchmeth(0,dictfile)
907 debug 2 "New path and name of ger-eng.txt configured: $default_searchmeth(0,dictfile)"
908 } elseif {$searchmeth($i,dictfile) == {/usr/share/dict/ger-eng.txt}} {
909 set searchmeth($i,dictfile) $default_searchmeth(0,dictfile)
910 debug 2 "New name of ger-eng.txt configured: $default_searchmeth(0,dictfile)"
911 }
912
913 set df [glob -nocomplain $searchmeth($i,dictfile)]
914 set searchmeth($i,dictfiles) $df
915 }
916 }
917 if [expr $param(debug) & 8] {
918 debug 8 "Search methods:"
919 foreach m [lsort [array names searchmeth]] {
920 puts stderr " $m: $searchmeth($m)"
921 }
922 }
923 set param(cursearchmeth) 0
924
925 # set program colors
926 if {[string length $param(bcolor)] != 7 ||
927 [scan $param(bcolor) "#%2x%2x%2x" red green blue] != 3 ||
928 [string length $param(fcolor)] != 7 ||
929 [scan $param(fcolor) "#%2x%2x%2x" red green blue] != 3} {
930
931 set param(bcolor) $default(bcolor)
932 set param(fcolor) $default(fcolor)
933 }
934 tk_setPalette foreground $param(fcolor) background $param(bcolor)
935
936 if { ![string compare $gparam(grepcmd) ""] && $cmds < 1} {
937 # no search command found ...
938 errorBox "No grep commands like [array names default_grepcmds] found.
939 Check your PATH and/or install a grep command.
940 Exiting ..."
941 exit
942 }
943 # Define Font names
944 proc defFonts {} {
945 global param
946 # Pixel size for Unix - looks better
947 set pixel [expr {$param(isunix) ? "-" : ""}]
948
949 if [string length [lindex $param(lfont) 2]] {
950 set weight [lindex $param(lfont) 2]
951 } else {
952 set weight {normal}
953 }
954 font create lfont -family [lindex $param(lfont) 0] \
955 -size $pixel[lindex $param(lfont) 1] -weight $weight
956
957 if [string length [lindex $param(bfont) 2]] {
958 set weight [lindex $param(bfont) 2]
959 } else {
960 set weight {bold}
961 }
962 font create bfont -family [lindex $param(bfont) 0] \
963 -size $pixel[lindex $param(bfont) 1] -weight $weight
964
965 if [string length [lindex $param(ifont) 3]] {
966 set slant [lindex $param(ifont) 3]
967 } else {
968 set slant {italic}
969 }
970 font create ifont -family [lindex $param(ifont) 0] \
971 -size $pixel[lindex $param(ifont) 1] -slant $slant
972
973 if [string length [lindex $param(sfont) 2]] {
974 set weight [lindex $param(sfont) 2]
975 } else {
976 set weight {normal}
977 }
978 font create sfont -family [lindex $param(sfont) 0] \
979 -size $pixel[lindex $param(sfont) 1] -weight $weight
980
981 if [string length [lindex $param(tfont) 2]] {
982 set weight [lindex $param(tfont) 2]
983 } else {
984 set weight {normal}
985 }
986 font create tfont -family [lindex $param(tfont) 0] \
987 -size $pixel[lindex $param(tfont) 1] -weight $weight
988
989 if [string length [lindex $param(ipafont) 2]] {
990 set weight [lindex $param(ipafont) 2]
991 } else {
992 set weight {normal}
993 }
994 font create ipafont -family [lindex $param(ipafont) 0] \
995 -size $pixel[lindex $param(ipafont) 1] -weight $weight
996
997 # font create ipafont -family lucidatypewriter -size -14 -weight normal
998 }
999
1000 # Change result font: how - 1 = bigger, -1 = smaller, 0 = default
1001 proc change_font {how} {
1002 global param default
1003 if {$how == 0} { # default
1004 set param(tfont) [list [lindex $param(tfont) 0] [lindex $default(tfont) 1] [lindex $param(tfont) 2]]
1005 set param(ifont) [list [lindex $param(ifont) 0] [lindex $default(tfont) 1] [lindex $param(ifont) 2] [lindex $param(ifont) 3]]
1006 set param(ipafont) [list [lindex $param(ipafont) 0] [lindex $default(ipafont) 1] [lindex $param(ipafont) 2]]
1007 } else {
1008 set fs [expr [lindex $param(tfont) 1] + $how]
1009 if {$fs > 4} { # greater than minimum font size
1010 set param(tfont) [list [lindex $param(tfont) 0] $fs [lindex $param(tfont) 2]]
1011 set param(ifont) [list [lindex $param(ifont) 0] $fs [lindex $param(ifont) 2] [lindex $param(ifont) 3]]
1012 set param(ipafont) [list [lindex $param(ipafont) 0] $fs [lindex $param(ipafont) 2]]
1013 }
1014 }
1015 chFont tfont
1016 chFont ifont
1017 chFont ipafont
1018 .statusBar.lab config -foreground $param(fcolor) -text "$param(tfont)"
1019 }
1020
1021 proc chFont {font} {
1022 global param
1023 # Pixel size for Unix - looks better
1024 set pixel [expr {$param(isunix) ? "-" : ""}]
1025
1026 if [string length [lindex $param($font) 2]] {
1027 set weight [lindex $param($font) 2]
1028 } else {
1029 set weight {normal}
1030 }
1031 if {[string length [lindex $param($font) 3]] &&
1032 [lindex $param($font) 3] == {italic}} {
1033 set slant {italic}
1034 } else {
1035 set slant {roman}
1036 }
1037 font configure $font -family [lindex $param($font) 0] \
1038 -size $pixel[lindex $param($font) 1] -weight $weight -slant $slant
1039 }
1040
1041 defFonts
1042
1043 # if {![string compare $searchmeth($param(cursearchmeth),grepcmd) ""]} {
1044 # } else {
1045 # set default_searchopts(grepcmd) $searchmeth($param(cursearchmeth),grepcmd)
1046 # }
1047
1048 if {[winfo depth .] > 1} { # Color display
1049 set param(errcolor) red
1050 } else {
1051 set param(errcolor) black
1052 }
1053
1054 #########################################################################
1055 # Balloon help, by John Haxby <jch@pwd.hp.com>, with slight changes
1056 # by Axel Boldt <boldt@math.ucsb.edu>.
1057
1058 proc BalloonInit {} {
1059 global param
1060
1061
1062 bind balloon <Enter> {
1063 if { [info exists balloonHelp(%W)] && [%W cget -state] != "disabled"} {
1064 set balloonHelp(%W,after) [after $param(balloonDelay) {showBalloonHelp %W}]
1065 }
1066 }
1067
1068 bind balloon <Leave> { unShowBalloonHelp %W }
1069 bind balloon <Any-KeyPress> { unShowBalloonHelp %W }
1070 bind balloon <Any-Button> { unShowBalloonHelp %W }
1071
1072 proc showBalloonHelp {w} {
1073 global balloonHelp param gparam
1074 if {![info exists balloonHelp($w)] || ! $param(showBalloons) } {
1075 return
1076 }
1077 update idletasks
1078 set curpos [winfo pointerxy $w]
1079 set curwin [eval winfo containing $curpos]
1080 if { $w == $curwin } {
1081 if ![winfo exists .balloon] {
1082 toplevel .balloon
1083 wm overrideredirect .balloon true
1084 pack [label .balloon.l -font lfont \
1085 -foreground black \
1086 -background $gparam(balloonBackground) \
1087 -highlightthickness 1 \
1088 -highlightbackground black]
1089 wm withdraw .balloon
1090 }
1091 .balloon.l configure -text $balloonHelp($w)
1092 set x [expr [lindex $curpos 0] - 14]
1093 set y [expr [lindex $curpos 1] + 19]
1094 wm geometry .balloon +$x+$y
1095 # This update is important to have the geometry command take
1096 # effect in all cases (A.B.)
1097 update idletasks
1098 raise .balloon
1099 wm deiconify .balloon
1100 }
1101 }
1102 proc unShowBalloonHelp {w} {
1103 global balloonHelp
1104 if [info exists balloonHelp($w,after)] {
1105 after cancel $balloonHelp($w,after)
1106 unset balloonHelp($w,after)
1107 }
1108 catch {wm withdraw .balloon}
1109 }
1110
1111 # end of proc BalloonInit
1112 }
1113
1114 BalloonInit
1115 ###############
1116
1117 # calculate other colors from given foreground and background colors
1118 proc shadeColor {fcolor bcolor} {
1119
1120 debug 2 "shadeColor $fcolor $bcolor"
1121 # the higher the following values
1122 # the more different is the shaded/hilite color, max 127
1123 set dc1 16
1124 set dc2 32
1125
1126 if {[scan $bcolor "#%2x%2x%2x" red green blue] != 3} {
1127 set rgb [winfo rgb . $bcolor]
1128 set red [expr {[lindex $rgb 0]/0x100}]
1129 set green [expr {[lindex $rgb 1]/0x100}]
1130 set blue [expr {[lindex $rgb 2]/0x100}]
1131 }
1132 debug 8 " old bcolor = $red $green $blue"
1133 set red [expr $red < (255 - $dc1) ? [expr $red + $dc1] : [expr $red - $dc1]]
1134 set green [expr $green < (255 - $dc1) ? [expr $green + $dc1] : [expr $green - $dc1]]
1135 set blue [expr $blue < (255 - $dc1) ? [expr $blue + $dc1] : [expr $blue - $dc1]]
1136 set bc [format "#%02x%02x%02x" $red $green $blue]
1137
1138 set red [expr $red < (255 - $dc2) ? [expr $red + $dc2] : [expr $red - $dc2]]
1139 set green [expr $green < (255 - $dc2) ? [expr $green + $dc2] : [expr $green - $dc2]]
1140 set blue [expr $blue < (255 - $dc2) ? [expr $blue + $dc2] : [expr $blue - $dc2]]
1141 set hc [format "#%02x%02x%02x" $red $green $blue]
1142
1143 set ec [format "#%02x%02x%02x" [expr $red < 128 ? 255 : $red] [expr $green < 128 ? 128 : 0] [expr $blue < 128 ? 128 : 0]]
1144 # [expr 255 - $green] [expr 255 - $blue]]
1145
1146 if {[scan $fcolor "#%2x%2x%2x" red green blue] != 3} {
1147 set rgb [winfo rgb . $fcolor]
1148 set red [expr {[lindex $rgb 0]/0x100}]
1149 set green [expr {[lindex $rgb 1]/0x100}]
1150 set blue [expr {[lindex $rgb 2]/0x100}]
1151 }
1152 debug 8 " old fcolor = $red $green $blue"
1153 # set red [expr $red < 128 ? 255 : 0]
1154 # set green [expr $green < 128 ? 255 : 0]
1155 set blue [expr $blue < 128 ? 255 : 0]
1156 set fc [format "#%02x%02x%02x" $red $green $blue]
1157
1158 debug 8 " new colors = $bc $fc $ec $hc"
1159 return [list $bc $fc $ec $hc]
1160 }
1161
1162 proc setSearchBg {color} {
1163 .search.s configure -background $color
1164 .search.s.label.label configure -background $color
1165 .search.l configure -background $color
1166 .search.l.logo configure -background $color
1167 .search configure -background $color
1168 }
1169
1170 # updates the menu for search methods when changed
1171 proc update_searchmeth_menu {} {
1172 global searchmeth searchmpos param gparam s
1173
1174 debug 2 "update_searchmeth_menu"
1175 set lang $gparam(lang)
1176 variable i
1177 .search.s.searchmeth.m delete 0 end
1178 set n 0
1179 foreach i $searchmpos {
1180 if $searchmeth($i,avail) {
1181 incr n
1182 set cmd "
1183 set param(cursearchmeth) $i
1184 .search.s.searchmeth configure -text {$searchmeth($i,name)}
1185 .statusBar.lab config -foreground $param(fcolor) \
1186 -text {[set s($lang)(cmd)] $searchmeth($i,grepcmd)}
1187 .statusBar.file config -foreground $param(fcolor) \
1188 -text {$searchmeth($i,dictfile)}
1189 set_opts_errors {$i}
1190 after cancel dictsearchquery_onchange
1191 after $param(autosearchDelay) dictsearchquery_onchange
1192 "
1193 if {$n < 10} {
1194 bind .search.s.entry <Control-KeyPress-$n> "$cmd"
1195 .search.s.searchmeth.m add command -font lfont \
1196 -accelerator "[set s($lang)(ctl)]+$n" \
1197 -label [set searchmeth($i,name)] -command $cmd \
1198 } else {
1199 .search.s.searchmeth.m add command -font lfont \
1200 -label [set searchmeth($i,name)] -command $cmd
1201 }
1202 }
1203 }
1204 .search.s.searchmeth configure -text $searchmeth($param(cursearchmeth),name)
1205 .statusBar.file config -foreground $param(fcolor) \
1206 -text "$searchmeth($param(cursearchmeth),dictfile)"
1207 }
1208
1209 # manipulates menu for opts(errors)
1210 # - active only for search methods which support error correction
1211 proc set_opts_errors {i} {
1212 global searchmeth opts param
1213
1214 debug 2 "set_opts_errors"
1215 if { ([string match "*grep*" $searchmeth($i,grepcmd)] && \
1216 [string match "agrep*" $searchmeth($i,grepcmd)]) ||
1217 [string match "dict*" $searchmeth($i,grepcmd)]} {
1218 # only agrep and dict (limited) have error correction
1219 .search.opts.errors configure -state normal
1220 .menuBar.params entryconfigure 8 -state normal
1221 .menuBar.params entryconfigure 9 -state normal
1222 .menuBar.params entryconfigure 10 -state normal
1223 .menuBar.params entryconfigure 11 -state normal
1224 .menuBar.params entryconfigure 12 -state normal
1225 } else {
1226 # save old state ???
1227 set opts(errors) 0
1228 .search.opts.errors configure -state disabled
1229 .menuBar.params entryconfigure 8 -state disabled
1230 .menuBar.params entryconfigure 9 -state disabled
1231 .menuBar.params entryconfigure 10 -state disabled
1232 .menuBar.params entryconfigure 11 -state disabled
1233 .menuBar.params entryconfigure 12 -state disabled
1234 }
1235 }
1236
1237 # Escape: reset interface (kill search process, reset cursor, stop anim logo)
1238 proc Reset {mini} {
1239 global proc param gparam s
1240
1241 debug 2 "Reset"
1242 set lang $gparam(lang)
1243 if {$proc(pid) > 0} {
1244 if {$param(isunix)} {
1245 debug 4 " kill $proc(pid)"
1246 if [catch {exec kill $proc(pid)} err] {
1247 .statusBar.lab config -foreground $param(errcolor) -text "[set s($lang)(nokill)] $err"
1248 } else {
1249 set $proc(pid) -1
1250 .statusBar.lab config -foreground $param(fcolor) -text [set s($lang)(kill)]
1251 }
1252 }
1253 } elseif {$proc(pid) == 0} {
1254 # internal search
1255 debug 4 "Stopping internal"
1256 set proc(pid) -1
1257 }
1258 interface_reset $mini
1259 }
1260
1261 # Scrollbars when needed, http://mini.net/cgi-bin/wikit/BagOfTkAlgorithms
1262 # scrollbars come and go as needed -- see Welch 8.0/347f.
1263 proc yscroll {bar cmd offset size} {
1264 # debug 8 "yscroll $bar \"$cmd\" $offset $size"
1265 if {$offset == 0 && $size == 0} {
1266 return
1267 }
1268 if {$offset != 0.0 || $size != 1.0} {
1269 # grid configure .result.text -rowspan 1
1270 eval $cmd
1271 }
1272 $bar set $offset $size
1273 }
1274 proc xscroll {bar cmd offset size} {
1275 # debug 8 "xscroll $bar \"$cmd\" $offset $size"
1276 if {$offset == 0 && $size == 0} {
1277 return
1278 }
1279 if {$offset != 0.0 || $size != 1.0} {
1280 grid configure .result.text -columnspan 1
1281 eval $cmd
1282 }
1283 $bar set $offset $size
1284 }
1285
1286 # show (full window) or hide (minimize window) the result frame
1287 # type 0 = hide, 1 = show, -1 = toggle
1288
1289 proc hideResult {type} {
1290 global param s lang balloonHelp
1291 debug 2 "hideResult $type"
1292 set x 0
1293 set y 0
1294 # update
1295 set geo [wm geometry .]
1296 scan $geo "%dx%d+%d+%d" w h x y
1297 set where {}
1298 set wx [winfo x .]
1299 set wy [winfo y .]
1300 if {$x == 0 && $y == 0} {
1301 if {${wx} != 0 && ${wy} != 0} {
1302 # set where "+${wx}+${wy}"
1303 }
1304 } else {
1305 set where "+$x+$y"
1306 }
1307 debug 8 " toplevel geometry: $geo (= $w $h $x $y) winfo: $wx $wy -> $where"
1308
1309 set visible [winfo viewable .result]
1310 # show
1311 if {($type == 1 && ! $visible) || ($type == -1 && ! $visible)} {
1312 pack .result -fill both -expand yes
1313 debug 8 " show result"
1314 set param(show_result) 1
1315 hideMenuBar -1
1316 hideStatusBar -1
1317 if {[info exists param(width)] && [info exists param(height)]} {
1318 set height [expr $param(height) + $param(add_geom_height)]
1319 debug 8 " setting geometry: $param(width)x$height$where"
1320 bind dlookup <Configure> {}
1321
1322 wm geometry . "$param(width)x$height$where"
1323 update
1324 debug 8 " after setting: [wm geometry .] [winfo height .] "
1325 set wh [winfo height .]
1326 if {$height != $wh} {
1327 # correction of height for some window managers
1328 debug 8 "Window manager sets false height: should $height, is $wh."
1329 set param(add_geom_height) [expr $param(height) - $wh]
1330 ## should be: requested height + correction
1331 set height [expr $param(height) + $param(add_geom_height)]
1332 # for KDE this works: setting requested height again
1333 set height $param(height)
1334 debug 8 " setting geometry: $param(width)x$height$where"
1335 wm geometry . "$param(width)x$height$where"
1336 update
1337 debug 8 " after setting: [wm geometry .] [winfo height .] "
1338 }
1339 bind dlookup <Configure> catch_resize
1340 } else {
1341 wm geometry . {}
1342 }
1343 set balloonHelp(.search.l.logo) [set s($lang)(minimize)]
1344 .popup entryconfigure 7 -label [set s($lang)(minimize)]
1345 return
1346 }
1347 # hide
1348 if {($type == 0 && $visible) || ($type == -1 && $visible)} {
1349 pack forget .result
1350 debug 8 " hide result"
1351 if {$param(do_automin) == 1 && $param(win_prop) == 2 && $param(autominDelay) > 0} {
1352 debug 2 " cancelling automatically minimize <Enter>"
1353 after cancel {hideResult 0}
1354 }
1355 set param(show_result) 0
1356 hideMenuBar 0
1357 hideStatusBar 0
1358 if [info exists param(width)] {
1359 set w $param(width)
1360 } else {
1361 set w [winfo width .search]
1362 }
1363 debug 8 " setting geometry: ${w}x[winfo height .search]$where"
1364 wm geometry . "${w}x[winfo height .search]$where"
1365 # wm geometry . {}
1366 set balloonHelp(.search.l.logo) [set s($lang)(normalsize)]
1367 .popup entryconfigure 7 -label [set s($lang)(normalsize)]
1368 return
1369 }
1370 debug 2 "hideResult - status ok, nothing done"
1371 }
1372
1373 # proc to show or hide the menu bar
1374 # type 0 = hide, 1 = show, -1 = show if user wants to see
1375
1376 proc hideMenuBar {type} {
1377 global param s lang
1378 debug 8 "hideMenuBar $type"
1379
1380 # show
1381 if {$type == 1} {
1382 . configure -menu .menuBar
1383 set param(show_menu) 1
1384 .popup entryconfigure 8 -label [set s($lang)(hide_menu)]
1385 debug 8 " show menu"
1386 } elseif {$type == 0} {
1387 # hide
1388 . configure -menu .nomenuBar
1389 # set param(show_menu) 0
1390 .popup entryconfigure 8 -label [set s($lang)(show_menu)]
1391 if {$param(show_result) == 1 && $param(show_status) == 1} {
1392 .statusBar.lab config -foreground $param(fcolor) -text [set s($lang)(show_menu_desc)]
1393 }
1394 debug 8 " hide menu"
1395 # type == -1
1396 } elseif {$param(show_menu) == 1} {
1397 . configure -menu .menuBar
1398 .popup entryconfigure 8 -label [set s($lang)(hide_menu)]
1399 debug 8 " show menu"
1400 } else {
1401 # hide
1402 . configure -menu .nomenuBar
1403 .popup entryconfigure 8 -label [set s($lang)(show_menu)]
1404 debug 8 " hide menu"
1405 }
1406
1407 }
1408
1409 # 0 - off, 1 = on, -1 = show if user wants to see
1410 proc hideStatusBar {type} {
1411 global param s lang
1412
1413 debug 8 "hideStatusBar $type"
1414 # show
1415 if {$type == 1} {
1416 pack .statusBar -side bottom -fill x -pady 1 -padx 1 -before .result
1417 set param(show_status) 1
1418 .popup entryconfigure 9 -label [set s($lang)(hide_status)]
1419 debug 8 " show status"
1420 } elseif {$type == 0} {
1421 # hide
1422 pack forget .statusBar
1423 # set param(show_status) 0
1424 .popup entryconfigure 9 -label [set s($lang)(show_status)]
1425 debug 8 " hide status"
1426 } elseif {$param(show_status) == 1 && ![winfo viewable .statusBar]} {
1427 pack .statusBar -side bottom -fill x -pady 1 -padx 1 -before .result
1428 .popup entryconfigure 9 -label [set s($lang)(hide_status)]
1429 debug 8 " show status"
1430 } else {
1431 # hide
1432 pack forget .statusBar
1433 .popup entryconfigure 9 -label [set s($lang)(show_status)]
1434 debug 8 " hide status"
1435 }
1436 }
1437
1438 proc welcome {start} {
1439 global param searchmpos searchmeth s lang pinfo
1440
1441 set t .result.text
1442 set big {Helvetica 18 bold}
1443 $t tag configure h1 -background $param(shadedcolor) -foreground $param(fcolor) -font $big -justify center
1444 .result.text tag configure cmd -background $param(bcolor) \
1445 -relief groove -borderwidth 1 -lmargin1 5 -spacing1 3 -spacing3 3 \
1446 -font lfont
1447 .result.text tag configure th -background $param(shadedcolor) -font bfont \
1448 -relief groove -borderwidth 1 -lmargin1 5 -spacing1 3 -spacing3 3
1449 $t tag configure c -justify center -font bfont -background $param(bcolor)
1450 $t tag configure infolink -foreground $param(highcolor) -underline 1 \
1451 -justify center -font bfont
1452 $t tag bind infolink <ButtonRelease-1> { aboutBox }
1453 $t tag bind infolink <Enter> " $t config -cursor hand2"
1454 $t tag bind infolink <Leave> " $t config -cursor xterm"
1455 $t configure -state normal
1456
1457 $t delete 0.0 end
1458 if {$start} {
1459 .result.text insert end "$pinfo(pname)\n" h1
1460 .result.text insert end "\nVersion $pinfo(version) - " c
1461 .result.text insert end "Info" infolink
1462 .result.text insert end "\n\n" c
1463 }
1464 # compute tab stop
1465 set width [winfo width $t]
1466 if {$width < 200} {
1467 set width 200
1468 }
1469 $t configure -tabs [expr round(($width / 2) - 2)]
1470
1471 .result.text insert end "[set s($lang)(configured)] [set s($lang)(searchmeth)]\t" th
1472 .result.text insert end "[set s($lang)(grepcmd)] / [set s($lang)(dictfile)]\n" th
1473 foreach i $searchmpos {
1474 set what "$searchmeth($i,language1)"
1475 if [string length $searchmeth($i,language2)] {
1476 set what "$what $searchmeth($i,language2)"
1477 }
1478 if $searchmeth($i,avail) {
1479 .result.text insert end [format "%s (%s)\t%s %s %s\n" \
1480 $searchmeth($i,name) $what \
1481 $searchmeth($i,grepcmd) \
1482 $searchmeth($i,grepopts) \
1483 $searchmeth($i,dictfile) ] cmd
1484 }
1485 }
1486 .result.text configure -state disabled
1487 .result.text tag raise sel
1488
1489 if {$start} {
1490 animlogo .search.l.logo
1491 after 1500 {
1492 after cancel animlogo .search.l.logo
1493 .search.l.logo configure -image "logo1"
1494 }
1495 }
1496 }
1497
1498 # proc mainWindow {w} {
1499 # global pinfo argv0 argv param gparam s lang
1500 # global searchmeth opts defaultcursor
1501 # global grepcmds
1502
1503 # now build the user interface
1504 set logo {
1505 R0lGODdhIAAgAMIAAMDAwAAAAP///4CAgPJ8Dv///////////ywAAAAAIAAgAAADxRi63P5N
1506 yEmrvVIJwLv/YDhoYWl6Y7CdLJiubQy8ALR0tsLRKiYENd9vpyH0MDWAMECYFY+X5LL5Mv4C
1507 g4EgK5Eustwf9SmU+phOlVWiBXeBE7dWnBaskfDzWA21mDFoVX0VXlhbYYFkV1hhfxeJfGV5
1508 gHt2UHMTZmCYdIJxh3OOFpCWkkqHGQyVa5sUokFXq4Ouk29DpHdRtRs6NbI2vEo5siZAxsXE
1509 xb0luDlMBEbDddDU1dRg1tmVMjIpm9/g4eLO5MAJADs=}
1510 image create photo windowicon -data $logo
1511
1512 wm title . $pinfo(pname)
1513 if {$tk_version >= 8.5} {
1514 wm iconphoto . windowicon
1515 }
1516 wm iconname . $pinfo(pname)
1517 wm command . [concat $argv0 $argv]
1518 wm client . [info hostname]
1519 # wm group . .
1520 # wm focusmodel . active
1521
1522 set lang $gparam(lang)
1523
1524 menu .menuBar -font lfont -tearoff 0 -relief groove -bd 1
1525 menu .menuBar.file -tearoff 0 -font lfont
1526 .menuBar.file add command -label "[set s($lang)(newwin)]..." \
1527 -underline 0 -accelerator "[set s($lang)(ctl)]+N" -command startNew
1528 .menuBar.file add command -label "[set s($lang)(save)]..." -command {save 0} \
1529 -underline 0 -accelerator "[set s($lang)(ctl)]+S"
1530 .menuBar.file add command -label "[set s($lang)(saveall)]..." -command {save 1} \
1531 -underline 0 -accelerator "[set s($lang)(ctl)]+L"
1532 .menuBar.file add command -label "[set s($lang)(clipboard_copy_all)]" -command clipboard_copy_all \
1533 -underline 0 -accelerator "[set s($lang)(ctl)]+C"
1534 .menuBar.file add command -label "[set s($lang)(notice)]..." \
1535 -command {notice $param(noticefile)} \
1536 -underline 1 -accelerator "[set s($lang)(ctl)]+O"
1537 .menuBar.file add command -label "[set s($lang)(mail)]..." -command sendMail \
1538 -underline 0 -accelerator "[set s($lang)(ctl)]+M"
1539 .menuBar.file add command -label [set s($lang)(quit)] -command {
1540 if {$param(autosave) != 0} {
1541 saveOptions
1542 }
1543 exit } \
1544 -underline 0 -accelerator "[set s($lang)(ctl)]+Q"
1545 .menuBar add cascade -menu .menuBar.file -label [set s($lang)(file)] -underline 0
1546
1547 menu .menuBar.opts -tearoff 0 -font lfont
1548 .menuBar.opts add checkbutton -label [set s($lang)(show_menu)] \
1549 -variable param(show_menu) -command {hideMenuBar $param(show_menu)} \
1550 -accelerator "[set s($lang)(shift)]+[set s($lang)(ctl)]+[set s($lang)(space)]"
1551
1552 .menuBar.opts add checkbutton -label [set s($lang)(params_as_menu)] \
1553 -variable param(params_as_menu) -command {
1554 if $param(params_as_menu) {
1555 pack .search.opts -pady 2
1556 } else {
1557 pack forget .search.opts
1558 }
1559 }
1560 .menuBar.opts add checkbutton -label [set s($lang)(umlaut_buttons)] \
1561 -variable param(umlaut_buttons) -command {
1562 if $param(umlaut_buttons) {
1563 pack .search.u -pady 2
1564 } else {
1565 pack forget .search.u
1566 }
1567 }
1568 # .menuBar.opts add checkbutton -label [set s($lang)(show_result)] \
1569 # -variable param(show_result) -command {hideResult $param(show_result)} \
1570 # -accelerator "[set s($lang)(ctl)]+[set s($lang)(space)]"
1571
1572 .menuBar.opts add checkbutton -label [set s($lang)(show_status)] \
1573 -variable param(show_status) -command \
1574 { hideStatusBar $param(show_status)}
1575
1576 .menuBar.opts add separator
1577 .menuBar.opts add command -label [set s($lang)(larger_font)] -command "change_font 1" \
1578 -accelerator "[set s($lang)(ctl)]++"
1579 .menuBar.opts add command -label [set s($lang)(smaller_font)] -command "change_font -1" \
1580 -accelerator "[set s($lang)(ctl)]+-"
1581 .menuBar.opts add command -label [set s($lang)(default_font)] -command "change_font 0" \
1582 -accelerator "[set s($lang)(ctl)]+0"
1583
1584 .menuBar.opts add separator
1585 .menuBar.opts add command -label [set s($lang)(general)] -command "setGeneral" -underline 0
1586 .menuBar.opts add command -label [set s($lang)(soptions)] -command "setSearch" -underline 0
1587 .menuBar.opts add command -label [set s($lang)(saveopts)] -command "saveOptions" -underline 0
1588
1589 if {$gparam(noconf)} {
1590 .menuBar.opts entryconfigure 11 -state disabled
1591 }
1592
1593 .menuBar add cascade -menu .menuBar.opts -label [set s($lang)(options)] -underline 0
1594
1595 # Search parameters as menu?
1596 menu .menuBar.params -tearoff 1 -font lfont
1597
1598 .menuBar.params add radiobutton -label [set s($lang)(word)(0)] \
1599 -value 0 -variable opts(word)
1600 .menuBar.params add radiobutton -label [set s($lang)(word)(1)] \
1601 -value 1 -variable opts(word)
1602
1603 .menuBar.params add separator
1604 .menuBar.params add radiobutton -label [set s($lang)(case)(0)] \
1605 -value 0 -variable opts(case)
1606 .menuBar.params add radiobutton -label [set s($lang)(case)(1)] \
1607 -value 1 -variable opts(case)
1608
1609 .menuBar.params add separator
1610 for {set x 0} {$x < 5} {incr x} {
1611 set e [expr $x == 1 ? {[set s($lang)(error)]} : {[set s($lang)(errors)]}]
1612 .menuBar.params add radiobutton -label "$x $e" \
1613 -value $x -variable opts(errors)
1614 }
1615 .menuBar.params add radiobutton -label [set s($lang)(closestmatch)] \
1616 -value -1 -variable opts(errors)
1617
1618 .menuBar.params add separator
1619 .menuBar.params add radiobutton -label [set s($lang)(regex)(0)] \
1620 -value 0 -variable opts(regex)
1621 .menuBar.params add radiobutton -label [set s($lang)(regex)(1)] \
1622 -value 1 -variable opts(regex)
1623
1624 .menuBar add cascade -menu .menuBar.params -label [set s($lang)(params)] \
1625 -underline 0
1626
1627 # Program behavior menu
1628 menu .menuBar.props -tearoff 1 -font lfont
1629
1630 .menuBar.props add radiobutton -label [set s($lang)(onrequest)] \
1631 -value 0 -variable param(search_prop) \
1632 -command {after cancel check_selection;
1633 .search.s.label.mark configure -background green }
1634 .menuBar.props add radiobutton -label [set s($lang)(onmouseover)] \
1635 -value 1 -variable param(search_prop) \
1636 -command {after cancel check_selection;
1637 .search.s.label.mark configure -background yellow }
1638 .menuBar.props add radiobutton -label [set s($lang)(onselection)] \
1639 -value 2 -variable param(search_prop) \
1640 -command { .search.s.label.mark configure -background red }
1641
1642 .menuBar.props add separator
1643 .menuBar.props add radiobutton -label [set s($lang)(min_none)] \
1644 -value 0 -variable param(win_prop)
1645 .menuBar.props add radiobutton -label [set s($lang)(min_focus_delay)] \
1646 -value 2 -variable param(win_prop)
1647 .menuBar.props add radiobutton -label [set s($lang)(min_focus)] \
1648 -value 1 -variable param(win_prop)
1649
1650 .menuBar.props add separator
1651 .menuBar.props add checkbutton -label [set s($lang)(raise)] \
1652 -onvalue 1 -offvalue 0 -variable param(raise)
1653 .menuBar.props add checkbutton -label [set s($lang)(autosearch)] \
1654 -onvalue 1 -offvalue 0 -variable param(autosearch)
1655
1656 .menuBar add cascade -menu .menuBar.props -label [set s($lang)(props)] \
1657 -underline 1
1658
1659 menu .menuBar.help -tearoff 0 -font lfont
1660 .menuBar.help add command -label [set s($lang)(help)] -command "helpGeneral" \
1661 -underline 0 -accelerator "F1"
1662 .menuBar.help add command -label [set s($lang)(khelp)] -command "helpKeys" \
1663 -underline 0
1664 .menuBar.help add command -label [set s($lang)(abbhelp)] -command "helpAbb" \
1665 -underline 0
1666 .menuBar.help add command -label [set s($lang)(cmdline)] \
1667 -command "helpCmdline" -underline 0
1668 .menuBar.help add command -label [set s($lang)(searchmeth)] -command "welcome 0" \
1669 -underline 0
1670 .menuBar.help add sep
1671 .menuBar.help add command -label "Homepage" -command "urlOpen $pinfo(homepage)"
1672 .menuBar.help add sep
1673 .menuBar.help add command -label [set s($lang)(about)] -command "aboutBox" \
1674 -underline 0
1675 .menuBar add cascade -menu .menuBar.help -label [set s($lang)(help)] -underline 0
1676
1677 # the "no menu bar" - empty
1678 menu .nomenuBar -bd 0
1679
1680 if {(! $mini) && $param(show_menu) == 1} {
1681 . configure -menu .menuBar
1682 } else {
1683 . configure -menu .nomenuBar
1684 }
1685
1686 # Pop up menu
1687 menu .popup -tearoff 0 -font lfont
1688 .popup add command -label [set s($lang)(bbhistory)] -command { history back } \
1689 -accelerator "[set s($lang)(ctl)]+[set s($lang)(up)]" -state disabled
1690 .popup add command -label [set s($lang)(bfhistory)] -command { history forward } \
1691 -accelerator "[set s($lang)(ctl)]+[set s($lang)(down)]" -state disabled
1692
1693 .popup add separator
1694 .popup add command -label [set s($lang)(save)] -command {save 0} \
1695 -underline 0 -accelerator "[set s($lang)(ctl)]+S"
1696 .popup add command -label [set s($lang)(clipboard_copy_line)] -command {
1697 .result.text tag remove sel 1.0 end
1698 #.result.text tag add sel [.result.text tag ranges hilite]
1699 if {[string compare [.result.text index "@$tkPriv(x),$tkPriv(y) linestart"] "1.0"]} {
1700 .result.text tag remove sel 1.0 end
1701 .result.text tag add sel "@$tkPriv(x),$tkPriv(y) linestart" "@$tkPriv(x),$tkPriv(y) lineend"
1702 }
1703 if {$param(isunix)} {
1704 catch {set last_selection [selection get]}
1705 } else {
1706 catch {set last_selection [selection get -selection CLIPBOARD]}
1707 }
1708 catch {clipboard clear}
1709 catch {clipboard append $last_selection}
1710 }
1711 .popup add command -label [set s($lang)(clipboard_copy_all)] \
1712 -accelerator "[set s($lang)(ctl)]+C" -command clipboard_copy_all
1713
1714 .popup add separator
1715 .popup add command -label [set s($lang)(minimize)] -command { hideResult -1 } \
1716 -accelerator "[set s($lang)(ctl)]+[set s($lang)(space)]"
1717 .popup add command -label [if {$param(show_menu) == 1} \
1718 {set s($lang)(hide_menu)} else {set s($lang)(show_menu)}] \
1719 -command { debug 8 "$param(show_menu) $mini"
1720 if {$param(show_menu) == 1 && $param(show_result) == 1} {set param(show_menu) 0} else {set param(show_menu) 1}
1721 hideMenuBar $param(show_menu) } \
1722 -accelerator "[set s($lang)(shift)]+[set s($lang)(ctl)]+[set s($lang)(space)]"
1723
1724 .popup add command -label [if {$param(show_status) == 1} \
1725 {set s($lang)(hide_status)} else {set s($lang)(show_status)}] \
1726 -command {
1727 debug 8 "$param(show_status)"
1728 if {$param(show_result) == 1} {
1729 set param(show_status) [expr $param(show_status) == 0 ? 1 : 0]
1730 hideStatusBar $param(show_status)
1731 }
1732 }
1733
1734 frame .search -background white
1735 pack .search -side top -fill x -expand 0
1736
1737 frame .search.l
1738
1739 pack .search.l -side right -fill y -padx 2
1740
1741 image create photo logo1 -data $logo
1742 image create photo logo2 -data {
1743 R0lGODdhIAAgAMIAAMDAwAAAAP///4CAgPJ8Dv///////////ywAAAAAIAAgAAAD2Bi63P5N
1744 yEmrvVIJwLv/nwIOGmiCgRCM5emmKpu6Jxx/5AwtnTY1nNzGdlkRB6pfUEMgWgCrCTKZIQCE
1745 TYwECpBMqSorNqUYIM3bKAwZmAbETGeF67S9r3GpwDzl6sF3Y1pDXXs/bnApWVp+FCQ/iQKL
1746 GHR6dpGLC3xphRRtVXiKchSNbpehkkdzUW6AmDZnaIQwOmiBeYxRVLphqIt8X4RKvLeig40q
1747 vL2CuYUiFcWpO8I70U0vdC+vNDzavtVvBE3VmOLm5+J86OuRNO4mOcDy8/T14PfTCQA7}
1748 image create photo logo3 -data {
1749 R0lGODdhIAAgAMIAAMDAwAAAAP///4CAgPJ8Dv///////////ywAAAAAIAAgAAADzxi63P5N
1750 yEmrvVIJwLv/QAB+gzaeytmVwaZ6rfiy7htmNh1CactCHF0LIxgWMTIawXjxHZsEgJJpCQwy
1751 1Ex0WrReB9fnTwAOB7aaJfF4zWqlaeMXnJloquiWmuj0zt9cfGZIeQJ7SHaEcHpDC2V1XV2P
1752 RYWHTUdulIuGTGF2MTd4m4dznkVBdGRtlZkZJQAVnmejQ2WmKRKpFLOBSAOwfKxrVsCKUzwb
1753 IjwKrCrKryjNzinOrMsE2Mu8adjd3thl3+KFNuUkCrbp6uvs2u7ICQA7}
1754 image create photo logo4 -data {
1755 R0lGODdhIAAgAMIAAMDAwAAAAP///4CAgPJ8Dv///////////ywAAAAAIAAgAAAD2xi63P5N
1756 yEmrvVIJwDsPXih6gzYCyqkCZbCNLriK7Su6gjx3NfpkHciC08NNUBOQ8SKrEZYbDRCTIbA0
1757 zwoSB8owrc5YYDBAJgE5DXlQvbqyFDO7Sw2AsUZ2TVBCSyt2bgJwRzFTfGSIbWFaOHNodXdv
1758 UD5nVDmSg1wphjl+aWuLeIBJnpeBjBQubFN/qpmEJROsdKGKqKNJtaYVrJiCcGuVj4i+SbCU
1759 H4cYuJMXynTMyEJKfkLIKkM6N9jZKdnT1wRP1LDj5+jja+nsmTvvPApr8/T19vTU+fkCCQA7}
1760 image create photo logo5 -data {
1761 R0lGODdhIAAgAMIAAMDAwAAAAP///4CAgPJ8Dv///////////ywAAAAAIAAgAAAD3Ri63P5N
1762 yEmrvVIJwLnqYCh2gxYGQjCuYYmeGSu7G4jG8kgD0fR5kN/uxktRVDeMCkAjEG9JHgCTITA1
1763 TkmxIs1cAtYmCikYSMzdRXlgToWxT1R70KWCr6jsZkwpTTUWd2JaUBN1bGZsVXgCeltlhFN2
1764 b3lPRpB1SpSNUIWRRgqIi4N7Pp+TjI5yFGlJR5uqZ4YqZ4prbqlJSW2ZE224pHSue1OiFYJw
1765 rBpotKikhlu9gbBBL7TV1CxIUivIlTIL4NTYBE7YqeXp6uWI6+6bOfEtoYj19vf49dX7+wIJ
1766 ADs=}
1767 image create bitmap left -foreground $param(fcolor) -data {
1768 #define l_width 9
1769 #define l_height 13
1770 static char l_bits[] = {
1771 0x80,0x00,0xc0,0x00,0xe0,0x00,0x70,0x00,0x38,0x00,0x1c,0x00,0x0e,0x00,0x1c,
1772 0x00,0x38,0x00,0x70,0x00,0xe0,0x00,0xc0,0x00,0x80,0x00};
1773 }
1774 image create bitmap right -foreground $param(fcolor) -data {
1775 #define r_width 9
1776 #define r_height 13
1777 static char r_bits[] = {
1778 0x02,0x00,0x06,0x00,0x0e,0x00,0x1c,0x00,0x38,0x00,0x70,0x00,0xe0,0x00,0x70,
1779 0x00,0x38,0x00,0x1c,0x00,0x0e,0x00,0x06,0x00,0x02,0x00};
1780 }
1781 image create bitmap up -foreground $param(fcolor) -data {
1782 #define u_width 13
1783 #define u_height 9
1784 static char u_bits[] = {
1785 0x00,0x00,0x40,0x00,0xe0,0x00,0xf0,0x01,0xb8,0x03,0x1c,0x07,0x0e,0x0e,0x07,
1786 0x1c,0x00,0x00};
1787 }
1788 image create bitmap down -foreground $param(fcolor) -data {
1789 #define d_width 13
1790 #define d_height 9
1791 static char d_bits[] = {
1792 0x00,0x00,0x07,0x1c,0x0e,0x0e,0x1c,0x07,0xb8,0x03,0xf0,0x01,0xe0,0x00,0x40,
1793 0x00,0x00,0x00};
1794 }
1795 image create bitmap plus -foreground $param(bcolor) -background $param(fcolor) -data {
1796 #define plus_width 8
1797 #define plus_height 8
1798 static unsigned char plus_bits[] = {
1799 0x00, 0x18, 0x18, 0x7e, 0x7e, 0x18, 0x18, 0x00};
1800 }
1801 image create bitmap minus -foreground $param(bcolor) -background $param(fcolor) -data {
1802 #define minus_width 8
1803 #define minus_height 8
1804 static unsigned char minus_bits[] = {
1805 0x00, 0x00, 0x00, 0x7e, 0x7e, 0x00, 0x00, 0x00};
1806 }
1807
1808 button .search.l.logo -image logo1 -bd 1 -relief raised -command {Reset 1}
1809 pack .search.l.logo -side right -expand 1 -anchor n
1810
1811 set balloonHelp(.search.l.logo) [set s($lang)(minimize)]
1812 bindtags .search.l.logo [list balloon .search.l.logo Button all]
1813
1814 set logoanim 1
1815 proc animlogo {t} {
1816 global logoanim
1817
1818 # debug 2 "animlogo $t"
1819 if ![winfo exists $t] {
1820 after cancel animlogo $t
1821 return
1822 }
1823 if {$logoanim >= 5} {
1824 set logoanim 1
1825 } else {
1826 incr logoanim
1827 }
1828 $t configure -image "logo$logoanim"
1829 after 100 "animlogo $t"
1830 }
1831
1832 frame .search.s -background white
1833 pack .search.s -side top -expand 1 -fill x -padx 5
1834 if {$tk_version > 8.3} {
1835 button .search.s.back -state disabled -height 15 -width 15 -image left \
1836 -relief flat -overrelief raised -command { history back }
1837 } else {
1838 button .search.s.back -state disabled -height 15 -width 15 -image left \
1839 -relief raised -command { history back }
1840 }
1841
1842 set balloonHelp(.search.s.back) [set s($lang)(bbhistory)]
1843 bindtags .search.s.back [list balloon .search.s.back Button all]
1844
1845 if {$tk_version > 8.3} {
1846 button .search.s.forw -state disabled -height 15 -width 15 -image right \
1847 -relief flat -overrelief raised -command { history forward }
1848 } else {
1849 button .search.s.forw -state disabled -height 15 -width 15 -image right \
1850 -relief raised -command { history forward }
1851 }
1852 set balloonHelp(.search.s.forw) [set s($lang)(bfhistory)]
1853 bindtags .search.s.forw [list balloon .search.s.forw Button all]
1854
1855 # fri: label -> button
1856 # label .search.s.label -text " [set s($lang)(query)]" -font lfont
1857
1858 #frame .search.s.label -pady 0
1859 #frame .search.s.label.mark -pady 1
1860 frame .search.s.label
1861 frame .search.s.label.mark
1862 switch $param(search_prop) {
1863 "0" { .search.s.label.mark configure -background green }
1864 "1" { .search.s.label.mark configure -background yellow }
1865 "2" { .search.s.label.mark configure -background red }
1866 }
1867
1868 button .search.s.label.label -text " [set s($lang)(query)]" -font lfont \
1869 -relief flat -command {
1870 # toggle search property: onrequest, onmouseover, onselect
1871 if {$param(search_prop) == 0} {
1872 set param(search_prop) 1
1873 .search.s.label.mark configure -background yellow
1874 .statusBar.lab config -foreground $param(fcolor) -text \
1875 "[set s($lang)(props)]: [set s($gparam(lang))(onmouseover)]"
1876
1877 } elseif {$param(search_prop) == 1} {
1878 set param(search_prop) 2
1879 .search.s.label.mark configure -background red
1880 .statusBar.lab config -foreground $param(fcolor) -text \
1881 "[set s($lang)(props)]: [set s($gparam(lang))(onselection)]"
1882 } elseif {$param(search_prop) == 2} {
1883 set param(search_prop) 0
1884 .search.s.label.mark configure -background green
1885 .statusBar.lab config -foreground $param(fcolor) -text \
1886 "[set s($lang)(props)]: [set s($gparam(lang))(onrequest)]"
1887 }
1888 }
1889 set balloonHelp(.search.s.label.label) [set s($lang)(change_props)]
1890 bindtags .search.s.label.label [list balloon .search.s.label.label Button all]
1891
1892 entry .search.s.entry -width 17 -selectbackground $param(fcolor) -selectforeground $param(bcolor) \
1893 -textvariable query -relief flat -font tfont -bd 3
1894
1895 if {$tk_version > 8.3} {
1896 button .search.s.button -text [set s($lang)(search)] -font lfont \
1897 -relief flat -overrelief raised -command "dictsearch \$query"
1898 } else {
1899 button .search.s.button -text [set s($lang)(search)] -font lfont \
1900 -relief raised -command "dictsearch \$query"
1901 }
1902 bind .search.s.button <2> {
1903 # internal search = search in result text
1904 display $curhistory $query 0 ""
1905 }
1906 set balloonHelp(.search.s.button) [set s($lang)(searchhelp)]
1907 bindtags .search.s.button [list balloon .search.s.button Button all]
1908
1909 menubutton .search.s.searchmeth -text $searchmeth($param(cursearchmeth),name) \
1910 -menu .search.s.searchmeth.m -indicatoron 1 -anchor c \
1911 -direction flush -font lfont -width 12 -relief raised
1912 set balloonHelp(.search.s.searchmeth) [set s($lang)(searchmeth)]
1913 bindtags .search.s.searchmeth [list balloon .search.s.searchmeth Menubutton all]
1914 menu .search.s.searchmeth.m -font lfont -tearoff 0
1915
1916 # Wheel mouse bindings for easy scrolling through search methods:
1917 proc next_searchmeth {nextprior} {
1918 global param searchmeth searchmpos gparam s query
1919 foreach i $searchmpos {
1920 if {$nextprior == 1} { # next
1921 if {$param(cursearchmeth) < [expr [llength $searchmpos] - 1]} {
1922 incr param(cursearchmeth)
1923 } else {
1924 set param(cursearchmeth) 0
1925 }
1926 } else { # prior
1927 if {$param(cursearchmeth) > 0} {
1928 set param(cursearchmeth) [expr $param(cursearchmeth) - 1]
1929 } else {
1930 set param(cursearchmeth) [expr [llength $searchmpos] - 1]
1931 }
1932 }
1933 if $searchmeth($param(cursearchmeth),avail) {
1934 .search.s.searchmeth config -text $searchmeth($param(cursearchmeth),name)
1935 .statusBar.lab config -foreground $param(fcolor) \
1936 -text "[set s($gparam(lang))(cmd)] $searchmeth($param(cursearchmeth),grepcmd)"
1937 .statusBar.file config -foreground $param(fcolor) \
1938 -text $searchmeth($param(cursearchmeth),dictfile)
1939 set_opts_errors $param(cursearchmeth)
1940 # querydictsearch $query
1941 after cancel dictsearchquery_onchange
1942 after $param(autosearchDelay) dictsearchquery_onchange
1943 break
1944 }
1945 }
1946 }
1947
1948 if {$param(isunix) == 1} {
1949 bind .search.s.searchmeth <Button-4> {
1950 next_searchmeth -1
1951 debug 8 "B4 in search.s.searchmeth: $param(cursearchmeth) [llength $searchmpos]"
1952 }
1953 bind .search.s.searchmeth <Button-5> {
1954 next_searchmeth 1
1955 debug 8 "B5 in search.s.searchmeth: $param(cursearchmeth) [llength $searchmpos]"
1956 }
1957 } else {
1958 bind .search.s.searchmeth <MouseWheel> {
1959 if {%D > 0} {
1960 next_searchmeth 1
1961 debug 8 "B5 in search.s.searchmeth: $param(cursearchmeth) [llength $searchmpos]"
1962 } else {
1963 next_searchmeth -1
1964 debug 8 "B4 in search.s.searchmeth: $param(cursearchmeth) [llength $searchmpos]"
1965 }
1966 }
1967 }
1968
1969 if {$tk_version > 8.3} {
1970 button .search.s.clear -text [set s($lang)(clear)] -font lfont \
1971 -relief flat -overrelief raised -command {set query ""}
1972 } else {
1973 button .search.s.clear -text [set s($lang)(clear)] -font lfont \
1974 -relief raised -command {set query ""}
1975 }
1976 set balloonHelp(.search.s.clear) [set s($lang)(clearhelp)]
1977 bindtags .search.s.clear [list balloon .search.s.clear Button all]
1978
1979 pack .search.s.back .search.s.forw -side left -pady 0 -padx 0
1980 pack .search.s.label -side left
1981 pack .search.s.label.label .search.s.label.mark -side top -pady 0 -padx 0 -fill x
1982 pack .search.s.entry -side left -expand yes -fill x
1983 pack .search.s.searchmeth -side left -pady 5 -padx 5
1984 pack .search.s.button -side left -pady 5
1985 pack .search.s.clear -side left -pady 5 -padx 5
1986
1987
1988 # adjust size of history buttons
1989 set h [expr [winfo reqheight .search.s.label.label] - 5]
1990 if {$h > 0} {
1991 debug 8 "new history button size: $h"
1992 .search.s.back configure -height $h -width $h
1993 .search.s.forw configure -height $h -width $h
1994 }
1995
1996 # Umlaut buttons?
1997 frame .search.u
1998 button .search.u.aumlaut -text "ä" -font lfont -command {.search.s.entry insert insert "ä"}
1999 button .search.u.oumlaut -text "ö" -font lfont -command {.search.s.entry insert insert "ö"}
2000 button .search.u.uumlaut -text "ü" -font lfont -command {.search.s.entry insert insert "ü"}
2001 button .search.u.bigaumlaut -text "Ä" -font lfont -command {.search.s.entry insert insert "Ä"}
2002 button .search.u.bigoumlaut -text "Ö" -font lfont -command {.search.s.entry insert insert "Ö"}
2003 button .search.u.biguumlaut -text "Ü" -font lfont -command {.search.s.entry insert insert "Ü"}
2004 button .search.u.eszet -text "ß" -font lfont -command {.search.s.entry insert insert "ß"}
2005
2006 pack .search.u.aumlaut .search.u.oumlaut .search.u.uumlaut .search.u.bigaumlaut .search.u.bigoumlaut .search.u.biguumlaut .search.u.eszet -side left
2007
2008 if {$param(umlaut_buttons) == 1} {
2009 pack .search.u -side top -pady 2
2010 }
2011
2012 # Search parameters as multiple menus?
2013 frame .search.opts
2014 menubutton .search.opts.optword -textvariable wlabel -menu .search.opts.optword.menu \
2015 -indicatoron 1 -relief raised -anchor c -direction flush -font lfont \
2016 -width 11
2017 set balloonHelp(.search.opts.optword) [set s($lang)(bwords)]
2018 bindtags .search.opts.optword [list balloon .search.opts.optword Menubutton all]
2019 menu .search.opts.optword.menu -font lfont -tearoff 0
2020 .search.opts.optword.menu add command -label [set s($lang)(word)(0)] -font lfont -command \
2021 {set opts(word) 0; set wlabel [set s($lang)(word)(0)]}
2022 .search.opts.optword.menu add command -label [set s($lang)(word)(1)] -font lfont -command \
2023 {set opts(word) 1; set wlabel [set s($lang)(word)(1)]}
2024 set wlabel [set s($lang)(word)($opts(word))]
2025
2026 menubutton .search.opts.optcase -textvariable clabel -menu .search.opts.optcase.menu \
2027 -indicatoron 1 -relief raised -anchor c -direction flush -font lfont \
2028 -width 13
2029 set balloonHelp(.search.opts.optcase) [set s($lang)(bcase)]
2030 bindtags .search.opts.optcase [list balloon .search.opts.optcase Menubutton all]
2031
2032 menu .search.opts.optcase.menu -font lfont -tearoff 0
2033 .search.opts.optcase.menu add command -label [set s($lang)(case)(0)] -font lfont \
2034 -command {set opts(case) 0; set clabel [set s($lang)(case)(0)]}
2035 .search.opts.optcase.menu add command -label [set s($lang)(case)(1)] -font lfont \
2036 -command {set opts(case) 1; set clabel [set s($lang)(case)(1)]}
2037
2038 set clabel [set s($lang)(case)($opts(case))]
2039
2040 menubutton .search.opts.errors -textvariable elabel -menu .search.opts.errors.menu \
2041 -indicatoron 1 -relief raised -anchor c -direction flush -font lfont \
2042 -width 9
2043 set balloonHelp(.search.opts.errors) [set s($lang)(berrors)]
2044 bindtags .search.opts.errors [list balloon .search.opts.errors Menubutton all]
2045 menu .search.opts.errors.menu -font lfont -tearoff 0
2046
2047 # set opts(errors) 0
2048 if {[expr $opts(errors) == -1]} {
2049 set elabel [set s($lang)(closestmatch)]
2050 } else {
2051 set elabel "$opts(errors) [expr $opts(errors) == 1 ? {[set s($lang)(error)]} : {[set s($lang)(errors)]}]"
2052 }
2053
2054 for {set x 0} {$x < 5} {incr x} {
2055 set e [expr $x == 1 ? {[set s($lang)(error)]} : {[set s($lang)(errors)]}]
2056 .search.opts.errors.menu add command -label "$x $e" -font lfont \
2057 -command "
2058 set opts(errors) $x; set elabel \"$x $e\""
2059 }
2060 .search.opts.errors.menu add command -label [set s($lang)(closestmatch)] -font lfont \
2061 -command {set opts(errors) -1; set elabel [set s($lang)(closestmatch)]}
2062
2063
2064 menubutton .search.opts.regex -textvariable rlabel -menu .search.opts.regex.menu \
2065 -indicatoron 1 -relief raised -anchor c -direction flush -font lfont \
2066 -width 13
2067 set balloonHelp(.search.opts.regex) [set s($lang)(bregex)]
2068 bindtags .search.opts.regex [list balloon .search.opts.regex Menubutton all]
2069 menu .search.opts.regex.menu -font lfont -tearoff 0
2070 .search.opts.regex.menu add command -label [set s($lang)(regex)(0)] -font lfont -command \
2071 {set opts(regex) 0; set rlabel [set s($lang)(regex)(0)]}
2072 .search.opts.regex.menu add command -label [set s($lang)(regex)(1)] -font lfont -command \
2073 {set opts(regex) 1; set rlabel [set s($lang)(regex)(1)]}
2074 set rlabel [set s($lang)(regex)($opts(regex))]
2075
2076 pack .search.opts.optword .search.opts.optcase .search.opts.errors \
2077 .search.opts.regex -side left -fill x -padx 2
2078
2079 if {$param(params_as_menu) == 1} {
2080 pack .search.opts -side top -pady 2
2081 }
2082
2083 ####### Results
2084 frame .result
2085 if {! $mini} {
2086 # pack .result -side top -fill both -expand yes -padx 0 -pady 0
2087 }
2088
2089 text .result.text -bd 1 -state disabled -wrap none -relief groove \
2090 -padx 2 -pady 2 -font tfont -width 76 -height 16 \
2091 -yscrollcommand ".result.yscroll set" \
2092 -xscrollcommand [list xscroll .result.xscroll \
2093 [list grid .result.xscroll -in .result -row 1 -column 0 -sticky ew]]
2094
2095 # -yscrollcommand [list yscroll .result.yscroll
2096 # [list grid .result.yscroll -in .result -row 0 -column 1 -sticky ns]]
2097
2098 scrollbar .result.yscroll -orient vertical -command { .result.text yview }
2099 scrollbar .result.xscroll -orient horizontal -command { .result.text xview }
2100 if {$param(isunix)} { # I like smaller scrollbars
2101 .result.yscroll configure -width 10 -bd 1
2102 .result.xscroll configure -width 10 -bd 1
2103 }
2104
2105 grid .result.text -in .result -row 0 -column 0 -sticky news -padx 0 -pady 0 -ipadx 0 -ipady 0
2106 grid .result.yscroll -in .result -row 0 -column 1 -sticky ns
2107 # grid .result.xscroll -in .result -row 1 -column 0 -sticky we
2108 # grid .result.yscroll -sticky news
2109 # grid .result.xscroll -sticky news
2110 grid rowconfig .result 0 -weight 1 -minsize 0
2111 grid columnconfig .result 0 -weight 1 -minsize 0
2112 # grid remove .result.xscroll
2113 # grid remove .result.yscroll
2114 # grid configure .result.text -columnspan 2
2115 grid configure .result.text -rowspan 2
2116
2117
2118 ####### Status bar
2119 frame .statusBar
2120
2121 label .statusBar.lab -width 46 -relief sunken -bd 1 -height 1 \
2122 -text "[set s($lang)(cmd)] $searchmeth($param(cursearchmeth),grepcmd)" \
2123 -font sfont -anchor w
2124 label .statusBar.file -width 30 -relief sunken -bd 1 -height 1 \
2125 -font sfont -anchor w -justify right \
2126 -text $searchmeth($param(cursearchmeth),dictfile)
2127
2128 pack .statusBar.lab -side left -padx 1 -pady 1 -expand yes -fill x
2129 pack .statusBar.file -side left -padx 1 -pady 1 -expand yes -fill x
2130 # hideStatusBar $param(show_status)
2131
2132 update_searchmeth_menu
2133 set_opts_errors $param(cursearchmeth)
2134
2135 # automatically minimize?
2136 set param(do_automin) [expr {$param(win_prop) == 2 && $param(autominDelay) > 0}]
2137
2138
2139 # Key bindings
2140 set w .search.s.entry
2141 set t .result.text
2142
2143 bind $w <Return> "dictsearch \$query"
2144 bind $w <Shift-Return> {
2145 after cancel dictsearchquery
2146 display $curhistory $query 0 ""}
2147 bind $w <Control-Up> {history back}
2148 bind $w <Control-Down> {history forward}
2149 bind $w <Escape> {set query ""; .search.s.entry configure -foreground $param(fcolor); Reset 0}
2150 bind $w <Shift-Escape> {set query ""; Reset 1}
2151 bind $w <Control-u> {set query ""; .search.s.entry configure -foreground $param(fcolor); Reset 0}
2152 bind $w <Control-w> {%W selection clear; %W delete [tk::EntryPreviousWord %W insert] insert; .search.s.entry configure -foreground $param(fcolor); Reset 0}
2153 bind $w <Control-BackSpace> {%W selection clear; %W delete [tk::EntryPreviousWord %W insert] insert; .search.s.entry configure -foreground $param(fcolor); Reset 0}
2154
2155 # for autosearch
2156 foreach c {a b c d e f g h i j k l m n o p q r s t u v w x y z
2157 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
2158 adiaeresis odiaeresis udiaeresis ssharp
2159 Adiaeresis Odiaeresis Udiaeresis} {
2160
2161 bind $w <KeyPress-$c> {
2162 # problems mit KeyRelease an ^C/^L
2163 # debug 8 "KeyPress-%K"
2164 after cancel dictsearchquery;
2165 after $param(autosearchDelay) dictsearchquery
2166 }
2167 }
2168 bind $w <KeyRelease-asterisk> {
2169 after cancel dictsearchquery;
2170 after $param(autosearchDelay) dictsearchquery
2171 }
2172
2173
2174
2175 # These key bindings look a bit strange: scroll result's text with key bindings
2176 # to the entry. But the entry always has the focus...
2177 # Settings for scrolling with a wheel mouse
2178 # See http://www.inria.fr/koala/colas/mouse-wheel-scroll/
2179 if {$param(isunix)} {
2180 bind Text <Button-4> {%W yview scroll -1 units}
2181 bind Text <Button-5> {%W yview scroll 1 units}
2182 bind Text <Shift-Button-4> {%W yview scroll -5 units}
2183 bind Text <Shift-Button-5> {%W yview scroll 5 units}
2184 bind Text <Alt-Button-4> {%W yview scroll -1 pages}
2185 bind Text <Alt-Button-5> {%W yview scroll 1 pages}
2186 bind Text <Control-Button-4> {history back}
2187 bind Text <Control-Button-5> {history forward}
2188 } else {
2189 # for windows
2190 bind $w <MouseWheel> {$t yview scroll [expr {-(%D / 120)}] units}
2191 bind $w <Shift-MouseWheel> {$t yview scroll [expr {-(%D /120 * 5)}] units}
2192 bind $w <Alt-MouseWheel> {$t yview scroll [expr {-(%D / 120)}] pages}
2193 bind $w <Control-MouseWheel> {if {%D > 0} {history back} else {history forward}}
2194 }
2195
2196 bind $w <Up> {$t yview scroll -1 units}
2197 bind $w <Down> {$t yview scroll 1 units}
2198 bind $w <Shift-Up> {$t yview scroll -5 units}
2199 bind $w <Shift-Down> {$t yview scroll 5 units}
2200 bind $w <Prior> {$t yview scroll -1 pages}
2201 bind $w <Next> {$t yview scroll 1 pages}
2202 bind $w <Home> {$t yview moveto 0}
2203 bind $w <End> {$t yview moveto 1.0}
2204 bind $w <Shift-Left> {$t xview scroll -5 units}
2205 bind $w <Shift-Right> {$t xview scroll 5 units}
2206 bind $w <F1> helpGeneral
2207 bind $w <Control-s> {save 0}
2208 bind $w <Control-l> {save 1}
2209 bind $w <Control-c> {clipboard_copy_all}
2210 bind $w <Control-q> {
2211 if {$param(autosave) != 0} { saveOptions }
2212 exit
2213 }
2214 wm protocol . WM_DELETE_WINDOW {
2215 if {$param(autosave) != 0} { saveOptions }
2216 exit
2217 }
2218 wm protocol . WM_SAVE_YOURSELF {
2219 if {$param(autosave) != 0} { saveOptions }
2220 exit
2221 }
2222 bind $w <Control-m> sendMail
2223 bind $w <Control-o> {notice $param(noticefile)}
2224 bind $w <Control-n> startNew
2225 bind $w <Control-space> {hideResult -1}
2226 bind $w <Control-Shift-space> {
2227 set param(show_menu) [expr $param(show_menu) == 1 ? 0 : 1]
2228 hideMenuBar $param(show_menu) }
2229
2230 # change font on the fly
2231 bind $w <Control-plus> { change_font 1}
2232 bind $w <Control-minus> { change_font -1}
2233 bind $w <Control-equal> { change_font 0}
2234 bind $w <Control-0> { change_font 0}
2235
2236 bind Text <Double-1> {
2237 global query tk_version
2238 if {$tk_version < 8.4} {
2239 set tkPriv(selectMode) word
2240 tkTextSelectTo %W %x %y
2241 } else {
2242 set tk::Priv(selectMode) word
2243 tk::TextSelectTo %W %x %y
2244 }
2245 catch {%W mark set insert sel.last}
2246 catch {%W mark set anchor sel.first}
2247 catch {set q [selection get -displayof %W]}
2248 if {[string length $q] > 0 && [string compare $query $q]} {
2249 set query $q
2250 dictsearch $query
2251 }
2252 }
2253
2254 # mouse over text - highlight the line below the mouse pointer
2255 bind dlookup <Motion> {
2256 global param
2257 set tkPriv(x) %x
2258 set tkPriv(y) %y
2259 if {$param(hilite)} {
2260 .result.text tag remove hilite 1.0 end
2261 if {[string compare [.result.text index "@%x, %y linestart"] "1.0"]} {
2262 .result.text tag add hilite "@%x, %y linestart" "@%x, %y lineend"
2263 }
2264 }
2265 }
2266
2267 bind . <<PasteSelection>> {
2268 global query param
2269 set tkPriv(x) %x
2270 set tkPriv(y) %y
2271 debug 8 " Event <<PasteSelection>>: "
2272 if {$param(isunix)} {
2273 catch {set q [selection get]}
2274 } else {
2275 catch {set q [selection get -selection CLIPBOARD]}
2276 }
2277 if {[info exists q] && [string length $q] > 0 && [string compare $query $q]} {
2278 debug 8 " $q"
2279 set query $q
2280 dictsearch $query
2281 }
2282 }
2283
2284 # Shift + Mouse-2: search for dropped word in current results
2285 bind . <Shift-2> {
2286 global query param
2287 set tkPriv(x) %x
2288 set tkPriv(y) %y
2289 debug 8 " Event Shift-Mouse 2: "
2290 if {$param(isunix)} {
2291 catch {set q [selection get]}
2292 } else {
2293 catch {set q [selection get -selection CLIPBOARD]}
2294 }
2295 if {[info exists q] && [string length $q] > 0 && [string compare $query $q]} {
2296 debug 8 " $q"
2297 set query $q
2298 display $curhistory $query 0 ""
2299 }
2300 }
2301
2302 # right mouse button == popup menu
2303 bind dlookup <3> {
2304 debug 8 " Event <3>: .popup"
2305 tk_popup .popup %X %Y
2306 }
2307
2308 # fold/unfold all additional result entries
2309 proc fold_result {} {
2310 global history_fold curhistory
2311 debug 8 " fold_result: $history_fold($curhistory)"
2312 for {set i 1} {[info exists history_fold($curhistory)($i)]} {incr i} {
2313 if {$history_fold($curhistory) == 1} {
2314 set history_fold($curhistory)($i) 1
2315 } else {
2316 set history_fold($curhistory)($i) 0
2317 }
2318 catch {.result.text.fold$i invoke}
2319 }
2320 set history_fold($curhistory) [expr ! $history_fold($curhistory)]
2321 }
2322
2323 bind Text <Control-1> fold_result
2324
2325
2326 # Polling if global selection changes - for "search on text selection"
2327 proc check_selection {} {
2328 global query param last_selection check_selection_id opts
2329
2330 debug 16 "check_selection: [clock seconds]"
2331 set param(check_selection_active) 1
2332 if {$param(isunix)} {
2333 catch {set q [selection get]}
2334 } else {
2335 catch {set q [selection get -selection CLIPBOARD]}
2336 }
2337 if {[info exists q] && [string length $q] > 0} {
2338 set q_orig $q
2339 if {$opts(regex) == 0} { # replace regex characters
2340 regsub -all {[*|\]\[]} $q {} q
2341 }
2342 if {[string length $q] > 0 && \
2343 [string compare $last_selection $q] && \
2344 [string compare $last_selection $q_orig] && \
2345 [string compare $query $q]} {
2346 debug 2 "New selection: $q"
2347 set last_selection $q
2348 # substiture UTF-8 chars - should be done better
2349 regsub -all {Ã} $q {} q
2350 regsub -all {¤} $q {ä} q
2351 regsub -all {¶} $q {ö} q
2352 regsub -all {¼} $q {ü} q
2353 regsub -all {Ÿ} $q {ß} q
2354 regsub -all {„} $q {Ü} q
2355 regsub -all {–} $q {Ö} q
2356 regsub -all {œ} $q {Ü} q
2357 binary scan $q H* hex
2358 regsub -all (..) $hex {\\x\1} hex
2359 debug 2 "--> $hex"
2360 set query $q
2361 if {[llength [info procs dictsearch]]} {
2362 catch [dictsearch $query]
2363 # catch [dictsearch $last_selection]
2364 }
2365 }
2366 }
2367 set check_selection_id [after 500 check_selection]
2368 debug 16 "restarting check_selection id = $check_selection_id"
2369 }
2370
2371
2372 bind . <Enter> {
2373 global query param last_selection
2374 debug 16 "Enter %W $param(win_prop) $param(do_automin) search_prop = $param(search_prop)"
2375 if {[string compare %W "."] == 0} {
2376 focus .search.s.entry
2377 if {$param(search_prop) == 2} {
2378 # fri: Why was that here?
2379 # catch [check_selection]
2380 debug 16 "cancelling check_selection [after info]"
2381 set param(check_selection_active) 0
2382 after cancel check_selection
2383 }
2384 if {$param(search_prop) == 1} {
2385 # Search when we have Focus and a selection
2386 if {$param(isunix)} {
2387 catch {set q [selection get]}
2388 } else {
2389 catch {set q [selection get -selection CLIPBOARD]}
2390 }
2391 if {[info exists q] && [string length $q] > 0} {
2392 if {$opts(regex) == 0} { # replace regex characters
2393 regsub -all {[*|\]\[]} $q {} q
2394 }
2395 if {[string length $q] > 0 && \
2396
2397 [string compare $last_selection $q] && \
2398 [string compare $query $q]} {
2399 debug 8 " New selection entered: $q"
2400 set last_selection $q
2401 set query $q
2402 catch {[dictsearch $last_selection]}
2403 }
2404 }
2405 }
2406 if {$param(win_prop) == 1 || $param(do_automin) == 1} {
2407 # full window when focus in
2408 hideResult 1
2409 }
2410 if {$param(do_automin) == 1 && $param(win_prop) == 2 && $param(autominDelay) > 0} {
2411 debug 2 " cancelling automatically minimize <Enter>"
2412 set param(do_automin) 0
2413 after cancel {hideResult 0}
2414 }
2415 }
2416 }
2417
2418 bind . <Leave> {
2419 global param
2420 debug 16 "Leave %W"
2421 if {[string compare %W "."] == 0} {
2422 # remove highlight from line
2423 .result.text tag remove hilite 1.0 end
2424 if {$param(search_prop) == 2} {
2425 # poll selection
2426 if {$param(check_selection_active) == 0} {
2427 set check_selection_id [after 500 check_selection]
2428 debug 16 "Leave .: Started check_selection, id = $check_selection_id"
2429 }
2430 }
2431 }
2432 }
2433
2434 bind . <FocusOut> {
2435 global param
2436 debug 16 "FocusOut %W"
2437 if {[string compare %W "."] == 0} {
2438 if {$param(win_prop) == 1} {
2439 # mini window when focus out
2440 hideResult 0
2441 }
2442 if {$param(win_prop) == 2 && $param(autominDelay) > 0 &&
2443 $param(show_result) == 1} {
2444 set param(do_automin) 1
2445 debug 2 " automatically minimize after $param(autominDelay) ms (FocusOut)"
2446 after $param(autominDelay) {hideResult 0}
2447 }
2448 }
2449 }
2450
2451 proc catch_resize {} {
2452 global param curhistory history_result
2453 debug 8 "catch_resize"
2454 # update
2455
2456 if { $curhistory > 0 && [string length $history_result($curhistory)] > 0} {
2457 display $curhistory "" 2 ""
2458 }
2459 scan [wm geometry .] {%dx%d+} param(width) param(height)
2460 debug 8 " catch_resize - new size: $param(width) x $param(height)"
2461 }
2462
2463 # catch resize event to redisplay result text
2464 bind dlookup <Configure> catch_resize
2465
2466 # bind .search.s.entry <Delete> {set query ""}
2467
2468 bindtags .search.s.entry [list .search.s.entry Entry all]
2469
2470 # set tags for result text
2471 if {[winfo depth .] > 1} { # Color display
2472 set cols [shadeColor $param(fcolor) $param(bcolor)]
2473 set param(shadedcolor) [lindex $cols 0]
2474 set param(highcolor) [lindex $cols 1]
2475 set param(errcolor) [lindex $cols 2]
2476 set param(hicolor) [lindex $cols 3]
2477 .result.text configure -selectbackground $param(fcolor) -selectforeground $param(bcolor) -selectborderwidth 0
2478 .result.text tag configure bg1 -background $param(shadedcolor)
2479 .result.text tag configure matchfg -foreground $param(highcolor)
2480 .result.text tag configure search -background $param(highcolor) -foreground $param(bcolor)
2481 .result.text tag configure u -background $param(fcolor) -foreground $param(bcolor)
2482 .result.text tag configure hilite -background $param(hicolor)
2483 .result.text tag configure aux -font ifont
2484 .result.text tag configure ipa -font ipafont
2485 } else {
2486 set param(shadedcolor) white
2487 set param(highcolor) white
2488 .result.text tag configure bg1 -background $param(shadedcolor) -foreground black
2489 .result.text tag configure matchfg -background black -foreground white
2490 .result.text tag configure search -background black -foreground white
2491 .result.text tag configure u -underline 1
2492 .result.text tag configure hilite -underline 1
2493 .result.text tag configure aux -font ifont
2494 }
2495
2496 if 0 {
2497 # commented out
2498 if {![info exists grepcmds(agrep)]} {
2499 .result.text configure -state normal
2500 .result.text insert end [set s($lang)(noagrep)]
2501 .result.text insert end $gparam(grepcmd)
2502 .result.text configure -state disabled
2503 }
2504 }
2505
2506 setSearchBg $param(shadedcolor)
2507
2508 if ($mini) {
2509 wm geometry . {}
2510 hideResult 0
2511 set balloonHelp(.search.l.logo) [set s($lang)(normalsize)]
2512 .popup entryconfigure 7 -label [set s($lang)(normalsize)]
2513 update
2514 if [info exists param(width)] {
2515 set w $param(width)
2516 } else {
2517 set w [winfo width .search]
2518 }
2519 debug 8 " setting geometry: ${w}x[winfo height .search]"
2520 wm geometry . "${w}x[winfo height .search]"
2521 # wm geometry . {}
2522 } else {
2523 wm geometry . {}
2524 update
2525 hideResult 1
2526 }
2527
2528 # automatically minimize?
2529 if {$param(win_prop) == 2 && $param(autominDelay) > 0} {
2530 debug 2 " automatically minimize after $param(autominDelay) ms (start)"
2531 set param(do_automin) 1
2532 after $param(autominDelay) {hideResult 0}
2533 }
2534
2535 # Check selection?
2536 if {$param(search_prop) == 2} {
2537 # get current selection
2538 if {$param(isunix)} {
2539 catch {set q [selection get]}
2540 } else {
2541 catch {set q [selection get -selection CLIPBOARD]}
2542 }
2543 if {[info exists q] && [string length $q] > 0} {
2544 set last_selection $q
2545 }
2546
2547 # poll for new selection
2548 if {$param(check_selection_active) == 0} {
2549 after 500 check_selection
2550 }
2551 }
2552
2553 update
2554 set geo [wm geometry .]
2555 scan $geo {%dx%d+%d+%d} w h x y
2556 debug 8 "toplevel geometry: $geo, winfo: [winfo width .] [winfo height .] [winfo x .] [winfo y .], correcting height: $param(add_geom_height)"
2557
2558 if {! $mini} {
2559 set param(width) $w
2560 set param(height) $h
2561 }
2562
2563 if {[string length $query] == 0 && ! $mini} {
2564 # welcome message if not started with search query and not mini size
2565 welcome 1
2566 }
2567 bindtags .result.text {Text . all dlookup}
2568
2569 # Always the focus to the search entry:
2570 focus .search.s.entry
2571
2572 # }
2573 # mainWindow {}
2574
2575 #####################################
2576
2577 # Handling of external processes
2578 proc ExecCmd {cmd stderr_to_stdout} {
2579 global proc lines param
2580
2581 debug 1 "ExecCmd $cmd $stderr_to_stdout"
2582 if {$proc(pid) > 0} {
2583 .statusBar.lab config -foreground $param(errcolor) -text \
2584 "Search process is still running. Wait or hit Escape."
2585 return 1
2586 }
2587 if {$stderr_to_stdout == 1 && $param(iswin) == 0} {
2588 set cmd [concat $cmd {2>@stdout}]
2589 }
2590 set lines {}
2591 if [catch {set proc(pipe) [open "|$cmd" r+]} err] {
2592 if [string match "child process exited abnormally" $err] {
2593 .statusBar.lab config -foreground $param(errcolor) -text "[set s($lang)(noresults)] $query"
2594 } else {
2595 .statusBar.lab config -foreground $param(errcolor) -text $err
2596 }
2597 return 1
2598 }
2599 debug 4 "Pipe: $proc(pipe)"
2600 set proc(pid) [pid $proc(pipe)]
2601 set proc(processlist) [list $proc(pid) $cmd]
2602 # fconfigure $proc(pipe) -buffering none -blocking 0
2603 fileevent $proc(pipe) readable "CmdOut"
2604 return 0
2605 }
2606
2607 proc CmdOut {} {
2608 global proc sigchld lines param searchmeth
2609
2610 debug 2 "CmdOut"
2611 set r1 [catch {eof $proc(pipe)} res]
2612 if {$r1 || $res} {
2613 debug 4 " CmdOut: End of $proc(pipe): $proc(processlist)"
2614 catch {close $proc(pipe)} err
2615 debug 4 " CmdOut: Close pipe: $err"
2616 set sigchld 1
2617 # mark as finished
2618 set proc(processlist) {}
2619 set proc(pid) -1
2620 return
2621 }
2622 # else read from the pipe
2623 set line [read $proc(pipe)]
2624 if {[llength $lines] > 10 * $searchmeth($param(cursearchmeth),maxresults)} {
2625 # Reset
2626 return
2627 }
2628 # if {$line != ""}i
2629 foreach l [split $line "\n"] {
2630 lappend lines $l
2631 debug 4 " CmdOut: read [llength $lines] .$l."
2632 if {[llength $lines] > 10 * $searchmeth($param(cursearchmeth),maxresults)} {
2633 debug 4 " CmdOut: more than $searchmeth($param(cursearchmeth),maxresults) read, stopping"
2634 Reset 0
2635 break
2636 }
2637 }
2638 }
2639
2640 # handle queries with umlauts - make queries to find also other spellings
2641 proc umlautquery {query style} {
2642 debug 8 "umlautquery $query"
2643 if {[string length $query] < 1} {return ""}
2644 set q $query
2645 lappend Q $q
2646 if {[regsub -all {ae} $q {ä} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2647 if {[regsub -all {oe} $q {ö} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2648 if {[regsub -all {ue} $q {ü} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2649 if {[regsub -all {A[Ee]} $q {Ä} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2650 if {[regsub -all {O[Ee]} $q {Ö} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2651 if {[regsub -all {U[Ee]} $q {Ü} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2652 if {[regsub -all {ss} $q {ß} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2653 if {[regsub -all {ß} $q {ss} q] > 0 && [lsearch $Q $q] == -1} {lappend Q $q}
2654
2655 if {$style == "agrep"} {
2656 set ret [join $Q {,}]
2657 # new agrep ...
2658 # set ret [join $Q {|}]
2659 } else {
2660 set ret [join $Q {|}]
2661 if {[llength $Q] > 1} {set ret "($ret)"}
2662 }
2663 debug 8 " -> $ret"
2664 return $ret
2665 }
2666
2667 # Thanks to Holger Trapp <hot@hrz.tu-chemnitz.de>
2668 # enforce loading the Tcl procedures "tcl_wordBreakBefore" and
2669 # "tcl_wordBreakAfter" by calling them with senseless args.
2670 # Now the global strings "tcl_nonwordchars" and "tcl_wordchars" are initialized
2671 # and we can modify them as needed to specify the chars belonging or not
2672 # belonging to words respectively
2673 ### No need on Unix for this:
2674
2675 # if {$param(iswin) == 1} {
2676 tcl_wordBreakBefore "" 0
2677 tcl_wordBreakAfter "" 0
2678 # set tcl_wordchars {[a-zA-Z0-9_äöüÄÖÜß]}
2679 # set tcl_nonwordchars {[^a-zA-Z0-9_äöüÄÖÜß]}
2680 set tcl_wordchars "\\w"
2681 set tcl_nonwordchars "\\W"
2682
2683 # }
2684
2685 ### internal search - search in dict file without an external grep
2686 # Thanks to Jens Poenisch <jens@ruessel.in-chemnitz.de>
2687
2688 array set internal_search_Dict {}
2689 array set internal_search_init {}
2690
2691 proc internal_search {query dictfile max} {
2692 global internal_search_init internal_search_Dict internal_search_dict
2693 global param proc opts tcl_nonwordchars
2694 debug 4 "internal_search $query $dictfile $max"
2695
2696 if {! [info exists internal_search_init($dictfile)]} {
2697 set nr [array size internal_search_init]
2698 incr nr
2699 debug 4 "Initialising $dictfile ($nr) ..."
2700 set s0 [clock seconds]
2701 .statusBar.lab config -foreground $param(fcolor) \
2702 -text "Initializing $dictfile ..."
2703 update idletasks
2704 set fd [open $dictfile r]
2705 fconfigure $fd -buffersize 1024000
2706 set Text [read $fd]
2707 close $fd
2708
2709 # exact case
2710 set internal_search_Dict($nr) [split $Text \n]
2711 # lower case
2712 set text [string tolower $Text]
2713 set internal_search_dict($nr) [split $text \n]
2714
2715 set internal_search_init($dictfile) $nr
2716
2717 .statusBar.lab config -foreground $param(fcolor) \
2718 -text "[expr [clock seconds] - $s0] sec"
2719 debug 4 "done: [expr [clock seconds] - $s0] sec"
2720 }
2721 set f 0
2722 set num 0
2723 set result {}
2724 set proc(pid) 0
2725 set search {-regexp}
2726 if {$opts(regex) == 0} { # simple query
2727 regsub -all {\*} $query {.*} query
2728 }
2729 if {$opts(case) == 0} {
2730 set query [string tolower $query]
2731 }
2732 if {$opts(word) == 0} {
2733 set searchquery "(^|.*${tcl_nonwordchars})${query}(${tcl_nonwordchars}.*|$)"
2734 } else {
2735 set searchquery "${query}"
2736 }
2737 # case exact ?
2738 set in $internal_search_init($dictfile)
2739 if {$opts(case)} {
2740 set d $internal_search_Dict($in)
2741 } else {
2742 set d $internal_search_dict($in)
2743 }
2744 debug 8 "searchquery = $searchquery in $in"
2745 while {$proc(pid) == 0 && $num <= $max && \
2746 [set i [lsearch -regexp [lrange $d $f end] $searchquery]] >= 0} {
2747 update
2748 lappend result [lindex $internal_search_Dict($in) [expr $f+$i]]
2749 debug 4 "$num: [lindex $internal_search_Dict($in) [expr $f+$i]]"
2750 set f [expr $f+$i+1]
2751 incr num
2752 }
2753 debug 4 "internal_search ended - $num results"
2754 return $result
2755 }
2756
2757 proc querydictsearch {q} {
2758 global query
2759 debug 1 "querydictsearch $q"
2760 if {[string length $q] > 0} {
2761 set query $q
2762 return [dictsearch $query]
2763 }
2764 return 0
2765 }
2766
2767 proc dictsearch {query args} {
2768 global param gparam searchmeth result opts
2769 global curhistory inshistory
2770 global history_result history_query history_searchm history_pos history_fold
2771 global s logoanim defaultcursor lines sigchld
2772
2773 debug 1 "dictsearch $query"
2774 set lang $gparam(lang)
2775
2776 # cancel autosearch
2777 after cancel dictsearchquery
2778
2779 # disable auto minimize
2780 if {$param(do_automin) == 1 && $param(win_prop) == 2 && $param(autominDelay) > 0} {
2781 debug 2 " cancelling automatically minimize (dictsearch)"
2782 # set param(do_automin) 0
2783 after cancel {hideResult 0}
2784 }
2785
2786 # starts with / -> internal search
2787 if {[regexp {^/} $query]} {
2788 regsub {^/} $query {} iquery
2789 debug 2 " query starts with / -> internal search"
2790 # .search.s.entry delete 0 end
2791 # .search.s.entry insert 0 $query
2792 # set history_pos($curhistory) [lindex [.result.text yview] 0]
2793 set history_pos($curhistory) [.result.text index @0,0]
2794 display $curhistory $iquery 0 ""
2795 return 2
2796 }
2797
2798 # search method specified
2799 if [llength $args] {
2800 set c [lindex $args 0]
2801 if [info exists searchmeth($c,name)] {
2802 set param(cursearchmeth) $c
2803 .search.s.searchmeth configure -text $searchmeth($c,name)
2804 set_opts_errors $c
2805 }
2806 }
2807 set curr $param(cursearchmeth)
2808 debug 1 " using search method $curr ($searchmeth($curr,name))"
2809
2810 if {[string length $searchmeth($curr,dictfiles)] <= 0} {
2811 .statusBar.lab config -foreground $param(errcolor) -text [set s($lang)(nodictfile)]
2812 return 2
2813 }
2814
2815 # clean up query
2816 # remove spaces and so at the beginning and the end
2817 set orig_query $query
2818 regsub -all "^\[ ,;:+'\n\t\]*" $query {} query
2819 regsub -all "\[ ,:-;'\n\t\]*$" $query {} query
2820 # remove duplicate spaces
2821 regsub -all { *} $query { } query
2822 # remove newline, tab, \
2823 regsub -all "\[\n\r\t\]$" $query {} query
2824 regsub -all "\[\n\r\t\]" $query { } query
2825 regsub -all {\\$} $query {} query
2826 if {$opts(regex) == 0} {
2827 regsub -all {\.$} $query {} query
2828 regsub -all {~} $query {} query
2829 }
2830
2831 if {[string match "ispell" $searchmeth($curr,grepcmd)]} {
2832 set squery $query
2833 regsub -all {ä} $squery {a"} squery
2834 regsub -all {Ä} $squery {A"} squery
2835 regsub -all {ö} $squery {o"} squery
2836 regsub -all {Ö} $squery {O"} squery
2837 regsub -all {ü} $squery {u"} squery
2838 regsub -all {Ü} $squery {U"} squery
2839 regsub -all {ß} $squery {s"} squery
2840 } else {
2841 regsub -all {"a} $query {ä} query
2842 regsub -all {"A} $query {Ä} query
2843 regsub -all {"o} $query {ö} query
2844 regsub -all {"O} $query {Ö} query
2845 regsub -all {"u} $query {ü} query
2846 regsub -all {"U} $query {Ü} query
2847 regsub -all {"s} $query {ß} query
2848 regsub -all {"} $query "" query
2849 set squery $query
2850 }
2851 if {[string compare $orig_query $query]} {
2852 # if query changed, display it
2853 .search.s.entry delete 0 end
2854 .search.s.entry insert 0 $query
2855 }
2856
2857 if {[string length $squery] < $searchmeth($curr,minlength)} {
2858 if {$param(autosearch_active) == 0} {
2859 .statusBar.lab config -foreground $param(errcolor) \
2860 -text [set s($lang)(tooshort)]
2861 }
2862 return 2
2863 }
2864 if {[string length $squery] > $searchmeth($curr,maxlength)} {
2865 if {$param(autosearch_active) == 0} {
2866 .statusBar.lab config -foreground $param(errcolor) -text \
2867 "[set s($lang)(toolong)] ([string length $squery], max. $searchmeth($curr,maxlength))"
2868 }
2869 return 2
2870 }
2871
2872 # escape shell meta chars -> \
2873 regsub -all {([]\[\{\} `&$])} $squery {\\\1} squery
2874 regsub -all {([<>|])} $squery {\\\\\1} squery
2875
2876
2877 # evaluate options
2878 set isgrep 0
2879 set isspell 0
2880 set isdict 0
2881 set opt $searchmeth($curr,grepopts)
2882 set internal 0
2883 set q $query
2884 set cmd {}
2885 set stderr_to_stdout 1
2886
2887 if [string match "internal_*" $searchmeth($curr,grepcmd)] {
2888 # internal search
2889 set cmd [concat $searchmeth($curr,grepcmd) \"$query\" $searchmeth($curr,dictfiles) $searchmeth($curr,maxresults)]
2890 set internal 1
2891 # for sorting
2892 set isgrep 1
2893 } elseif {[string match "*grep" $searchmeth($curr,grepcmd)]} {
2894 # grep family
2895 set isgrep 1
2896 if {$opts(word) == 0 && ![regexp {[.| ]} $squery] && $opts(errors) != -1} {
2897 # words only search - makes no sense if search string contains
2898 # white space, or when "best match" used
2899 set opt "$opt -w"
2900 }
2901 if {$opts(case) == 0} {
2902 set opt "$opt -i"
2903 }
2904 if ($opts(errors)) {
2905 if {$opts(errors) == -1} {
2906 set opt "$opt -B -y"
2907 } else {
2908 set opt "$opt -$opts(errors)"
2909 }
2910 }
2911 if {$opts(regex) == 0} {
2912 if [string match "agrep*" $searchmeth($curr,grepcmd)] {
2913 # prepare simple pattern for agrep
2914 regsub -all {\*} $squery "#" squery
2915 # delete lonesome + at the end
2916 regsub -all {\+$} $query "" query
2917 regsub -all {\+$} $squery "" squery
2918 # AND: + -> ;
2919 regsub -all { *\+ *} $squery ";" squery
2920 # Umlaut
2921
2922 set squery [umlautquery $squery "agrep"]
2923 } else {
2924 # prepare simple pattern for other grep cmd: * -> .*
2925 regsub -all {\*} $squery ".*" squery
2926 set squery [umlautquery $squery "egrep"]
2927 }
2928 # q is for priority sorting
2929 regsub -all {[[\*+)(]} $query "" q
2930 }
2931 debug 8 " query = $query, squery = $squery"
2932
2933 set opt "$opt -e"
2934 set cmd [concat "$searchmeth($curr,grepcmd) $opt \"$squery\" $searchmeth($curr,dictfiles)"]
2935 } elseif {[string match "*spell" $searchmeth($curr,grepcmd)]} {
2936 # spell family
2937 set isspell 1
2938 set cmd [concat "echo \"$squery\" | $searchmeth($curr,grepcmd) $opt"]
2939 } elseif {[string match "*fortune" $searchmeth($curr,grepcmd)]} {
2940 # fortune
2941 set stderr_to_stdout 0
2942 if {[string length $squery] > 0} {
2943 # fortune with pattern
2944 if {$opts(case) == 0} {
2945 set opt "$opt -i"
2946 }
2947 if {$opts(word) == 0} {
2948 # words only search - add a space after word...
2949 set squery "$squery\[ !?.,\]"
2950 }
2951 set opt "$opt -m \"$squery\""
2952 }
2953 set cmd [concat "$searchmeth($curr,grepcmd) $opt"]
2954
2955 } else {
2956 # this is for dict:
2957 set isdict 1
2958 set strategy {}
2959 if {$opts(regex) == 1} {
2960 set strategy "-s re"
2961 } elseif {$opts(word) == 1 || [regexp { } $squery]} {
2962 regsub -all {\*} $squery "" squery
2963 set strategy "-s substring"
2964 } elseif {[regsub -all {\*$} $squery "" squery]} {
2965 set strategy "-s prefix"
2966 }
2967 # what to do with these?
2968 # setting more than one search strategy is useless
2969 if {$opts(errors) >= 1} {
2970 set opt "$opt -s lev"
2971 } elseif {$opts(errors) == -1} {
2972 set opt "$opt -s soundex"
2973 }
2974
2975 if {$strategy != ""} {
2976 set opt "$opt $strategy"
2977 }
2978 set cmd [concat "$searchmeth($curr,grepcmd) $opt -- \"$squery\""]
2979 }
2980
2981 set starttime [clock clicks -milliseconds]
2982 .statusBar.lab config -foreground $param(fcolor) -text "$cmd"
2983
2984 . configure -cursor watch
2985 .result.text configure -cursor watch
2986 .search.s.entry configure -cursor watch
2987 update
2988
2989 # Suche!
2990 set res ""
2991 set logoanim 1
2992 animlogo .search.l.logo
2993
2994 debug 1 "dictsearch: Starting $cmd"
2995 if ($internal) {
2996 set lines [eval $cmd]
2997 } else {
2998 set sigchld 0
2999 if {[ExecCmd $cmd $stderr_to_stdout] == 0} {
3000 tkwait variable sigchld
3001 } else {
3002 # wait a bit - allow to see the error message
3003 update idletasks
3004 after 2000
3005 }
3006 }
3007 # ok, read results
3008 update idletasks
3009 set resl {}
3010 set c 0
3011 foreach line $lines {
3012 # foreach line [split $lines "\n"]
3013 update idletasks
3014 incr c
3015 debug 2 "dictsearch: result $c: $line."
3016 if {!$isspell && [regexp "^#" $line]} { # skip comments
3017 continue
3018 }
3019 if {$isdict && [regexp "^No (definitions|matches) found for " $line]} {
3020 continue
3021 }
3022 set p 0
3023 # sorting of *grep
3024 if {$isgrep} {
3025 if {$line == ""} {continue}
3026 if [string match "Grand Total*" $line] {
3027 # get rid of Windows agrep's last line ...
3028 continue
3029 }
3030 # find good matches (word at beginning, exact order etc.)
3031 # remove alls (..) [..] {..}
3032 regsub -all { \{[^.\}]*\}} $line "" pline
3033 regsub -all { \([^.\)]*\)} $pline "" pline
3034 regsub -all { \[[^\]]*\]} $pline "" pline
3035 # debug 8 "$line\n$pline"
3036
3037 if {[regexp {[ +]} $query]} { # search words with spaces
3038 set p [regexp -nocase -- $q $pline]
3039 } else {
3040 set ml [regexp -all {\|} $line]
3041 if {$ml > 0} { # multiline result
3042 set p 0
3043 # Anfang + 100
3044 if {[regexp -nocase ":: (to )?${q}(;.*| )\\|" $pline] ||
3045 [regexp -nocase "^${q}(;| ).*\\|.* ::" $pline] } {
3046 set p [expr $p + 100 + $ml]
3047 # 1. Zeile
3048 } elseif {[regexp -nocase ":: \[^|\]*${q}.*\\|" $pline] ||
3049 [regexp -nocase "^\[^|\]*${q}.*\\|.* ::" $pline] } {
3050 set p $ml
3051 }
3052 } else {
3053 set p 2
3054 # set p [expr [string length $pline] - [string first $q $pline]]
3055 # Anfang + 100
3056 if {[regexp -nocase ":: (to )?${q}(;|$)" $pline] ||
3057 [regexp -nocase "^${q}(;| ::)" $pline]} {
3058 set p [expr $p + 100]
3059 } elseif {[regexp -nocase "; ${q}(;|$)" $pline]} {
3060 # Einzelwort
3061 set p [expr $p + 80]
3062 }
3063 # Abkürzung + 10
3064 if {[regexp { : } $pline]} {set p [expr $p + 10]}
3065 }
3066 }
3067 debug 8 "dictsearch: prio $p: $line"
3068 }
3069 lappend resl [list $p $line]
3070 }
3071 debug 8 "dictsearch: prio sorting ..."
3072 set res {}
3073 set first 1
3074 foreach l [lsort -decreasing -integer -index 0 $resl] {
3075 if {$first == 1} {set first 0} else {set res "$res\n"}
3076 set res "$res[lindex $l 1]"
3077 }
3078 debug 8 "dictsearch: prio sorting done"
3079 if [string length $res] {
3080 # results found
3081 .search.s.entry configure -foreground $param(fcolor)
3082 if {$inshistory >= $param(maxhistory)} {
3083 set inshistory 1
3084 } else {
3085 incr inshistory
3086 }
3087 .search.s.forw configure -state disabled
3088 .popup entryconfigure 1 -state disabled
3089 if {$curhistory != 0} {
3090 .search.s.back configure -state normal
3091 .popup entryconfigure 0 -state normal
3092 # mark the current scroll position
3093 #set history_pos($curhistory) [lindex [.result.text yview] 0]
3094 set history_pos($curhistory) [.result.text index @0,0]
3095 }
3096 set curhistory $inshistory
3097 set history_query($inshistory) $query
3098 set history_searchm($inshistory) $curr
3099 set history_result($inshistory) $res
3100 set history_pos($inshistory) 0.0
3101 set history_fold($inshistory) $searchmeth($curr,foldedresult)
3102 set endtime [clock clicks -milliseconds]
3103 display $inshistory "" 1 " [expr {$endtime - $starttime}] msec"
3104 set ret 0
3105 } else {
3106 # no results found
3107 # .search.s.entry delete 0 end
3108 # .search.s.entry insert 0 $query
3109 # .search.s.entry selection range 0 [string length $query]
3110 .statusBar.lab config -foreground $param(errcolor) -text \
3111 "[set s($lang)(noresults)] $query"
3112 .search.s.entry configure -foreground $param(errcolor)
3113 .result.text configure -state disabled
3114 set ret 1
3115 }
3116
3117 catch {close $in}
3118 after 400 {
3119 after cancel animlogo .search.l.logo
3120 .search.l.logo configure -image "logo1"
3121 }
3122
3123 . configure -cursor $defaultcursor
3124 .result.text configure -cursor $defaultcursor
3125 .search.s.entry configure -cursor $defaultcursor
3126 return $ret
3127 }
3128
3129 proc dictsearchquery {} {
3130 global query param
3131 debug 2 "dictsearchquery $query"
3132 if {$param(autosearch) == 0} return
3133 set param(autosearch_active) 1
3134 # set r [dictsearch $query]
3135 if {[dictsearch $query] == 1} {
3136 # no result -> try appending *
3137 debug 2 "dictsearchquery $query*"
3138 dictsearch "$query*"
3139 }
3140 }
3141
3142 proc dictsearchquery_onchange {} {
3143 global query param curhistory history_query history_searchm
3144 debug 2 "dictsearchquery_onchange $query - $curhistory"
3145 if {$param(autosearch) == 0} return
3146 if {[string length $query] == 0} return
3147 if {[info exists history_query($curhistory)] &&
3148 $history_query($curhistory) == $query && $history_searchm($curhistory) == $param(cursearchmeth)} {
3149 debug 2 "query and search method identical - returning"
3150 return
3151 }
3152 set param(autosearch_onchage_active) 1
3153 # set r [dictsearch $query]
3154 if {[dictsearch $query] == 1} {
3155 # no result -> try appending *
3156 debug 2 "dictsearchquery_onchange $query*"
3157 dictsearch "$query*"
3158 }
3159 }
3160
3161 # display: shows search results:
3162 # num - show result for number in history
3163 # search - highlight this string in result
3164 # status - update status line, remove scrollbars?
3165 # 1 = from new search, 2 = from history
3166 # extra - some extra status info
3167
3168 proc display {num search status extra} {
3169 global searchmeth maxresults param gparam s
3170 global history_query history_searchm history_result history_pos history_fold
3171
3172 debug 1 "display num = $num search = $search status = $status extra = $extra"
3173
3174 # make result visible
3175 hideResult 1
3176 wm deiconify .
3177
3178 if ![info exists history_query($num)] {
3179 return
3180 }
3181 if ![info exists history_pos($num)] {
3182 set history_pos($num) 0.0
3183 }
3184 set history_spos $history_pos($num);
3185 debug 4 "history_spos = $history_spos"
3186
3187 set lang $gparam(lang)
3188 set count 0
3189 set foldcount 0
3190 set more ""
3191 set shape 0
3192
3193 if {[string length $search] == 0 && $status != 1} {
3194 .search.s.entry delete 0 end
3195 .search.s.entry insert 0 $history_query($num)
3196 }
3197
3198 # selection to the query in search entry when no other selection active
3199 if {$param(isunix)} {
3200 catch {set q [selection get]}
3201 } else {
3202 catch {set q [selection get -selection CLIPBOARD]}
3203 }
3204 if {$param(autosearch_active) == 0 &&
3205 (![info exists q] ||
3206 ([string length $q] > 0 &&
3207 [string compare $q $history_query($num)] == 0))} {
3208 debug 2 "query selection exported: $history_query($num)"
3209 # debug 2 "query selection exported: $q - $history_query($num)"
3210 .search.s.entry configure -exportselection 1
3211 .search.s.entry selection range 0 end
3212 } else {
3213 debug 2 "query selection NOT exported: $history_query($num)"
3214 .search.s.entry configure -exportselection 0
3215 .search.s.entry selection range 0 end
3216 }
3217
3218 # search pattern for marking
3219 regsub -all {[,+]} $history_query($num) "|" mquery
3220 regsub -all {[[*+?)(|$]} $mquery "" mquery
3221 regsub -all {^-} $mquery "" mquery
3222 regsub -all { } $mquery " " mquery
3223 debug 8 " query = $history_query($num), mquery = $mquery"
3224
3225 set t .result.text
3226 $t configure -state normal
3227 $t delete 0.0 end
3228 # remove scrollbars
3229 if {$status > 0} {
3230 grid forget .result.xscroll
3231 # grid forget .result.yscroll
3232 # grid configure .result.text -columnspan 2
3233 grid configure .result.text -rowspan 2
3234 }
3235
3236 # compute tab stop in the middle
3237 # set width [$t cget -width]
3238 set width [winfo width $t]
3239 set w [expr round(($width / 2) - 2)]
3240 $t configure -tabs $w
3241
3242
3243 if {[string compare $searchmeth($history_searchm($num),language1) ""] || \
3244 [string compare $searchmeth($history_searchm($num),language2) ""]} {
3245 $t insert end \
3246 "$searchmeth($history_searchm($num),language1)\t $searchmeth($history_searchm($num),language2)\n" u
3247 }
3248
3249 set isdict [expr [string compare $searchmeth($history_searchm($num),grepcmd) "dict"] ? 0 : 1]
3250 set isfortune [string match "*fortune" $searchmeth($history_searchm($num),grepcmd)]
3251 set isspell [string match "*spell" $searchmeth($history_searchm($num),grepcmd)]
3252 if {$isspell} { ; # an empty line ...
3253 $t insert end "\n"
3254 }
3255 set spell_version {}
3256 set ftext 0
3257 set ffirst 1
3258 set xscroll 0
3259
3260 # for each line
3261 foreach l [split $history_result($num) "\n"] {
3262 if {!$isspell && [regexp "^#" $l]} { # skip comments
3263 continue
3264 }
3265 if {$count >= $searchmeth($history_searchm($num),maxresults)} {
3266 set more [set s($lang)(more)]
3267 break
3268 }
3269 if {$isdict == 1} {
3270 # dict - Find a "NUM definition found" l
3271 if {[regexp {^([0-9]+) definitions? found} $l b c]} {
3272 set count $c
3273 continue
3274 }
3275 } elseif {$isfortune == 1} {
3276 # fortune
3277 if {! $ftext && [regexp {^$} $l]} {
3278 continue
3279 }
3280 if {[regexp {^\(.*\)$} $l]} {
3281 set ftext 0
3282 continue
3283 }
3284 if {[regexp "^%$" $l]} {
3285 set l ""
3286 if {$searchmeth($history_searchm($num),shapedresult)} {
3287 set shape [expr ! $shape]
3288 }
3289 if $ftext {
3290 incr count
3291 $t insert end "\n"
3292 }
3293 continue
3294 } else {
3295 # fortune text
3296 # substitute tabs
3297 if $ffirst {
3298 incr count
3299 set ffirst 0
3300 $t insert end "\n"
3301 }
3302 set ftext 1
3303 regsub "\t" $l " " l
3304 }
3305 } elseif {$isspell == 1} {
3306 # ispell -a results:
3307 # fist line: @(#) Version
3308 # * ok
3309 # + <root word>
3310 # - <concatenation>,
3311 # & <original> <count> <offset>: <miss>, <miss>, ..., <guess>, ...
3312 # ? <original> 0 <offset>: <guess>, <guess>, ...
3313 # # <original> <offset>
3314
3315 if {[regexp {^@\(#\) (.+)} $l b spell_version]} {
3316 continue
3317 } elseif {[regexp {^$} $l]} {
3318 continue
3319 } elseif {[regexp {^\*} $l]} {
3320 set l [set s($lang)(correct)]
3321 } elseif {[regexp {^\+} $l]} {
3322 regsub {^\+} $l "[set s($lang)(root)]:" l
3323 } elseif {[regexp {^\#} $l]} {
3324 set l [set s($lang)(nosuggestion)]
3325 } else {
3326 regsub {.+: } $l "[set s($lang)(suggestion)]: \n" l
3327 # wrap results
3328 regsub -all {(.{40}[^,]*), } $l "\\1\n" l
3329 regsub -all {\n} $l "\n " l
3330
3331 # regsub -all {, } $l "\t\n" l
3332 }
3333 regsub -all {a"} $l {ä} l
3334 regsub -all {A"} $l {Ä} l
3335 regsub -all {o"} $l {ö} l
3336 regsub -all {O"} $l {Ö} l
3337 regsub -all {u"} $l {ü} l
3338 regsub -all {U"} $l {Ü} l
3339 regsub -all {s"} $l {ß} l
3340
3341 incr count
3342 } else {
3343 # not dict: 1 line == 1 match
3344 incr count
3345 # ignore <...> - old/wrong spelling
3346 regsub -all {<[^>]*>} $l {} l
3347 }
3348
3349 if {$searchmeth($history_searchm($num),shapedresult)} {
3350 if {$isdict == 1} {
3351 if {[regexp "^From " $l]} {
3352 set shape 1
3353 } else {
3354 set shape 0
3355 }
3356 } elseif {! $isfortune} {
3357 if {[expr $count % 2]} {
3358 set shape 1
3359 } else {
3360 set shape 0
3361 }
3362 }
3363 }
3364 set bgtag [expr {$shape == 1 ? {bg1 } : {}}]
3365
3366 if {[string compare $searchmeth($history_searchm($num),separator) ""] && \
3367 [regexp "$searchmeth($history_searchm($num),separator)" $l]} {
3368 regsub "$searchmeth($history_searchm($num),separator).*" $l "" lang1
3369 regsub ".*$searchmeth($history_searchm($num),separator)" $l "" lang2
3370 if {[regexp {\|} "$lang1"]} {
3371 # contains additional entries: separate on different lines
3372 set l1 [split $lang1 |]
3373 set l2 [split $lang2 |]
3374 incr foldcount
3375 set tag "vis$foldcount"
3376 if {! [info exists history_fold($num)($foldcount)]} {
3377 set history_fold($num)($foldcount) $history_fold($num)
3378 }
3379 $t tag configure $tag -elide [set history_fold($num)($foldcount)]
3380
3381 for {set i 0} {$i < [llength $l1]} {incr i} {
3382 if {$i == 0} { # first = main entry
3383 $t insert end "[lindex $l1 $i]\t" $bgtag
3384 set cmd "$t tag configure $tag -elide \[expr \[set history_fold($num)($foldcount)\]\]"
3385 checkbutton $t.fold$foldcount -image minus -selectimage plus \
3386 -variable history_fold($num)($foldcount) -indicatoron 0 \
3387 -bd 0 -width 8 -height 8 -command $cmd
3388 $t window create end -window $t.fold$foldcount
3389 $t insert end " [lindex $l2 $i]\n" $bgtag
3390 # search word within main entry?
3391 if {[string length $mquery] > 0 &&
3392 ([regexp -nocase "$mquery" [lindex $l1 $i]] ||
3393 [regexp -nocase "$mquery" [lindex $l2 $i]])} {
3394 set foundfirst 1
3395 debug 8 "found $mquery first"
3396 } else {
3397 set foundfirst 0
3398 debug 8 "NOT found $mquery first"
3399 }
3400 } elseif {(! $foundfirst) && [string length $mquery] > 0 &&
3401 ([regexp -nocase "$mquery" [lindex $l1 $i]] ||
3402 [regexp -nocase "$mquery" [lindex $l2 $i]])} {
3403 # search word in additional line
3404 $t insert end "[lindex $l1 $i]\t [lindex $l2 $i]\n" $bgtag
3405 } else { # additional entry
3406 $t insert end "[lindex $l1 $i]\t [lindex $l2 $i]\n" "$bgtag $tag"
3407 }
3408 }
3409 } else {
3410 $t insert end "$lang1\t $lang2\n" $bgtag
3411 }
3412 } else {
3413 $t insert end "$l\n" $bgtag
3414 }
3415 }
3416 # selection colors wins over other tags colors
3417 $t tag raise sel
3418
3419 if {$status > 0} {
3420 set erg [expr $count == 1 ? {[set s($lang)(result)]} : {[set s($lang)(results)]}]
3421 if {$isdict == 1 && $count == 0} {
3422 set count "??"
3423 }
3424 .statusBar.lab config -foreground $param(fcolor) -text "$count $erg $more $extra"
3425 if {$isspell == 1} {
3426 .statusBar.file config -foreground $param(fcolor) -text $spell_version
3427 }
3428 }
3429 # find and mark match pattern
3430 if {[string length $mquery] > 0} {
3431 debug 4 " find and mark match pattern: >$mquery<"
3432 set cur 1.0
3433 while 1 {
3434 set cur [.result.text search -nocase -count length -regexp -- $mquery $cur end]
3435 if {$cur == ""} {
3436 break
3437 }
3438 .result.text tag add matchfg $cur "$cur + $length char"
3439 set cur [.result.text index "$cur + $length char"]
3440 }
3441 }
3442
3443 # search pattern ?
3444 if {[string length $search] > 0} {
3445 debug 4 " find and mark search pattern: >$search<"
3446 # remove special chars
3447 regsub -all {\*} $search {} search
3448 if {[string length $search] <= 0} {
3449 return
3450 }
3451 if {$status > 0 || ![info exists history_spos] || $history_spos == 0} {
3452 set history_spos 1.0
3453 }
3454 set found 0
3455 set first {}
3456 # mark search words
3457 # start looking at current position
3458 set now [expr $history_spos + 1.0]
3459 set cur 1.0
3460 while 1 {
3461 set cur [.result.text search -nocase -count length -exact -- $search $cur end]
3462 if {$cur == {}} {
3463 break
3464 }
3465 if {$first == {}} {
3466 set first $cur
3467 }
3468 .result.text tag add search $cur "$cur + $length char"
3469 set new [.result.text index "$cur + $length char"]
3470 if {$found == 0} {
3471 if {$status == 0 && $history_spos != 1.0} {
3472 if [.result.text compare $cur > $now] {
3473 set history_spos $new
3474 set found 1
3475 }
3476 } else {
3477 set history_spos $new
3478 set found 1
3479 }
3480 }
3481 set cur $new
3482 }
3483 .statusBar.lab configure -foreground $param(fcolor) -text ""
3484 if {$found == 0} {
3485 # no next search results
3486 if {$first != {}} {
3487 # jump to the first
3488 set history_spos $first
3489 } else {
3490 # no search result
3491 .statusBar.lab configure -foreground $param(errcolor) \
3492 -text "[set s($lang)(notfound)]"
3493 }
3494 }
3495 set history_pos($num) $history_spos
3496 }
3497 if {$isdict == 1} {
3498 # mark word in dict results - synonyms, antonyms etc.
3499 set cur 1.0
3500 set pattern {\{[^\}]*\}}
3501 while 1 {
3502 set cur [.result.text search -nocase -count length -regexp -- $pattern $cur end]
3503 if {$cur == ""} {
3504 break
3505 }
3506 set length [expr $length - 2]
3507 .result.text delete $cur
3508 .result.text delete "$cur + $length char"
3509 .result.text tag add matchfg $cur "$cur + $length char"
3510 set cur [.result.text index "$cur + $length char"]
3511 }
3512 } else {
3513 debug 4 " find aux"
3514 set cur 1.0
3515 while 1 {
3516 set cur [.result.text search -nocase -count length -regexp -- {(\[[^]]*\]|\{[^\}]*\})} $cur end]
3517 if {$cur == ""} {
3518 break
3519 }
3520 .result.text tag add aux $cur "$cur + $length char"
3521 set cur [.result.text index "$cur + $length char"]
3522 }
3523 }
3524 if {$history_pos($num)} {
3525 #scroll
3526 debug 4 "Move to position $history_pos($num)"
3527 .result.text yview $history_pos($num)
3528 }
3529 .result.text configure -state disabled
3530 focus .search.s.entry
3531
3532 # raise is slowly with KDE/Gnome :-/
3533 if {$param(raise) == 1} {
3534 debug 2 "raise top win"
3535 raise .
3536 }
3537 # automatically minimize?
3538 if {$param(do_automin) == 1 && $param(win_prop) == 2 && $param(autominDelay) > 0} {
3539 debug 2 " automatically minimize after $param(autominDelay) ms (display)"
3540 after $param(autominDelay) {hideResult 0}
3541 }
3542 set param(autosearch_active) 0
3543 set param(autosearch_onchage_active) 0
3544 debug 1 "display return"
3545 }
3546
3547
3548 #### main
3549
3550 # if query is set via command line - search it:
3551 if {[string length $query] > 0} {
3552 dictsearch $query
3553 }
3554
3555
3556 proc save {what} {
3557 global inshistory history_result param gparam s
3558
3559 debug 2 "save $what"
3560 set lang $gparam(lang)
3561 if { $inshistory <= 0 || [string length $history_result($inshistory)] <= 0} {
3562 tk_messageBox -icon info -type ok -parent . -message \
3563 [set s($lang)(nosave)]
3564 return
3565 }
3566 set f [tk_getSaveFile]
3567 if {$f == ""} {
3568 return
3569 }
3570 set err [catch "set fd \[open $f w\]"]
3571 if $err {
3572 tk_messageBox -icon error -type ok -parent . -message \
3573 "Couldn't open $f for writing!"
3574 return
3575 }
3576 if {$what == 0} { # current result
3577 puts $fd $history_result($inshistory)
3578 } else { # all results in history
3579 for {set h [expr $inshistory + 1]} {$h <= [array size history_result]} {incr h} {
3580 puts $fd "$history_result($h)"
3581 }
3582 for {set h 1} {$h <= $inshistory} {incr h} {
3583 puts $fd "$history_result($h)"
3584 }
3585 }
3586 catch {close $fd}
3587 }
3588
3589 proc interface_reset {toggle_result} {
3590 global defaultcursor
3591
3592 debug 2 "interface_reset"
3593 after cancel animlogo .search.l.logo
3594 .search.l.logo configure -image "logo1"
3595 . configure -cursor $defaultcursor
3596 .result.text configure -cursor $defaultcursor
3597 .search.s.entry configure -cursor $defaultcursor
3598
3599 if {$toggle_result == 1} {
3600 hideResult -1
3601 }
3602 }
3603
3604 proc clipboard_copy_all {} {
3605 global last_selection param
3606
3607 debug 2 "clipboard_copy_all"
3608 .result.text tag remove sel 1.0 end
3609 .result.text tag add sel 1.0 end
3610 if {$param(isunix)} {
3611 catch {set last_selection [selection get]}
3612 } else {
3613 catch {set last_selection [selection get -selection CLIPBOARD]}
3614 }
3615 catch {clipboard clear}
3616 catch {clipboard append $last_selection}
3617 }
3618
3619 # places a window on the desktop
3620 proc placeWin {win diff} {
3621 debug 8 "placeWin $win $diff"
3622
3623 scan [wm geometry .] "%dx%d+%d+%d" w h x y
3624 set x [expr $x + $diff]
3625 set y [expr $y + $diff]
3626 debug 8 " -> +$x+$y"
3627 wm geometry $win +$x+$y
3628 }
3629
3630 proc aboutBox {} {
3631 global param gparam pinfo s defaultcursor
3632
3633 debug 2 "aboutBox"
3634 set lang $gparam(lang)
3635 # just in case ...
3636 interface_reset 0
3637
3638 if ![winfo exists .about] {
3639 toplevel .about
3640 wm group .about .
3641 wm title .about "$pinfo(pname) - [set s($lang)(about)]"
3642 wm resizable .about 0 0
3643 placeWin .about 50
3644
3645 text .about.text -font lfont -wrap word -width 60 -height 26 \
3646 -relief groove -padx 8 -pady 8
3647 button .about.ok -text "Ok" -width 8 -command {
3648 after cancel animlogo .about.text.logo
3649 destroy .about
3650 }
3651 pack .about.text -side top -expand 1 -fill x -fill y -ipady 10 -ipadx 10
3652 pack .about.ok -side bottom -pady 8
3653 label .about.text.logo -image logo1 -bd 1
3654 animlogo .about.text.logo
3655 after 1500 {
3656 catch {after cancel animlogo .about.text.logo}
3657 catch {.about.text.logo configure -image "logo1"}
3658 }
3659
3660 .about.text tag configure center -justify center
3661 .about.text tag configure bfont -font bfont -justify center
3662 .about.text tag configure homepage -foreground $param(highcolor) -underline 1 \
3663 -font bfont
3664 .about.text tag bind homepage <ButtonRelease-1> { urlOpen $pinfo(homepage) }
3665 .about.text tag bind homepage <Enter> { .about.text config -cursor hand2}
3666 .about.text tag bind homepage <Leave> { .about.text config -cursor xterm}
3667
3668 .about.text insert end " " center
3669 # .about.text image create end -image logo1 -pady 10 -align center
3670 .about.text window create end -window .about.text.logo -pady 10 -align center
3671 .about.text insert end " \n$pinfo(pname)\nVersion $pinfo(version)\n\n" bfont
3672 .about.text insert end "$pinfo(copyright)\n\nOnline: " center
3673 .about.text insert end "$pinfo(homepage)" homepage
3674
3675 if {$gparam(lang) == "de"} {
3676 .about.text insert end "\nKommentare sind sehr willkommen!\n" center
3677
3678 .about.text insert end "
3679 Dieses Programm ist freie Software. Sie können es unter \
3680 den Bedingungen der GNU General Public License, wie von der \
3681 Free Software Foundation veröffentlicht, weitergeben und/oder \
3682 modifizieren, entweder gemäß Version 2 der Lizenz oder (nach \
3683 Ihrer Option) jeder späteren Version.
3684
3685 Die Veröffentlichung dieses Programms erfolgt in der \
3686 Hoffnung, dass es Ihnen von Nutzen sein wird, aber OHNE \
3687 IRGENDEINE GARANTIE, sogar ohne die implizite Garantie \
3688 der MARKTREIFE oder der VERWENDBARKEIT FÜR EINEN BESTIMMTEN ZWECK. \
3689 Details finden Sie in der GNU General Public License.
3690
3691 Sie sollten ein Exemplar der GNU General Public License zusammen \
3692 mit diesem Programm erhalten haben. Falls nicht, siehe \
3693 <http://www.gnu.org/licenses/>.
3694 "
3695
3696 } else {
3697 .about.text insert end "\nComments are welcome!\n" center
3698 .about.text insert end "
3699 This program is free software; you can redistribute it and/or modify it \
3700 under the terms of the GNU General Public License as published by the \
3701 Free Software Foundation; either version 2 of the License, or (at your \
3702 option) any later version.
3703
3704 This program is distributed in the hope that it will be useful, \
3705 but WITHOUT ANY WARRANTY; without even the implied warranty of \
3706 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the \
3707 GNU General Public License for more details.
3708
3709 You should have received a copy of the GNU General Public License \
3710 along with this program. If not, see <http://www.gnu.org/licenses/>.
3711 "
3712 }
3713 .about.text configure -state disabled
3714 } else {
3715 wm deiconify .about
3716 raise .about
3717 }
3718 }
3719
3720 proc openHelpWindow {} {
3721 global param gparam s pinfo
3722
3723 debug 2 "openHelpWindow"
3724 set lang $gparam(lang)
3725 if ![winfo exists .help] {
3726 toplevel .help
3727 wm group .help .
3728 wm title .help "$pinfo(pname) - [set s($lang)(help)]"
3729 # wm resizable .help 0 0
3730 placeWin .help 50
3731
3732 text .help.text -font lfont -wrap word -width 80 -height 24 \
3733 -relief groove -yscrollcommand ".help.yscroll set" \
3734 -xscrollcommand ".help.xscroll set" \
3735 -padx 4 -pady 4 -wrap none
3736 scrollbar .help.yscroll -orient vertical \
3737 -command { .help.text yview }
3738 scrollbar .help.xscroll -orient horizontal \
3739 -command { .help.text xview }
3740 if {$param(isunix)} { # I like smaller scrollbars
3741 .help.yscroll configure -width 10 -bd 1
3742 .help.xscroll configure -width 10 -bd 1
3743 }
3744 button .help.ok -text "Ok" -width 8 -command {destroy .help}
3745 pack .help.ok -side bottom -pady 8
3746 pack .help.yscroll -side right -fill y
3747 pack .help.xscroll -side bottom -fill x
3748 pack .help.text -expand 1 -fill both
3749
3750 .help.text tag configure center -justify center
3751 .help.text tag configure big -font bfont -justify center
3752 .help.text tag configure bfont -font bfont
3753 .help.text tag configure maillink -foreground $param(highcolor) -underline 1
3754 .help.text tag bind maillink <ButtonRelease-1> { sendMail }
3755 .help.text tag bind maillink <Enter> { .help.text config -cursor hand2}
3756 .help.text tag bind maillink <Leave> { .help.text config -cursor xterm}
3757
3758 .help.text tag configure keylink -foreground $param(highcolor) -underline 1
3759 .help.text tag bind keylink <ButtonRelease-1> { helpKeys }
3760 .help.text tag bind keylink <Enter> { .help.text config -cursor hand2}
3761 .help.text tag bind keylink <Leave> { .help.text config -cursor xterm}
3762
3763 .help.text tag configure flaglink -foreground $param(highcolor) -underline 1
3764 .help.text tag bind flaglink <ButtonRelease-1> { helpCmdline }
3765 .help.text tag bind flaglink <Enter> { .help.text config -cursor hand2}
3766 .help.text tag bind flaglink <Leave> { .help.text config -cursor xterm}
3767
3768 .help.text tag configure abblink -foreground $param(highcolor) -underline 1
3769 .help.text tag bind abblink <ButtonRelease-1> { helpAbb }
3770 .help.text tag bind abblink <Enter> { .help.text config -cursor hand2}
3771 .help.text tag bind abblink <Leave> { .help.text config -cursor xterm}
3772
3773 .help.text tag configure helplink -foreground $param(highcolor) -underline 1 -font bfont
3774 .help.text tag bind helplink <ButtonRelease-1> { helpGeneral }
3775 .help.text tag bind helplink <Enter> { .help.text config -cursor hand2}
3776 .help.text tag bind helplink <Leave> { .help.text config -cursor xterm}
3777
3778 set w [expr round([winfo reqwidth .help.text] / 2) - 30]
3779 .help.text configure -tabs $w
3780 # mouse over text - highlight the line below the mouse pointer
3781 .help.text tag configure hilite -background $param(hicolor)
3782 bind .help.text <Motion> {
3783 global param
3784 if {$param(hilite)} {
3785 .help.text tag remove hilite 1.0 end
3786 if {[string compare [.help.text index "@%x, %y linestart"] "1.0"]} {
3787 .help.text tag add hilite "@%x, %y linestart" "@%x, %y lineend"
3788 }
3789 }
3790 }
3791 } else {
3792 wm deiconify .help
3793 # raise .help
3794 .help.text configure -state normal
3795 .help.text delete 0.0 end
3796 }
3797 }
3798
3799 proc helpGeneral {} {
3800 global s gparam pinfo
3801
3802 debug 2 "helpGeneral"
3803 set lang $gparam(lang)
3804 openHelpWindow
3805
3806 .help.text insert end "\n$pinfo(pname) - [set s($lang)(help)]\nVersion $pinfo(version)\n\n" big
3807
3808 if {$lang == "de"} {
3809 .help.text insert end {Suche starten:} bfont
3810 .help.text insert end {
3811 * Suchwort eingeben, Suchmethode auswählen, ENTER oder auf "Suche" drücken, oder
3812 * Doppelklick mit linker Maustaste auf Wort in Ergebnisfenster, oder
3813 * in anderem Fenser selektiertes Wort mit mittlerer Maustaste über
3814 Ergebnisfenster "fallenlassen"
3815 * Suche im Ergebnis:
3816 - Schrägstrich vor Suchwort: "/Suchwort" + ENTER oder
3817 - Suchwort eingeben, Umschalt+ENTER oder
3818 - mit mittlerer Maustaste auf "Suche" drücken oder
3819 - Umschalt-Taste drücken und selektiertes Wort mit mittlerer Maustaste
3820 über Ergebnisfenster "fallenlassen"
3821 }
3822 .help.text insert end {
3823 Suchworte angeben: } bfont
3824 .help.text insert end {
3825 * ein Suchwort oder
3826 * eins aus mehreren Wörtern (ODER-Verknüpfung): }
3827 .help.text insert end {Wort1,Wort2} bfont
3828 .help.text insert end {
3829 * alle Wörter (UND-Verknüpfung): }
3830 .help.text insert end {Wort1+Wort2} bfont
3831 .help.text insert end {
3832 * exakte Wortfolge: }
3833 .help.text insert end {Wort1 Wort2} bfont
3834 .help.text insert end {
3835 * }
3836 .help.text insert end {Umlaute: } bfont
3837 .help.text insert end {Falls Sie keine Umlaute auf der Tastatur haben, benutzen Sie:
3838 }
3839 .help.text insert end {"a = ä "A = Ä "o = ö "O = Ö "u = ü "U = Ü "s = ß} bfont
3840
3841 .help.text insert end {
3842
3843 Suchparameter: } bfont
3844 .help.text insert end {
3845 * Suche nach vollständigen Wörtern oder nach Muster in Wörtern?
3846 * Groß-/Kleinschreibweise ignorieren oder exakt beachten?
3847 * Korrekte Schreibweise oder, falls agrep benutzt wird, Fehlerkorrektur
3848 versuchen?
3849 * Einfache Suche (* als Platzhalter für beliebige Zeichen) oder
3850 reguläre Ausdrücke zulassen?
3851 }
3852
3853 .help.text insert end {
3854 Andere Suchverhalten } bfont
3855 .help.text insert end { sind über das Menü (oder durch Klick auf "Suchwort") einstellbar: }
3856 .help.text insert end {
3857 Suche, sobald Maus über Fenster: } bfont
3858 .help.text insert end {
3859 * Selektieren Sie in einem anderen Fenster ein Wort (linke Maustaste)
3860 * Sobald Sie mit der Maus über das Ding-Fenster kommen, wird dieses
3861 Wort mit aktueller Suchmethode gesucht.
3862 }
3863 .help.text insert end {
3864 Suche sofort bei neuer Textauswahl: } bfont
3865 .help.text insert end {
3866 * Sobald Sie in einem anderen Fenster ein Wort selektieren
3867 (linke Maustaste), wird dieses Wort mit aktueller Suchmethode gesucht.
3868 }
3869
3870 .help.text insert end {
3871 History-Funktion: } bfont
3872 .help.text insert end {
3873 * Frühere Suchergebnisse lassen sich wieder anzeigen (Knöpfe "<" bzw. ">")
3874 }
3875 .help.text insert end {
3876 Zur Funktionsweise: } bfont
3877 .help.text insert end "
3878 * \"$pinfo(pname)\" ist kein intelligentes Dolmetscherprogramm,
3879 sondern letztlich nur ein Front-End zur Suche in Dateien.
3880 * Die eigentliche Suche führt ein dafür existierendes Unix-Kommando aus der
3881 \"grep\"-Famile durch. Hat man \"agrep\" installiert, kann man die Funktion
3882 der \"fehlertoleranten Suche\" nutzen.
3883 * Die Ergebnisse sind nur so gut, wie die zugrundeliegende Wörterbuch-Datei.
3884 Zur Verbesserung dieser Datenbasis können Sie beitragen.
3885 Senden Sie einfach "
3886 .help.text insert end {eine E-Mail an den Autor.} maillink
3887
3888 .help.text insert end "\n\nWeitere Informationen:\n" bfont
3889 .help.text insert end " * "
3890 .help.text insert end "Hilfe zu Tastaturkürzeln" keylink
3891 .help.text insert end "\n * "
3892 .help.text insert end "Hilfe zu Startoptionen" flaglink
3893 .help.text insert end "\n * "
3894 .help.text insert end "Hilfe zu Abkürzungen" abblink
3895 .help.text insert end "
3896 * Unix-Manuals zu agrep, egrep, ispell, dict\n\n"
3897
3898 } else { # english
3899 .help.text insert end {Start search:} bfont
3900 .help.text insert end {
3901 * Type in search word, select a search method,
3902 then press ENTER or press the "Search" button, or
3903 * Double click on a word in the result window with left mouse button 1, or
3904 * Select a word in another X window, drop it by clicking with middle mouse
3905 button 2 over the result window.
3906 * Search in result:
3907 - Type a slash, then the search word: "/word" + ENTER, or
3908 - Type in search word, then press Shift+ENTER, or
3909 - press the "Search" button with mouse middle button 2, or
3910 - press Shift and drop word by clicking with middle mouse button 2
3911 over the result window.
3912 }
3913 .help.text insert end {
3914 Specify your search words: } bfont
3915 .help.text insert end {
3916 * Just one word, or
3917 * Find one of many words: }
3918 .help.text insert end {word1,word2} bfont
3919 .help.text insert end {
3920 * Find all words: }
3921 .help.text insert end {word1+word2} bfont
3922 .help.text insert end {
3923 * Find exact phrase: }
3924 .help.text insert end {word1 word2} bfont
3925 .help.text insert end {
3926 * }
3927 .help.text insert end {Umlauts: } bfont
3928 .help.text insert end {If you don't have umlaut keys on your keyboard, please use:
3929 }
3930 .help.text insert end {"a = ä "A = Ä "o = ö "O = Ö "u = ü "U = Ü "s = ß} bfont
3931
3932 .help.text insert end {
3933
3934 Search options: } bfont
3935 .help.text insert end {
3936 * Search for full words or partial matches within words?
3937 * Ignore case or search case sensitive?
3938 * If agrep is used, try error correction if nothing is found?
3939 * Simple search (* is wildcard for any character) or search with
3940 regular expressions?
3941 }
3942
3943 .help.text insert end {
3944 Another search behavior } bfont
3945 .help.text insert end { can be selected via the menu, or by clicking on "search word": }
3946 .help.text insert end {
3947 Search on mouse over: } bfont
3948 .help.text insert end {
3949 * Select a word in another window (left mouse button)
3950 * As soon as you move the mouse over the Ding window
3951 this word will be searched with the current search method.
3952 }
3953 .help.text insert end {
3954 Search on new text selection: } bfont
3955 .help.text insert end {
3956 * As soon as you select a word in another window (left mouse button)
3957 this word will be searched with the current search method.
3958 }
3959
3960 .help.text insert end {
3961 History function: } bfont
3962 .help.text insert end {
3963 * Previous search results could be displayed again ("<" and ">" buttons)
3964 }
3965 .help.text insert end {
3966 How it works: } bfont
3967 .help.text insert end "
3968 * \"$pinfo(pname)\" is not an intelligent translator system, but \"only\"
3969 a front-end to search quickly in files.
3970 * The search itself is done by a dedicated Unix command ala \"grep\".
3971 If you have installed \"agrep\" you are able to use the approximate
3972 matching feature to correct spelling errors.
3973 * Well, the results are as good as the dictionary wordlist.
3974 You could contribute to improve this list!
3975 Simply send "
3976 .help.text insert end {an email to the author.} maillink
3977
3978 .help.text insert end "\n\nFurther information:\n" bfont
3979 .help.text insert end " * "
3980 .help.text insert end "Help on Keyboard shortcuts" keylink
3981 .help.text insert end "\n * "
3982 .help.text insert end "Help on start options" flaglink
3983 .help.text insert end "\n * "
3984 .help.text insert end "Help on abbreviations" abblink
3985 .help.text insert end "
3986 * Unix manual pages for agrep, egrep, ispell, dict \n\n"
3987 }
3988 .help.text configure -state disabled
3989 }
3990
3991
3992 proc helpKeys {} {
3993 global s gparam pinfo
3994
3995 debug 2 "helpKeys"
3996 set lang $gparam(lang)
3997 openHelpWindow
3998 .help.text insert end "\n$pinfo(pname) - [set s($lang)(help)]\nVersion $pinfo(version)\n\n" big
3999
4000 if {$lang == "de"} {
4001 .help.text insert end {Viele Funktionen lassen sich einfach und schnell über }
4002 .help.text insert end {Tastaturkürzel} bfont
4003 .help.text insert end " erreichen.\n\n"
4004 .help.text insert end {Im Suchwort ändern:} bfont
4005 .help.text insert end "
4006 Kursur links (rechts)\tÄndern im Suchwort
4007 Esc, Strg+u\tSuchwort löschen, evtl. Suche stoppen, Oberfläche rücksetzen
4008 Umschalt + Esc\tSuchwort löschen, evtl. Suche stoppen, Oberfläche rücksetzen
4009 \tFenster minimieren oder normale Größe
4010 Strg+a\tan den Anfang des Suchwortes
4011 Strg+e\tans Ende des Suchwortes
4012 Strg+Zurück, Strg+w\tLöscht ein Wort links von aktueller Position
4013 Strg+k\tLöschen von aktueller Position bis Ende\n\n"
4014 .help.text insert end {Suchmethode ändern:} bfont
4015 .help.text insert end "
4016 Strg + 1\tSuche mit Methode 1, 2 usw.
4017 Strg + 2 ...\t ... je nachdem, wieviele definiert\n\n"
4018 .help.text insert end {Im Ergebnis blättern:} bfont
4019 .help.text insert end "
4020 Kursur hoch (runter) / Rollmaus\t1 Zeile hoch (runter)
4021 Umschalt + Kursur hoch (runter) / Rollmaus\t5 Zeilen hoch (runter)
4022 Bild hoch (runter) / Alt + Rollmaus\t1 Seite hoch (runter)
4023 Pos 1\tan den Anfang
4024 Ende\tans Ende
4025 Umschalt + Kursur links (rechts)\tnach links (rechts) verschieben (bei langen Zeilen)
4026
4027 Strg + Kursur hoch (runter)\tin früheren Suchergebnissen
4028 Strg + Rad der Rollmaus\tblättern (History)
4029 \n"
4030
4031 .help.text insert end {Menü-Funktionen:} bfont
4032 .help.text insert end "
4033 Strg + q\tProgramm beenden
4034 Strg + n\tNeues Programmfenster starten
4035 Strg + s\tAktuelles Ergebnis speichern
4036 Strg + l\tAlle Ergebnisse speichern
4037 Strg + c\tAktuelles Ergebnis in Zwischenablage
4038 Strg + m\tE-Mail an den Autor senden (nur Unix)\n\n"
4039
4040 .help.text insert end {Sonstiges:} bfont
4041 .help.text insert end "
4042 F1\tHilfe
4043 Strg + +\tSchrift vergrößern
4044 Strg + -\tSchrift verkleinern
4045 Strg + = oder Strg + 0\tStandard-Schriftgröße
4046 Strg + Klick links\tErgebnisse ein- oder ausklappen (wenn verfügbar)
4047 \n"
4048 .help.text insert end "Allgemeine Hilfe" helplink
4049 .help.text insert end "\n\n"
4050
4051 } else { # english
4052 .help.text insert end {Many functions are easily available by }
4053 .help.text insert end {Keyboard shortcuts} bfont
4054 .help.text insert end ".\n\n"
4055 .help.text insert end {To change the search word:} bfont
4056 .help.text insert end "
4057 Cursor left (right)\tEdit in the current word
4058 Esc, Ctrl+u\tErase search word, Stop search, Reset interface
4059 Shift + Esc\tErase search word, Stop search, Reset interface
4060 \tminimize window or set normal size
4061 Ctrl+a\tGo to the begin of the search word
4062 Ctrl+e\tGo to end of the search word
4063 Ctrl+Backspace, Ctrl+w\tErase one word left from current position
4064 Ctrl+k\tErase from current position to the end\n\n"
4065 .help.text insert end {To change the search method:} bfont
4066 .help.text insert end "
4067 Ctrl + 1\tSearch with method 1, 2 etc..
4068 Ctrl + 2 ...\t ... if defined\n\n"
4069 .help.text insert end {Scroll in the results:} bfont
4070 .help.text insert end "
4071 Cursor up (down) / wheel mouse\t1 line up (down)
4072 Shift + Cursor up (down) / wheel mouse\t5 lines up (down)
4073 Page up (down) / Alt + wheel mouse\t1 page up (down)
4074 Pos 1\tto the beginning
4075 End\tto the end
4076 Shift + Cursor left (right)\tscroll left (right) (for long lines)
4077
4078 Ctrl + Cursur up (down)\tbrowse through previous
4079 Ctrl + wheel of mouse\tsearch results (History)\n\n"
4080
4081 .help.text insert end {Menu functions:} bfont
4082 .help.text insert end "
4083 Ctrl + q\tQuit program
4084 Ctrl + n\tStart new program window
4085 Ctrl + s\tSave current result
4086 Ctrl + l\tSave all results
4087 Strg + c\tCopy current result to clipboard
4088 Ctrl + m\tSend an e-mail to the author (Unix only)\n\n"
4089 .help.text insert end {Others:} bfont
4090 .help.text insert end "
4091 F1\tHelp
4092 Ctrl + +\tIncrease font size
4093 Ctrl + -\tDecrease font size
4094 Ctrl + = or Ctrl + 0\tStandard font size
4095 Ctrl + click left\tFold or unfold search results (where available)
4096 \n"
4097 .help.text insert end {Umlauts: } bfont
4098 .help.text insert end {If you don't have umlaut keys on your keyboard, please use:
4099 }
4100 .help.text insert end {"a = ä "A = Ä "o = ö "O = Ö "u = ü "U = Ü "s = ß
4101
4102 } bfont
4103 .help.text insert end "General help" helplink
4104 .help.text insert end "\n\n"
4105
4106 }
4107 .help.text configure -state disabled
4108 }
4109
4110 proc helpCmdline {} {
4111 global s gparam pinfo argv0 ding_usage
4112
4113 debug 2 "helpCmdline"
4114 set lang $gparam(lang)
4115 openHelpWindow
4116 .help.text insert end "\n$pinfo(pname) - [set s($lang)(help)]\nVersion $pinfo(version)\n\n" big
4117
4118 if {$lang == "de"} {
4119 .help.text insert end "Das Programm $argv0 kann mit verschiedenen Optionen (Flags) gestartet werden:\n"
4120 .help.text insert end "$ding_usage(de)"
4121 .help.text insert end "Allgemeine Hilfe" helplink
4122 } else { # english
4123 .help.text insert end "The program $argv0 may be started with different options (command line flags):\n"
4124 .help.text insert end "$ding_usage(en)"
4125 .help.text insert end "General help" helplink
4126 }
4127 .help.text insert end "\n\n"
4128 .help.text configure -state disabled
4129 }
4130
4131 # updates the list of search methods in configuration
4132 proc update_searchmeth {num} {
4133 global searchmeth searchmpos
4134
4135 debug 2 "update_searchmeth $num"
4136 set sel [.ssearch.m.list curselection]
4137 set size [.ssearch.m.list size]
4138 .ssearch.m.list delete 0 $size
4139 foreach i $searchmpos {
4140 if {$searchmeth($i,name) != ""} {
4141 .ssearch.m.list insert end $searchmeth($i,name)
4142 }
4143 }
4144 if {$sel != ""} {
4145 set s [expr $sel + $num]
4146 if {($s <= $size && $s >= 0)} {
4147 .ssearch.m.list selection set $s
4148 }
4149 }
4150 # update
4151 }
4152
4153 proc helpAbb {} {
4154 global s gparam pinfo
4155
4156 debug 2 "helpAbb"
4157 set lang $gparam(lang)
4158 openHelpWindow
4159 set w [expr round([winfo reqwidth .help.text] / 7)]
4160 debug 4 "w = $w"
4161 .help.text tag configure abbtab -tabs "$w [expr 4 * $w] [expr 7 * $w]"
4162 .help.text tag configure abbtabb -tabs "$w [expr 4 * $w] [expr 7 * $w]" -font bfont
4163 .help.text insert end "\n$pinfo(pname) - [set s($lang)(help)]\nVersion $pinfo(version)\n\n" big
4164
4165 if {$lang == "de"} {
4166 .help.text insert end {Abkürzungen im Deutsch <> Englischen Wörterbuch} bfont
4167 } else { # english
4168 .help.text insert end {Used abbreviations in the German <> English Dictionary} bfont
4169 }
4170 .help.text insert end "\n\n\tWortart\tPart of speech\n" abbtabb
4171 .help.text insert end "
4172 {m}\tSubstantiv, männlich\tnoun, masculine
4173 {f}\tSubstantiv, weiblich\tnoun, feminine
4174 {n}\tSubstantiv, sächlich\tnoun, neuter
4175 {pl}\tSubstantiv, Plural\tnoun, plural
4176 {vt}\tVerb, transitiv\tverb, transitive
4177 {vi}\tVerb, intransitiv\tverb, intransitive
4178 {vr}\tVerb, reflexiv\tverb, reflexive
4179 {adj}\tAdjektiv\tadjective
4180 {adv}\tAdverb\tadverb
4181 {prp}\tPräposition\tpreposition
4182 {num}\tNumeral, Zahlwort\tnumeral
4183 {art}\tArtikel\tarticle
4184 {ppron}\tPersonalpronomen\tpersonal pronoun
4185 {conj}\tKonjunktion\tconjunction
4186 {interj}\tInterjektion; Ausruf \tinterjection
4187
4188 etw. - sth.\tetwas\tsomething
4189 jds. - sb.'s\tjemandes (Genitiv)\tsomebody's
4190 jdm. - sb.\tjemandem (Dativ)\tsomebody
4191 jdn. - sb.\tjemanden (Akkusativ)\tsomebody
4192 usw. - etc.\tund so weiter\tet cetera; and so on
4193 " abbtab
4194 .help.text insert end "\n\tVerwendung\tUsage\n" abbtabb
4195 .help.text insert end "
4196 \[alt\]\talte deutsche Rechtschreibung\told German spelling
4197 \[obs.\]\tveraltet; nicht mehr gebräuchlich\tobsolete
4198 \[Am.\]\tAmerikanisches Englisch\tAmerican English
4199 \[Br.\]\tBritisches Englisch\tBritish English
4200 \[Sc.\]\tSchottisches Englisch\tScottish English
4201 \[Austr.\]\tAutralisches Englisch\tAustralian English
4202 \[Süddt.\]\tSüddeutsch\tSouthern German
4203 \[Ös.\]\tösterreichisches Deutsch\tAustrian German
4204 \[Schw.\]\tSchweizerisch\tSwiss German
4205 \[ugs.\] \[coll.\]\tumgangssprachlich\tcolloquial
4206 \[übtr.\] \[fig.\]\tübertragen; bildlich\tfigurative
4207 \[slang\]\tJargon, Slang; saloppe Umgangssprache\tslang
4208 \[Sprw.\] \[prov.\]\tSprichwort\tproverb
4209 \[tm\]\tHandelsmarke; Warenzeichen\ttrademark
4210 " abbtab
4211
4212 .help.text insert end "\n\tFachgebiete\tSpecial branches\n" abbtabb
4213 .help.text insert end "
4214 \[anat.\]\tAnatomie\tanatomy
4215 \[arch.\]\tArchitektur\tarchitecture
4216 \[astron.\]\tAstronomie\tastronomy
4217 \[auto\]\tAutos; Automobilindustrie\tcars; automotive industry
4218 \[biochem.\]\tBiochemie\tbiochemistry
4219 \[biol.\]\tBiologie\tbiology
4220 \[bot.\]\tBotanik; Pflanzen\tbotany; plants
4221 \[chem.\]\tChemie\tchemistry
4222 \[comp.\]\tComputer\tcomputer
4223 \[constr.\]\tBauwesen\tconstruction
4224 \[econ.\]\tÖkonomie; Wirtschaft\teconomy
4225 \[electr.\]\tElektrotechnik, Elektronik\telectrical engineering, electronics
4226 \[cook.\]\tSpeisen; Kochen; Essen; Gastronomie\tdishes; cooking; eating; gastronomy
4227 \[geogr.\]\tGeografie\tgeography
4228 \[geol.\]\tGeologie\tgeology
4229 \[gramm.\]\tGrammatik\tgrammar
4230 \[jur.\]\tRecht, Jura\tlaw
4231 \[math.\]\tMathematik\tmathematics
4232 \[med.\]\tMedizin\tmedicine
4233 \[mil.\]\tMilitär\tmilitary
4234 \[min.\]\tMineralogie\tmineralogy
4235 \[mus.\]\tMusik\tmusic
4236 \[naut.\]\tNautik; Schifffahrtskunde\tnautical science; seafaring
4237 \[ornith.\]\tOrnithologie; Vogelkunde\tornithology
4238 \[pharm.\]\tPharmakologie; Arzneimittelkunde\tpharmacology
4239 \[phil.\]\tPhilosophie\tphilosophy
4240 \[phys.\]\tPhysik\tphysics
4241 \[pol.\]\tPolitik\tpolitics
4242 \[relig.\]\tReligion\treligion
4243 \[sport\]\tSport\tsports
4244 \[techn.\]\tTechnik\ttechnology; engineering
4245 \[textil.\]\tTextilindustrie\ttextile industry
4246 \[zool.\]\tZoologie; Tiere\tzoology; animals
4247 " abbtab
4248
4249 if {$lang == "de"} {
4250 .help.text insert end "\n\nAllgemeine Hilfe" helplink
4251 } else {
4252 .help.text insert end "\n\nGeneral help" helplink
4253 }
4254 .help.text insert end "\n\n"
4255 .help.text configure -state disabled
4256 }
4257
4258 proc setSearch {} {
4259 global s pinfo default_searchmeth searchmeth searchmpos gparam param grepcmds
4260
4261 debug 2 "setSearch"
4262 set lang $gparam(lang)
4263 if ![winfo exists .ssearch] {
4264 toplevel .ssearch
4265 wm group .ssearch .
4266 wm title .ssearch "$pinfo(pname): [set s($lang)(searchm)]"
4267 wm iconname .ssearch "dict"
4268 placeWin .ssearch 50
4269
4270 frame .ssearch.buttons
4271 pack .ssearch.buttons -side bottom -fill x
4272 button .ssearch.buttons.ok -text [set s($lang)(apply)] -command {
4273 update_searchmeth_menu
4274 if {$param(autosave) != 0} {
4275 saveOptions
4276 }
4277 destroy .ssearch
4278 }
4279 button .ssearch.buttons.cancel -text [set s($lang)(cancel)] -command "destroy .ssearch"
4280 pack .ssearch.buttons.ok .ssearch.buttons.cancel \
4281 -side left -expand 1 -pady 8 -padx 8
4282
4283 # Methods
4284 frame .ssearch.m -bd 2 -relief groove
4285 pack .ssearch.m -side top -fill x -ipady 10
4286 scrollbar .ssearch.m.scroll -command ".ssearch.m.list yview"
4287 if {$param(isunix)} { # I like smaller scrollbars
4288 .ssearch.m.scroll configure -width 10 -bd 1
4289 }
4290 listbox .ssearch.m.list -yscroll ".ssearch.m.scroll set" \
4291 -setgrid 1 -height 4
4292 menubutton .ssearch.m.new -text [set s($lang)(new)] -width 8 \
4293 -menu .ssearch.m.new.menu -indicatoron 1 -relief raised \
4294 -anchor c -direction flush
4295
4296 menu .ssearch.m.new.menu -font lfont -tearoff 0
4297 for {set j 0} {[info exists default_searchmeth($j,name)]} {incr j} {
4298 # check for available search cmds
4299 set state "disabled"
4300 foreach c $default_searchmeth($j,grepcmds) {
4301 if [info exists grepcmds($c)] {
4302 set state "active"
4303 break
4304 }
4305 }
4306 .ssearch.m.new.menu add command -label "$default_searchmeth($j,name)" \
4307 -state $state -command "setSearchOptions {} $j"
4308 }
4309 .ssearch.m.new.menu add command -label "Generic" -command "setSearchOptions {} -1"
4310
4311 button .ssearch.m.edit -text [set s($lang)(edit)] -width 8 \
4312 -state disabled -command {
4313 if {[.ssearch.m.list curselection] != {}} {
4314 setSearchOptions [lindex $searchmpos [.ssearch.m.list curselection]] {}
4315 }
4316 }
4317 button .ssearch.m.delete -text [set s($lang)(delete)] -width 8 \
4318 -state disabled -command {
4319 if {[.ssearch.m.list curselection] != {}} {
4320 set sel [.ssearch.m.list curselection]
4321 set searchmeth([lindex $searchmpos $sel],name) ""
4322 set searchmpos [lreplace $searchmpos $sel $sel]
4323 update_searchmeth 0
4324 }
4325 }
4326
4327 button .ssearch.m.up -image up -state disabled -command {
4328 if {[.ssearch.m.list curselection] != {}} {
4329 set sel [.ssearch.m.list curselection]
4330 if {$sel > 0} {
4331 set pos [lindex $searchmpos $sel]
4332 set searchmpos [lreplace $searchmpos $sel $sel]
4333 set searchmpos [linsert $searchmpos [expr $sel - 1] $pos]
4334 update_searchmeth -1
4335 }
4336 }
4337 }
4338 button .ssearch.m.down -image down -state disabled -command {
4339 if {[.ssearch.m.list curselection] != {}} {
4340 set sel [.ssearch.m.list curselection]
4341 if {$sel < [expr [.ssearch.m.list size] - 1]} {
4342 set pos [lindex $searchmpos $sel]
4343 set searchmpos [lreplace $searchmpos $sel $sel]
4344 set searchmpos [linsert $searchmpos [expr $sel + 1] $pos]
4345 update_searchmeth 1
4346 }
4347 }
4348 }
4349 grid .ssearch.m.list -in .ssearch.m -row 0 -column 0 -rowspan 5 \
4350 -sticky w,n,s -pady 4
4351 grid .ssearch.m.scroll -in .ssearch.m -row 0 -column 1 -rowspan 5 \
4352 -sticky w,n,s -pady 4
4353 grid .ssearch.m.up -in .ssearch.m -row 1 -column 2 -rowspan 1 \
4354 -padx 4 -sticky n
4355 grid .ssearch.m.down -in .ssearch.m -row 1 -column 2 -rowspan 1 \
4356 -padx 4 -sticky s
4357 grid .ssearch.m.new -in .ssearch.m -row 0 -column 3 -rowspan 1 \
4358 -padx 8 -pady 4
4359 grid .ssearch.m.edit -in .ssearch.m -row 1 -column 3 -rowspan 1 \
4360 -padx 8 -pady 4
4361 grid .ssearch.m.delete -in .ssearch.m -row 2 -column 3 -rowspan 1 \
4362 -padx 8 -pady 4
4363
4364 # grid .ssearch.m.down -in .ssearch.m -row 1 -column 2 -rowspan 1 \
4365 # -padx 8 -pady 4
4366
4367 bind .ssearch.m.list <Double-1> {
4368 setSearchOptions [lindex $searchmpos [.ssearch.m.list curselection]] {}
4369 }
4370 bind .ssearch.m.list <Return> {
4371 setSearchOptions [lindex $searchmpos [.ssearch.m.list curselection]] {}
4372 }
4373 bind .ssearch.m.list <1> {
4374 .ssearch.m.up configure -state normal
4375 .ssearch.m.down configure -state normal
4376 .ssearch.m.edit configure -state normal
4377 .ssearch.m.delete configure -state normal
4378 }
4379 update_searchmeth 0
4380
4381 } else {
4382 wm deiconify .ssearch
4383 raise .ssearch
4384 }
4385 }
4386
4387 proc setSearchOptions {num type} {
4388 global searchmeth default_searchmeth default_searchopts searchmpos grepcmds
4389 global param gparam pinfo s
4390
4391 debug 1 "setSearchOptions $num $type"
4392 set lang $gparam(lang)
4393 variable smeth
4394 if [array exists smeth] {
4395 unset smeth
4396 }
4397 variable new 0
4398 variable n $num
4399 if {$num != ""} {
4400 foreach i [array names searchmeth "$num,*"] {
4401 regsub "$num," $i "" j
4402 set smeth($j) $searchmeth($i)
4403 }
4404 } else {
4405 set n 0
4406 set new 1
4407 array set smeth [array get default_searchopts]
4408 foreach i [array names default_searchmeth "$type,*"] {
4409 regsub "$type," $i "" j
4410 set smeth($j) $default_searchmeth($i)
4411 }
4412 # set smeth(grepopts) $grepcmds($smeth(grepcmd))
4413 # set smeth(name) ""
4414 foreach i [array names searchmeth "*,name"] {
4415 incr n
4416 }
4417 set smeth(type) $type
4418 }
4419 if [winfo exists .sopts] {
4420 wm deiconify .sopts
4421 raise .sopts
4422 } else {
4423 toplevel .sopts
4424 wm group .sopts .
4425 wm title .sopts "$pinfo(pname): [set s($lang)(searcho)]"
4426 wm iconname .sopts "dict"
4427 placeWin .sopts 70
4428
4429 frame .sopts.buttons
4430 pack .sopts.buttons -side bottom -fill x
4431 button .sopts.buttons.ok -text [set s($lang)(apply)] -command {
4432 if {$smeth(name) == ""} {
4433 tk_messageBox -icon info -type ok -parent .sopts \
4434 -message [set s($lang)(namerequired)]
4435 focus .sopts.c.n
4436 return
4437 }
4438 set searchmeth($n,name) $smeth(name)
4439 set searchmeth($n,type) $smeth(type)
4440 set searchmeth($n,grepcmd) $smeth(grepcmd)
4441 set searchmeth($n,grepopts) $smeth(grepopts)
4442 set searchmeth($n,dictfile) $smeth(dictfile)
4443 set df [glob -nocomplain $smeth(dictfile)]
4444 set searchmeth($n,dictfiles) $df
4445 set searchmeth($n,separator) $smeth(separator)
4446 set searchmeth($n,language1) $smeth(language1)
4447 set searchmeth($n,language2) $smeth(language2)
4448 set searchmeth($n,minlength) $smeth(minlength)
4449 set searchmeth($n,maxlength) $smeth(maxlength)
4450 set searchmeth($n,maxresults) $smeth(maxresults)
4451 set searchmeth($n,shapedresult) $smeth(shapedresult)
4452 set searchmeth($n,foldedresult) $smeth(foldedresult)
4453 set searchmeth($n,avail) 1
4454 if {$new == 1} { # new
4455 lappend searchmpos $n
4456 }
4457 update_searchmeth 0
4458 unset smeth
4459 destroy .sopts
4460 }
4461 button .sopts.buttons.st -text [set s($lang)(default)] -command {
4462 if {$new == 1} { # new
4463 array set smeth [array get default_searchopts]
4464 } else {
4465 foreach i [array names searchmeth "$n,*"] {
4466 regsub "$n," $i "" j
4467 set smeth($j) $searchmeth($i)
4468 }
4469 }
4470 }
4471 button .sopts.buttons.cancel -text [set s($lang)(cancel)] \
4472 -command {
4473 unset smeth
4474 destroy .sopts
4475 }
4476 pack .sopts.buttons.ok .sopts.buttons.st .sopts.buttons.cancel \
4477 -side left -expand 1 -pady 8
4478
4479 # Command
4480 frame .sopts.c -bd 2 -relief groove
4481 pack .sopts.c -side top -fill x -ipady 10
4482 label .sopts.c.ln -text "[set s($lang)(name)]:" -font bfont
4483 entry .sopts.c.n -textvariable smeth(name) -font bfont -width 15
4484 label .sopts.c.l -text "[set s($lang)(grepcmd)]:" -font lfont
4485
4486
4487 if {$type != -1} {
4488 # pre-definded cmd
4489 menubutton .sopts.c.m -textvariable smeth(grepcmd) -menu .sopts.c.m.m \
4490 -indicatoron 1 -relief raised -anchor c -direction flush \
4491 -font lfont -width 13
4492 menu .sopts.c.m.m -font lfont -tearoff 0
4493 foreach c $default_searchmeth($smeth(type),grepcmds) {
4494 # all defined commands for this method
4495 if {![info exists grepcmds($c)]} {
4496 # not available in current system
4497 continue
4498 }
4499 if {$smeth(grepcmd) == ""} { # no default command yet
4500 set smeth(grepcmd) $c
4501 if ![info exists smeth(grepopts)] {
4502 # don't override specific options
4503 set smeth(grepopts) "$grepcmds($c)"
4504 }
4505 }
4506 if {$new == 1 || [string compare $c $searchmeth($n,grepcmd)] != 0} {
4507 # no options set so far
4508 if {[info exists default_searchmeth($smeth(type),grepopts)]} {
4509 # special options for this method
4510 set cmd "set smeth(grepopts) \"$default_searchmeth($smeth(type),grepopts)\""
4511 } else {
4512 # default options for this command
4513 set cmd "set smeth(grepopts) \"$grepcmds($c)\""
4514 }
4515 } else {
4516 # set default options
4517 set cmd "set smeth(grepopts) \"$searchmeth($n,grepopts)\""
4518 }
4519 set cmd "$cmd; set smeth(grepcmd) $c"
4520
4521 .sopts.c.m.m add command -label $c -font lfont -command $cmd
4522 }
4523 } else {
4524 # generic command - TODO!
4525 entry .sopts.c.m
4526 }
4527 label .sopts.c.l2 -text "[set s($lang)(grepopts)]:" -font lfont
4528 entry .sopts.c.o -textvariable smeth(grepopts) -font lfont -width 13
4529 grid .sopts.c.ln -in .sopts.c -row 0 -column 0 -rowspan 1 -sticky e \
4530 -padx 4 -pady 4
4531 grid .sopts.c.n -in .sopts.c -row 0 -column 1 -rowspan 1 -sticky w \
4532 -padx 4 -pady 4
4533 grid .sopts.c.l -in .sopts.c -row 1 -column 0 -rowspan 1 -sticky e \
4534 -padx 4 -pady 4
4535 grid .sopts.c.m -in .sopts.c -row 1 -column 1 -rowspan 1 -sticky w \
4536 -padx 4 -pady 4
4537 grid .sopts.c.l2 -in .sopts.c -row 2 -column 0 -rowspan 1 -sticky e \
4538 -padx 4 -pady 4
4539 grid .sopts.c.o -in .sopts.c -row 2 -column 1 -rowspan 1 -sticky w \
4540 -padx 4 -pady 4
4541
4542 # File
4543 frame .sopts.file -bd 2 -relief groove
4544 pack .sopts.file -side top -fill x -ipadx 10 -ipady 10 -pady 10
4545
4546 label .sopts.file.l -text "[set s($lang)(dictfile)]: " \
4547 -font lfont
4548 entry .sopts.file.e -width 36 -font lfont \
4549 -textvariable smeth(dictfile)
4550 variable types {
4551 {"Text files" {.txt .vok .dic}}
4552 {"All files" *}
4553 }
4554
4555 button .sopts.file.b -font lfont -text "Browse ..." \
4556 -command {
4557 set f [tk_getOpenFile -initialdir [file dirname $smeth(dictfile)] \
4558 -filetypes $types -parent .sopts]
4559 if [string compare $f ""] {
4560 set smeth(dictfile) $f
4561 }
4562 }
4563 grid .sopts.file.l -in .sopts.file -row 0 -column 0 -columnspan 6
4564 grid .sopts.file.e -in .sopts.file -row 1 -column 0 -columnspan 5 -sticky e
4565 grid .sopts.file.b -in .sopts.file -row 1 -column 6
4566
4567 label .sopts.file.l1 -text "[set s($lang)(lang)] 1:" -font lfont
4568 label .sopts.file.lt -text "[set s($lang)(sep)]:" -font lfont
4569 label .sopts.file.l2 -text "[set s($lang)(lang)] 2:" -font lfont
4570 entry .sopts.file.e1 -font lfont -textvariable smeth(language1) -width 10
4571 entry .sopts.file.et -font lfont -textvariable smeth(separator) -width 5
4572 entry .sopts.file.e2 -font lfont -textvariable smeth(language2) -width 10
4573
4574
4575 grid .sopts.file.l1 -in .sopts.file -row 2 -column 0 -padx 4 -columnspan 2
4576 grid .sopts.file.lt -in .sopts.file -row 2 -column 2 -padx 4 -columnspan 2
4577 grid .sopts.file.l2 -in .sopts.file -row 2 -column 4 -padx 4 -columnspan 2
4578 grid .sopts.file.e1 -in .sopts.file -row 3 -column 0 -padx 4 -columnspan 2
4579 grid .sopts.file.et -in .sopts.file -row 3 -column 2 -padx 4 -columnspan 2
4580 grid .sopts.file.e2 -in .sopts.file -row 3 -column 4 -padx 4 -columnspan 2
4581
4582
4583 frame .sopts.search -bd 2 -relief groove
4584 pack .sopts.search -side top -fill x -ipadx 10 -ipady 10
4585 label .sopts.search.rl -text "[set s($lang)(maxresults)]:" -font lfont
4586 entry .sopts.search.re -justify right -width 5 -font lfont -textvariable smeth(maxresults)
4587 label .sopts.search.ll -text "[set s($lang)(minlength)]:" -font lfont
4588 entry .sopts.search.le -justify right -width 5 -font lfont -textvariable smeth(minlength)
4589 label .sopts.search.ml -text "[set s($lang)(maxlength)]:" -font lfont
4590 entry .sopts.search.me -justify right -width 5 -font lfont -textvariable smeth(maxlength)
4591 checkbutton .sopts.search.shaped -text [set s($lang)(shaped)] -font lfont \
4592 -variable smeth(shapedresult)
4593 checkbutton .sopts.search.folded -text [set s($lang)(folded)] -font lfont \
4594 -variable smeth(foldedresult)
4595
4596 grid .sopts.search.rl -in .sopts.search -row 0 -column 0 -rowspan 1 -sticky e -padx 0
4597 grid .sopts.search.re -in .sopts.search -row 0 -column 1 -rowspan 1 -sticky w -padx 0
4598 grid .sopts.search.ll -in .sopts.search -row 1 -column 0 -rowspan 1 -sticky e -padx 0
4599 grid .sopts.search.le -in .sopts.search -row 1 -column 1 -rowspan 1 -sticky w -padx 0
4600 grid .sopts.search.ml -in .sopts.search -row 2 -column 0 -rowspan 1 -sticky e -padx 0
4601 grid .sopts.search.me -in .sopts.search -row 2 -column 1 -rowspan 1 -sticky w -padx 0
4602 grid .sopts.search.shaped -in .sopts.search -row 3 -column 0 -rowspan 1 -sticky w -padx 0
4603 grid .sopts.search.folded -in .sopts.search -row 4 -column 0 -rowspan 1 -sticky w -padx 0
4604 }
4605
4606 if {! [info exists default_searchmeth($smeth(type),dictfile)]} {
4607 .sopts.file.e configure -state disabled
4608 .sopts.file.b configure -state disabled
4609 .sopts.file.l configure -foreground darkgray
4610 }
4611 if {! [info exists default_searchmeth($smeth(type),separator)]} {
4612 .sopts.file.et configure -state disabled
4613 .sopts.file.lt configure -foreground darkgray
4614 }
4615 if {! [info exists default_searchmeth($smeth(type),language2)]} {
4616 .sopts.file.e2 configure -state disabled
4617 .sopts.file.l2 configure -foreground darkgray
4618 }
4619 }
4620
4621 proc setGeneral {} {
4622 global default
4623 global pinfo s languages
4624 global param gparam
4625
4626 debug 1 "setGeneral"
4627 set lang $gparam(lang)
4628 if ![winfo exists .general] {
4629 toplevel .general
4630 wm group .general .
4631 wm title .general "$pinfo(pname): [set s($lang)(general)]"
4632 wm iconname .general "ding"
4633 placeWin .general 50
4634
4635 variable fc "$param(fcolor)"
4636 variable bc "$param(bcolor)"
4637 variable ll $lang
4638 variable changes_restart 0
4639 variable ffamily
4640 variable fsize
4641 variable fstyle
4642 variable lffamily
4643 variable lfsize
4644 variable lfstyle
4645 set ffamily [lindex $param(tfont) 0]
4646 set fsize [lindex $param(tfont) 1]
4647 set fstyle [lindex $param(tfont) 2]
4648 set lffamily [lindex $param(lfont) 0]
4649 set lfsize [lindex $param(lfont) 1]
4650 set lfstyle [lindex $param(lfont) 2]
4651
4652 variable omaxhistory $param(maxhistory)
4653
4654 frame .general.buttons
4655 pack .general.buttons -side bottom -fill x
4656
4657 button .general.buttons.ok -text [set s($lang)(apply)] -command {
4658 if {$gparam(lang) != $ll} {
4659 set gparam(lang) $ll
4660 set lang $ll
4661 set changes_restart 1
4662 }
4663 set tf [list $ffamily $fsize $fstyle]
4664 if [string compare "$tf" "$param(tfont)"] {
4665 set param(tfont) $tf
4666 chFont tfont
4667 set param(ifont) [list $ffamily $fsize normal italic]
4668 chFont ifont
4669 # .result.text configure -font $param(tfont)
4670 # .search.s.entry configure -font $param(tfont)
4671 }
4672 set lf [list $lffamily $lfsize $lfstyle]
4673 if [string compare "$lf" "$param(lfont)"] {
4674 set param(lfont) $lf
4675 set param(bfont) [list $lffamily $lfsize bold]
4676 set param(sfont) [list $lffamily [expr $lfsize - 2] $lfstyle]
4677 chFont lfont
4678 chFont bfont
4679 chFont sfont
4680 }
4681 if {[string compare $param(fcolor) $fc] || [string compare $param(bcolor) $bc]} {
4682 # color change
4683 set param(fcolor) "$fc"
4684 set param(bcolor) "$bc"
4685 tk_setPalette foreground "$fc" background "$bc"
4686
4687 left configure -foreground $param(fcolor)
4688 right configure -foreground $param(fcolor)
4689 up configure -foreground $param(fcolor)
4690 down configure -foreground $param(fcolor)
4691 plus configure -foreground $param(bcolor)
4692 plus configure -background $param(fcolor)
4693 minus configure -foreground $param(bcolor)
4694 minus configure -background $param(fcolor)
4695
4696 if {[winfo depth .] > 1} { # Color display
4697 # other background color for result text
4698 set cols [shadeColor $param(fcolor) $param(bcolor)]
4699 set param(shadedcolor) [lindex $cols 0]
4700 set param(highcolor) [lindex $cols 1]
4701 set param(errcolor) [lindex $cols 2]
4702 set param(hicolor) [lindex $cols 3]
4703 .result.text configure -selectbackground $param(fcolor) -selectforeground $param(bcolor)
4704 .search.s.entry configure -selectbackground $param(fcolor) -selectforeground $param(bcolor)
4705 .result.text tag configure bg1 -background $param(shadedcolor)
4706 .result.text tag configure matchfg -foreground $param(highcolor)
4707 .result.text tag configure search -background $param(highcolor) -foreground $param(bcolor)
4708 .result.text tag configure u -background $param(fcolor) \
4709 -foreground $param(bcolor)
4710 .result.text tag configure hilite -background $param(hicolor)
4711 setSearchBg $param(shadedcolor)
4712 }
4713 if {($curhistory <= 0) || ([string length $query] == 0 && ! $mini)} {
4714 welcome 1
4715 }
4716 }
4717 if {$param(win_prop) == 2 && $param(autominDelay) > 0} {
4718 set param(do_automin) 1
4719 }
4720 if {$changes_restart == 1} {
4721 tk_messageBox -icon info -type ok -parent .general -message \
4722 [set s($lang)(changes_later)]
4723 }
4724 if {$param(autosave) != 0} {
4725 saveOptions
4726 }
4727 destroy .general
4728 }
4729 button .general.buttons.st -text [set s($lang)(default)] -command {
4730 set lang $default(language)
4731 set llabel $languages($lang)
4732 set fc $default(fcolor)
4733 set bc $default(bcolor)
4734 .general.c.fl configure -background $fc
4735 .general.c.bl configure -background $bc
4736 set ffamily [lindex $default(tfont) 0]
4737 set fsize [lindex $default(tfont) 1]
4738 set lffamily [lindex $default(lfont) 0]
4739 set lfsize [lindex $default(lfont) 1]
4740 set param(showBalloons) $default(showBalloons)
4741 set param(balloonDelay) $default(balloonDelay)
4742 set param(autosearch) $default(autosearch)
4743 set param(autosearchDelay) $default(autosearchDelay)
4744 set param(win_prop) $default(win_prop)
4745 set param(autominDelay) $default(autominDelay)
4746 set param(hilite) $default(hilite)
4747 set param(raise) $default(raise)
4748 set param(maxhistory) $default(maxhistory)
4749 set param(autosave) $default(autosave)
4750 }
4751 button .general.buttons.cancel -text [set s($lang)(cancel)] \
4752 -command "destroy .general"
4753 pack .general.buttons.ok .general.buttons.st .general.buttons.cancel \
4754 -side left -expand 1 -pady 8 -padx 8
4755
4756 # language
4757 frame .general.l -bd 2 -relief groove
4758 pack .general.l -side top -fill x -ipady 10
4759 label .general.l.l -text "[set s($lang)(lang)]:" -font lfont
4760 variable llabel
4761 set llabel $languages($lang)
4762 menubutton .general.l.m -textvariable llabel -menu .general.l.m.m \
4763 -indicatoron 1 -relief raised -anchor c -direction flush \
4764 -font lfont -width 13
4765 menu .general.l.m.m -font lfont -tearoff 0
4766 foreach i [array names languages] {
4767 .general.l.m.m add command -label $languages($i) -font lfont \
4768 -command "set ll $i; set llabel $languages($i)"
4769 }
4770 grid .general.l.l -in .general.l -row 0 -column 0 -rowspan 1 -sticky e \
4771 -padx 4 -pady 4
4772 grid .general.l.m -in .general.l -row 0 -column 1 -rowspan 1 -sticky w \
4773 -padx 4 -pady 4
4774
4775 # colors
4776 frame .general.c -bd 2 -relief groove
4777 pack .general.c -side top -fill x -ipady 10 -pady 10
4778
4779 button .general.c.fb -text [set s($lang)(fg)] -width 18 -font lfont \
4780 -command {
4781 set fc [selectColor .general $fc fg]
4782 raise .general
4783 if [string compare $fc ""] {
4784 .general.c.fl configure -background $fc
4785 }
4786 }
4787 button .general.c.bb -text [set s($lang)(bg)] -width 18 -font lfont \
4788 -command {
4789 set bc [selectColor .general $bc bg]
4790 raise .general
4791 if [string compare $bc ""] {
4792 .general.c.bl configure -background $bc
4793 }
4794 }
4795 label .general.c.fl -background $fc -width 13 -relief groove
4796 label .general.c.bl -background $bc -width 13 -relief groove
4797 button .general.c.flip -text [set s($lang)(change)] -font lfont \
4798 -command { set obc $bc; set bc $fc; set fc $obc;
4799 .general.c.fl configure -background $fc
4800 .general.c.bl configure -background $bc
4801 }
4802 grid .general.c.fb -in .general.c -row 0 -column 0 -sticky e \
4803 -padx 4 -pady 4
4804 grid .general.c.fl -in .general.c -row 0 -column 1 -sticky ew \
4805 -padx 4 -pady 4
4806 grid .general.c.bb -in .general.c -row 1 -column 0 -sticky e \
4807 -padx 4 -pady 4
4808 grid .general.c.bl -in .general.c -row 1 -column 1 -sticky ew \
4809 -padx 4 -pady 4
4810 grid .general.c.flip -in .general.c -row 0 -column 2 -rowspan 2 -sticky e \
4811 -padx 4 -pady 4
4812
4813 # Fonts
4814 # frame .general.f -bd 2 -relief groove
4815 pack .general.c -side top -fill x -ipady 10 -pady 10
4816 label .general.c.l -text "[set s($lang)(tfont)]: " -font lfont
4817 label .general.c.l2 -text "[set s($lang)(lfont)]: " -font lfont
4818
4819 menubutton .general.c.f -textvariable ffamily -menu .general.c.f.m \
4820 -indicatoron 1 -relief raised -anchor c -direction flush \
4821 -font lfont -width 13
4822 menu .general.c.f.m -font lfont -tearoff 0
4823 menubutton .general.c.f2 -textvariable lffamily -menu .general.c.f2.m \
4824 -indicatoron 1 -relief raised -anchor c -direction flush \
4825 -font lfont -width 13
4826 menu .general.c.f2.m -font lfont -tearoff 0
4827
4828 set allfams [lsort -unique [font families]]
4829 set found_fonts 0
4830 if {[llength $param(tfonts)] > 0} {
4831 foreach i $param(tfonts) {
4832 foreach f [lsearch -glob -all -inline $allfams $i] {
4833 # if {[lsearch $allfams [string tolower $i]] != -1}
4834 .general.c.f.m add command -label $f -font lfont \
4835 -command "set ffamily {$f}"
4836 .general.c.f2.m add command -label $f -font lfont \
4837 -command "set lffamily {$f}"
4838 incr found_fonts
4839 debug 8 "adding font $f"
4840 }
4841 }
4842 }
4843 if {$found_fonts < 3} { # use all available fonts
4844 foreach i $allfams {
4845 .general.c.f.m add command -label $i -font lfont \
4846 -command "set ffamily {$i}"
4847 .general.c.f2.m add command -label $i -font lfont \
4848 -command "set lffamily {$i}"
4849 }
4850 }
4851 menubutton .general.c.s -textvariable fsize -menu .general.c.s.m \
4852 -indicatoron 1 -relief raised -anchor c -direction flush \
4853 -font lfont -width 4
4854 menu .general.c.s.m -font lfont -tearoff 0
4855 menubutton .general.c.s2 -textvariable lfsize -menu .general.c.s2.m \
4856 -indicatoron 1 -relief raised -anchor c -direction flush \
4857 -font lfont -width 4
4858 menu .general.c.s2.m -font lfont -tearoff 0
4859 foreach i {7 8 10 12 14 15 16 18 24} {
4860 .general.c.s.m add command -label "$i" -font lfont \
4861 -command "set fsize \"$i\""
4862 .general.c.s2.m add command -label "$i" -font lfont \
4863 -command "set lfsize \"$i\""
4864 }
4865
4866 grid .general.c.l -in .general.c -row 2 -column 0 -sticky e \
4867 -padx 4 -pady 4
4868 grid .general.c.f -in .general.c -row 2 -column 1 -sticky w \
4869 -padx 4 -pady 4
4870 grid .general.c.s -in .general.c -row 2 -column 2 -sticky w \
4871 -padx 4 -pady 4
4872 grid .general.c.l2 -in .general.c -row 3 -column 0 -sticky e \
4873 -padx 4 -pady 4
4874 grid .general.c.f2 -in .general.c -row 3 -column 1 -sticky w \
4875 -padx 4 -pady 4
4876 grid .general.c.s2 -in .general.c -row 3 -column 2 -sticky w \
4877 -padx 4 -pady 4
4878
4879 # History, Balloon help, search behavior, autosave
4880 frame .general.b -bd 2 -relief groove
4881 pack .general.b -side top -fill x -ipady 10
4882 label .general.b.hl -text "[set s($lang)(maxhistory)]:" -font lfont
4883 entry .general.b.he -justify right -width 5 -font lfont \
4884 -textvariable param(maxhistory)
4885
4886 checkbutton .general.b.help -text [set s($lang)(balloon)] -font lfont \
4887 -variable param(showBalloons) -command {
4888 if {$param(showBalloons) == 1} {
4889 .general.b.e configure -state normal
4890 .general.b.l1 configure -state normal
4891 .general.b.l2 configure -state normal
4892 } else {
4893 .general.b.e configure -state disabled
4894 .general.b.l1 configure -state disabled
4895 .general.b.l2 configure -state disabled
4896 }
4897 }
4898
4899 label .general.b.l1 -text [set s($lang)(after)] -font lfont
4900 entry .general.b.e -width 5 -textvariable param(balloonDelay) \
4901 -font lfont -justify right
4902 label .general.b.l2 -text [set s($lang)(ms)] -font lfont
4903
4904 # Autosearch:
4905 checkbutton .general.b.autosearch -text [set s($lang)(autosearch)] -font lfont \
4906 -variable param(autosearch) -command {
4907 if {$param(autosearch) == 1} {
4908 .general.b.autosearche configure -state normal
4909 .general.b.autosearchl1 configure -state normal
4910 .general.b.autosearchl2 configure -state normal
4911 } else {
4912 .general.b.autosearche configure -state disabled
4913 .general.b.autosearchl1 configure -state disabled
4914 .general.b.autosearchl2 configure -state disabled
4915 }
4916 }
4917 set state [expr {$param(autosearch) == 1 ? {normal} : {disabled}}]
4918 label .general.b.autosearchl1 -text [set s($lang)(after)] -font lfont \
4919 -state $state
4920 entry .general.b.autosearche -width 5 -textvariable param(autosearchDelay) \
4921 -font lfont -justify right -state $state
4922 label .general.b.autosearchl2 -text [set s($lang)(ms)] -font lfont \
4923 -state $state
4924
4925 # Autominimize:
4926 checkbutton .general.b.automin -text [set s($lang)(automin)] -font lfont \
4927 -variable param(win_prop) -onvalue 2 -offvalue 0 -command {
4928 if {$param(win_prop) == 2} {
4929 .general.b.automine configure -state normal
4930 .general.b.autominl1 configure -state normal
4931 .general.b.autominl2 configure -state normal
4932 } else {
4933 .general.b.automine configure -state disabled
4934 .general.b.autominl1 configure -state disabled
4935 .general.b.autominl2 configure -state disabled
4936 }
4937 }
4938 set state [expr {$param(win_prop) == 2 ? {normal} : {disabled}}]
4939 label .general.b.autominl1 -text [set s($lang)(after)] -font lfont \
4940 -state $state
4941 entry .general.b.automine -width 5 -textvariable param(autominDelay) \
4942 -font lfont -justify right -state $state
4943 label .general.b.autominl2 -text [set s($lang)(ms)] -font lfont \
4944 -state $state
4945
4946 # Raise window when search done
4947 checkbutton .general.b.raise -text [set s($lang)(raise)] -font lfont \
4948 -variable param(raise)
4949
4950 # Highlight text line when mouse over
4951 checkbutton .general.b.hilite -text [set s($lang)(hilite)] -font lfont \
4952 -variable param(hilite)
4953
4954 # Autosave options
4955 checkbutton .general.b.as -text [set s($lang)(autosave)] -font lfont \
4956 -variable param(autosave)
4957
4958 grid .general.b.hl -in .general.b -row 0 -column 0 -columnspan 2 \
4959 -sticky w -padx 4 -pady 4
4960 grid .general.b.he -in .general.b -row 0 -column 2 \
4961 -sticky e -padx 4 -pady 4
4962 grid .general.b.help -in .general.b -row 1 -column 0 \
4963 -sticky w -padx 4 -pady 4
4964 grid .general.b.l1 -in .general.b -row 1 -column 1 \
4965 -sticky w -padx 4 -pady 4
4966 grid .general.b.e -in .general.b -row 1 -column 2 \
4967 -sticky e -padx 4 -pady 4
4968 grid .general.b.l2 -in .general.b -row 1 -column 3 \
4969 -sticky w -padx 4 -pady 4
4970 grid .general.b.autosearch -in .general.b -row 2 -column 0 \
4971 -sticky w -padx 4 -pady 4
4972 grid .general.b.autosearchl1 -in .general.b -row 2 -column 1 \
4973 -sticky w -padx 4 -pady 4
4974 grid .general.b.autosearche -in .general.b -row 2 -column 2 \
4975 -sticky e -padx 4 -pady 4
4976 grid .general.b.autosearchl2 -in .general.b -row 2 -column 3 \
4977 -sticky w -padx 4 -pady 4
4978 grid .general.b.automin -in .general.b -row 3 -column 0 \
4979 -sticky w -padx 4 -pady 4
4980 grid .general.b.autominl1 -in .general.b -row 3 -column 1 \
4981 -sticky w -padx 4 -pady 4
4982 grid .general.b.automine -in .general.b -row 3 -column 2 \
4983 -sticky e -padx 4 -pady 4
4984 grid .general.b.autominl2 -in .general.b -row 3 -column 3 \
4985 -sticky w -padx 4 -pady 4
4986 grid .general.b.raise -in .general.b -row 4 -column 0 -columnspan 3 \
4987 -sticky w -padx 4 -pady 4
4988 grid .general.b.hilite -in .general.b -row 5 -column 0 -columnspan 3 \
4989 -sticky w -padx 4 -pady 4
4990 grid .general.b.as -in .general.b -row 6 -column 0 -columnspan 3 \
4991 -sticky w -padx 4 -pady 4
4992
4993 } else {
4994 wm deiconify .general
4995 raise .general
4996 }
4997 }
4998
4999 proc selectColor {w color name} {
5000 global s gparam
5001
5002 debug 2 "selectColor $color $name"
5003 set lang $gparam(lang)
5004 grab $w
5005 set color [tk_chooseColor -parent $w -title "[set s($lang)(color)] [set s($lang)($name)]" \
5006 -initialcolor $color]
5007 grab release $w
5008 if [string compare $color ""] {
5009 return $color
5010 }
5011 }
5012
5013 # Save options
5014 proc saveOptions {} {
5015 global opts pinfo
5016 global param gparam
5017 global pinfo env s searchmeth searchmpos
5018
5019 debug 1 "saveOptions"
5020 if {$gparam(noconf) == 1} {
5021 return
5022 }
5023 set lang $gparam(lang)
5024 if {[file readable $param(rcfile)] &&
5025 ![file isfile $param(rcfile)]} {
5026 errorBox "$param(rcfile) isn't a regular file!"
5027 return
5028 }
5029 set err [catch "set fd \[open $param(rcfile) w\]"]
5030 if $err {
5031 errorBox "Couldn't open $param(rcfile) for writing!"
5032 return
5033 }
5034 puts $fd "# Options for $pinfo(pname) - do not edit!"
5035 puts $fd "# General options"
5036 puts $fd "set ding_version {$pinfo(version)}"
5037 puts $fd "set param(autosave) {$param(autosave)}"
5038 puts $fd "set param(hilite) {$param(hilite)}"
5039 puts $fd "set param(raise) {$param(raise)}"
5040 puts $fd "set gparam(lang) {$lang}"
5041 puts $fd "set param(showBalloons) {$param(showBalloons)}"
5042 puts $fd "set param(balloonDelay) {$param(balloonDelay)}"
5043 puts $fd "set param(autosearch) {$param(autosearch)}"
5044 puts $fd "set param(autosearchDelay) {$param(autosearchDelay)}"
5045 # puts $fd "set param(automin) {$param(automin)}"
5046 puts $fd "set param(autominDelay) {$param(autominDelay)}"
5047 puts $fd "set param(params_as_menu) {$param(params_as_menu)}"
5048 puts $fd "set param(show_menu) {$param(show_menu)}"
5049 puts $fd "set param(umlaut_buttons) {$param(umlaut_buttons)}"
5050 puts $fd "set param(show_result) {$param(show_result)}"
5051 puts $fd "set param(show_status) {$param(show_status)}"
5052 puts $fd "set param(fcolor) {$param(fcolor)}"
5053 puts $fd "set param(bcolor) {$param(bcolor)}"
5054 puts $fd "set param(lfont) {$param(lfont)}"
5055 puts $fd "set param(bfont) {$param(bfont)}"
5056 puts $fd "set param(sfont) {$param(sfont)}"
5057 puts $fd "set param(tfont) {$param(tfont)}"
5058 puts $fd "set param(ifont) {$param(ifont)}"
5059 puts $fd "set param(maxhistory) {$param(maxhistory)}"
5060 puts $fd "set param(width) {$param(width)}"
5061 puts $fd "set param(height) {$param(height)}"
5062 puts $fd "set param(search_prop) {$param(search_prop)}"
5063 puts $fd "set param(win_prop) {$param(win_prop)}"
5064
5065 puts $fd "set opts(word) {$opts(word)}"
5066 puts $fd "set opts(case) {$opts(case)}"
5067 puts $fd "set opts(errors) {$opts(errors)}"
5068 puts $fd "set opts(regex) {$opts(regex)}"
5069
5070 puts $fd "\n# Dictionaries and search methods"
5071 set n 0
5072 set so ""
5073 foreach i $searchmpos {
5074 set so "$so $n"
5075 incr n
5076 }
5077 puts $fd "set searchmpos {$so}"
5078
5079 set n 0
5080 foreach i $searchmpos {
5081 puts $fd "set searchmeth($n,name) {$searchmeth($i,name)}"
5082 puts $fd "set searchmeth($n,type) {$searchmeth($i,type)}"
5083 puts $fd "set searchmeth($n,dictfile) {$searchmeth($i,dictfile)}"
5084 puts $fd "set searchmeth($n,separator) {$searchmeth($i,separator)}"
5085 puts $fd "set searchmeth($n,language1) {$searchmeth($i,language1)}"
5086 puts $fd "set searchmeth($n,language2) {$searchmeth($i,language2)}"
5087 puts $fd "set searchmeth($n,grepcmd) {$searchmeth($i,grepcmd)}"
5088 puts $fd "set searchmeth($n,grepopts) {$searchmeth($i,grepopts)}"
5089 puts $fd "set searchmeth($n,maxlength) {$searchmeth($i,maxlength)}"
5090 puts $fd "set searchmeth($n,maxresults) {$searchmeth($i,maxresults)}"
5091 puts $fd "set searchmeth($n,minlength) {$searchmeth($i,minlength)}"
5092 puts $fd "set searchmeth($n,shapedresult) {$searchmeth($i,shapedresult)}"
5093 puts $fd "set searchmeth($n,foldedresult) {$searchmeth($i,foldedresult)}"
5094 incr n
5095 }
5096
5097 catch {close $fd}
5098 .statusBar.lab configure -foreground $param(fcolor) -text "[set s($lang)(saveopts)] ok"
5099 }
5100
5101 # History function
5102 proc history {where} {
5103 global curhistory inshistory history_query history_result history_pos
5104 global param gparam s
5105
5106 debug 1 "history $where"
5107 set lang $gparam(lang)
5108 set len [array size history_result]
5109
5110 if ![string compare $where "back"] { # back
5111 if {$curhistory == 0} {
5112 set curhistory $inshistory
5113 }
5114 debug 8 "history: back: max $param(maxhistory) cur $curhistory ins $inshistory len $len"
5115 if {($curhistory <= 0) ||
5116 ($curhistory == 1 && $len < $param(maxhistory)) ||
5117 ($curhistory == 1 && $inshistory == $param(maxhistory)) ||
5118 ($curhistory == [expr $inshistory + 1])} {
5119 # no more history entries
5120 .statusBar.lab config -foreground $param(fcolor) \
5121 -text [set s($lang)(noback)]
5122 return
5123 }
5124 # mark the current scroll position
5125 #set history_pos($curhistory) [lindex [.result.text yview] 0]
5126 set history_pos($curhistory) [.result.text index @0,0]
5127 if {$curhistory == 1} {
5128 set curhistory $param(maxhistory)
5129 } else {
5130 set curhistory [expr $curhistory - 1]
5131 }
5132 display $curhistory "" 2 ""
5133 if {($curhistory == 1 && (