alited stands for a lite editor.
It satisfies most requirements of Tcl Editors, adding its own features. It pretends to be the best of the Tcl Editors.
The main features of alited are:
Edited by alited are Tcl/Tk files. The C/C++ code is another target of alited, still for development of Tcl/Tk projects all the same.
alited facilitates the development and the maintenance of Tcl/Tk code, particularly because of the unit tree being a sort of documentation.
alited is suspected of being very good with large Tcl/Tk projects, i.e. when, in one session, you deal with 30-40-50... Tcl/Tk scripts, to say nothing of others.
It is quick at starting.
It is quick at switching projects.
It is quick at organizing Tcl/Tk code.
It is quick at navigating Tcl/Tk code.
It is quick at searching Tcl/Tk code.
It is quick at writing Tcl/Tk code.
It is quick at testing Tcl/Tk code.
It is quick at saving Tcl/Tk code.
It is quick at maintaining Tcl/Tk code.
Briefly, alited is totally quick, being at that a pure Tcl/Tk application.
For a quick acquaintance of alited, a few of its demos are available.
For a quick installation of alited, just run an installer of alited. Then run alited's desktop shortcut.
---
Also, when you have Tcl/Tk deployed on your machine and like to install and run alited from its source, you need only to unpack alited's source to a directory and run it with tclsh src/alited.tcl command. Thus, in this case the installation of alited is straightforward as well:
wish ~/PG/alited/src/alited.tcl
In Linux, you can run tclsh instead of wish.
alited project started 1 March 2021.
In fact, alited has been developed by its own v0.2 since 24 April 2021. Inspite of permanent overheads of this way, it turned out to be amazingly productive, more and more in the course of time.
When developing a weekend or small Tcl/Tk project, you can nicely do it with Geany or Kate or something else. The situation becomes not so nice with middle and large Tcl/Tk projects, however good and smart those editors are (they are indeed).
What is the large Tcl project? The poApps by Paul Obermeier may be considered the canonical large Tcl project. Its main source directories (poApplib, poTcllib, poTklib) contain about 70 Tcl scripts of size 2.5 Mb (total about 150 files, 5 Mb). Also, alited by itself is rather large project containing about 60 main Tcl scripts of size 1.7 Mb (total about 1150 files, 5 Mb), so that no wonder its editing session includes 70-80 files.
It is with the middle and large Tcl projects that alited reveals all its best, while it has 0 Kb of dependencies for developing Tcl/Tk 8.6.10+ and is in no way a half gigabyte monster.
The cause is obvious: those other editors are not Tclish, while alited is. It is intended specifically for developing Tcl/Tk projects, not for being a universal plug to every hole. Going its own way, of course. Do not forget that it has been coded in Tcl/Tk.
By the way, sometimes I still return to the good old Geany or Pluma (when my alited is busy with an open dialogue) - just to confirm once more how good alited is.
One just becomes more productive with alited at developing Tcl code. Just so simple.
One day I decided to change the data format of e_menu because the old .mnu files seemed to be too complex. The e_menu project had started in 2018, when I was an active user of Geany. As a result, its main scripts (e_menu.tcl and e_addon.tcl) were seen as chaotic mixtures of procedures - no structure, no consistency, no order.
I tried and tried to implement the format change, getting in the real trouble with the task that seemed to be so hard...
Finally, in one moment, I decided to rearrange my scripts by means of alited, i.e. to make a proper unit tree and to place the code units in their proper branches.
It was only after the radical rearrangement of e_menu.tcl and e_addon.tcl that I felt the format change can be easily implemented. I did it in two days instead of two weeks as it threatened to be at first.
Along the way, I got two nice unit trees of code. Being two nice pieces of documentation too.
In other words, alited is a sort of code architect and documentation generator that organizes and documents Tcl code "on fly" along with the coding.
The unit tree of alited is so good that it by itself can drastically improve Tcl code and enhance the productivity of Tclers. Not to mention other sweets of alited.
Below is a screenshot of alited, just to glance at it:
and its localized and themed variant:
and its dark theme on Windows 10:
and its 1.6.5 version installed 24.01.2024 on x86 machine with Debian v6.0 (Linux core v2.6.32) and GNOME v2.30.2, deployed far back in 2010:
and its localized variant running under Wine of Linux Mint DE on x86 machine (with Windows console started by alited, Linux console started by Linux Mint):
Displays a message in a balloon window.
| message |
| yes for red background; optional, default no |
| millisec. before showing the message; optional, default 100 |
| options of baltip::tip |
proc ::alited::Balloon {msg {red no} {timo 100} args} { # Displays a message in a balloon window. # msg - message # red - yes for red background # timo - millisec. before showing the message # args - options of baltip::tip variable al variable obPav set cs [$obPav csGet] set fg [lindex $cs 14] ;# colors of tips set bg [lindex $cs 15] if {$red} {set fg #6e0000} lassign [split [winfo geometry $al(WIN)] x+] w h x y set geo "+([expr {$w+$x}]-W)+$y-60" set msg [string map [list \n " \n "] $msg] if {[llength [split $msg \n]]==1} {set msg \n$msg\n} ::baltip clear $al(WIN) after $timo [list ::baltip tip $al(WIN) $msg -fg $fg -bg $bg -alpha 0.9 -font {-weight bold -size 11} -pause 1000 -fade 1000 -geometry $geo -bell $red -on yes -relief groove {*}$args] }
Shows a balloon about non-existing file.
| file's name |
proc ::alited::Balloon1 {fname} { # Shows a balloon about non-existing file. # fname - file's name variable al Balloon [string map [list %f $fname] $al(MC,filenoexist)] }
Runs "Check Tcl".
proc ::alited::CheckRun {} { # Runs "Check Tcl". CheckSource check::_run }
Sources check.tcl (at need).
proc ::alited::CheckSource {} { # Sources check.tcl (at need). ScriptSource check }
Tries to close a Help dialogue, open non-modal aside by the current dialogue.
proc ::alited::CloseDlg {} { # Tries to close a Help dialogue, open non-modal aside by the current dialogue. variable obDlg catch {[$obDlg ButOK] invoke} }
Destroys current window and focuses on previously focused widget.
| current window passed as %w |
| previously focused widget |
| Optional arguments. |
proc ::alited::destroyWindow {win foc args} { # Destroys current window and focuses on previously focused widget. # win - current window passed as %w # foc - previously focused widget catch {destroy $win} after idle after 100 "focusByForce $foc" }
Gets an edited file's extention without '.'.
| the file name; optional, default "" |
proc ::alited::EditExt {{fname {}}} { # Gets an edited file's extention without '.'. # fname - the file name if {$fname eq {}} {set fname [bar::FileName]} string trimleft [file extension $fname] . }
Ensures restoring an array at calling a proc.
| fully qualified array name |
| proc name & arguments |
proc ::alited::EnsureAlArray {arName args} { # Ensures restoring an array at calling a proc. # arName - fully qualified array name # args - proc name & arguments set foc [focus] ::apave::EnsureArray $arName {*}$args focusByForce $foc 20 }
Closes alited application.
| not used; optional, default "" |
| result of running of main window; optional, default 0 |
| if "yes", requests the confirmation of the exit; optional, default yes |
proc ::alited::Exit {{w {}} {res 0} {ask yes}} { # Closes alited application. # w - not used # res - result of running of main window # ask - if "yes", requests the confirmation of the exit variable al variable obPav set al(INI,isfindrepl) [expr {[winfo exist $al(WIN).winFind]}] if {$al(INI,confirmexit)>1} { set timo "-timeout {$al(INI,confirmexit) ButOK}" } else { set timo {} } if {!$ask || !$al(INI,confirmexit) || [msg okcancel info [msgcat::mc {Quitting alited.}] OK {*}$timo]} { if {[file::AllSaved]} { alited::menu::SaveCascadeMenuGeo catch {find::CloseFind} ;# save Find/Replace geometry if {$res eq {2}} { # save alited's settings: in main::_run not saved yet catch {ini::SaveIni} } tool::_close ;# close all of the catch {run::Cancel} ;# possibly open catch {check::Cancel} ;# non-modal catch {destroy $::alited::find::win2} ;# windows catch {destroy $::alited::al(FN2WINDOW)} ;# and its possible children catch {paver::Destroy} $obPav res $al(WIN) $res ::apave::endWM } } }
Gets the list of additional colors: branch, red, todo.
proc ::alited::FgAdditional {} { # Gets the list of additional colors: branch, red, todo. lassign [::hl_tcl::addingColors {} -AddTags] - - fgbr - - fgred - - - fgtodo list $fgbr $fgred $fgtodo }
Gets foregrounds of normal and colored text of current color scheme and red color of TODOs.
proc ::alited::FgFgBold {} { # Gets foregrounds of normal and colored text of current color scheme # and red color of TODOs. variable obPav lassign [FgAdditional] -> fgred if {[catch {set lst [$obPav csGet]}]} { set fg [ttk::style lookup "." -foreground] set bg [ttk::style lookup "." -background] set fgbold $fgred } else { lassign $lst - fg - bg fgbold } list $fg $fgbold $fgred $bg }
Focuses a current text.
proc ::alited::FocusText {} { # Focuses a current text. after idle after 100 {focusByForce [alited::main::CurrentWTXT]} }
Gets editor's font.
proc ::alited::Font {} { # Gets editor's font. variable al return $al(FONT,txt) }
Shows a help file for a procedure.
| currently active window |
| suffix for a help file's name; optional, default "" |
| options of HelpFile |
proc ::alited::Help {win {suff {}} args} { # Shows a help file for a procedure. # win - currently active window # suff - suffix for a help file's name # args - options of HelpFile HelpFile $win [HelpFname $win $suff] {*}$args }
Shows "About..." dialogue.
proc ::alited::HelpAbout {} { # Shows "About..." dialogue. if {[info commands about::About] eq {}} { source [file join $::alited::SRCDIR about.tcl] } about::About }
Shows a main help of alited.
| internal link; optional, default "" |
proc ::alited::HelpAlited {{ilink {}}} { # Shows a main help of alited. # ilink - internal link openDoc https://aplsimple.github.io/en/tcl/alited/index.html$ilink }
Reads and shows a help file.
| currently active window |
| the file's name |
| option of msg |
proc ::alited::HelpFile {win fname args} { # Reads and shows a help file. # win - currently active window # fname - the file's name # args - option of msg variable obDlg variable al if {[HelpOnce 1 $fname]} return lassign [::apave::extractOptions args -ale1Help no -ontop 0] ale1Help ontop if {[::asKDE]} {set ontop 1} set tags [MessageTags] if {[file exists $fname]} { set msg [readTextFile $fname] } else { set msg "Here should be a text of\n\"$fname\"" } if {$::alited::DEBUG} {puts "help file: $fname"} set wmax 1 foreach ln [split $msg \n] { set oc 0 foreach tag {r b link} { foreach yn {{} /} { set ln2 $ln set t <$yn$tag> set ln [string map [list $t {}] $ln] incr oc [expr {([string length $ln2]-[string length $ln])/([string length $t]+1)}] } } set wmax [expr {max($wmax,[string length $ln]+$oc)}] } set pobj $obDlg if {[info commands $pobj] eq {}} { # at first start, there are no apave objects bound to the main window of alited # -> create an independent one to be deleted afterwards set pobj alitedHelpObjToDel catch {::apave::APave create $pobj} } if {[llength [split $msg \n]]>30} { set args [linsert $args 0 -h 30 -scroll 1] } after 200 [list alited::HelpOnce 0 $fname] if {$ale1Help} { # if run from "Help/Context", remove its predecessor catch {destroy $al(DLGPREV)} after idle "set ::alited::al(DLGPREV) \[$pobj dlgPath\]" } set res [$pobj ok {} Help "\n$msg\n" -modal no -waitvar no -onclose "alited::destroyWindow %w [focus]" -centerme $win -text 1 -scroll no {*}$tags -ontop $ontop -w [incr wmax] {*}$args] return $res }
Gets a help file's name.
| currently active window |
| suffix for a help file's name; optional, default "" |
proc ::alited::HelpFname {win {suff {}}} { # Gets a help file's name. # win - currently active window # suff - suffix for a help file's name variable DATADIR set fname [lindex [split [dict get [info frame -2] proc] :] end-2] set fname [file join [file join $DATADIR help] $fname$suff.txt] return $fname }
Shows a help file for a procedure with "Don't show again" checkbox.
| currently active window |
| suffix for a help file's name; optional, default "" |
proc ::alited::HelpMe {win {suff {}}} { # Shows a help file for a procedure with "Don't show again" checkbox. # win - currently active window # suff - suffix for a help file's name variable al variable helpedMe if {[lsearch -exact $helpedMe $win]>-1} return set ans [HelpFile $win [HelpFname $win $suff] -ch $al(MC,noask)] if {[lindex $ans 0]==11} { lappend helpedMe $win } }
Handles "Help" window to have the only instance of it.
| 1 to check for existance the help; 0 to register it |
| file of help |
proc ::alited::HelpOnce {mode fname} { # Handles "Help" window to have the only instance of it. # mode - 1 to check for existance the help; 0 to register it # fname - file of help variable al2 variable obDlg set key _help_$fname if {$mode} { if {[info exists al2($key)] && [winfo exists $al2($key)]} { ::apave::deiconify $al2($key) return 1 } return 0 } if {[catch {set al2($key) [$obDlg dlgPath]}]} {set al2($key) 0} }
Tries to highlight add-on extensions.
| text's path |
| current file's name |
| colors of highlighting |
| font size; optional, default "" |
proc ::alited::HighlightAddon {wtxt fname colors {fontsize {}}} { # Tries to highlight add-on extensions. # wtxt - text's path # fname - current file's name # colors - colors of highlighting # fontsize - font size namespace upvar ::alited al al LIBDIR LIBDIR set res {} set ext [EditExt $fname] if {$ext ne {}} { catch { switch $ext { htm - ui - tpl1 {set ext html} ale - conf - typetpl {set ext ini} } set addon hl_$ext lassign [glob -nocomplain [file join $LIBDIR addon $addon.tcl]] fhl set addon [file rootname [file tail $fhl]] if {![namespace exists ::alited::$addon]} { if {[catch {source $fhl} err]} { alited::Message $err 4 return {} } } lappend colors [FgFgBold] if {$fontsize ne {}} { set fsz $fontsize } elseif {[dict exists $al(FONT,txt) -size]} { set fsz [dict get $al(FONT,txt) -size] } else { set fsz $al(FONTSIZE,std) } set res [${addon}::init $wtxt $al(FONT,txt) $fsz {*}$colors] obj set_highlight_matches $wtxt foreach tag {sel hilited hilited2} {after idle $wtxt tag raise $tag} } } return $res }
Gets highlighting colors.
proc ::alited::Hl_Colors {} { # Gets highlighting colors. variable al foreach nam [::hl_tcl::hl_colorNames] {lappend colors $al(ED,$nam)} return $colors }
Initializes the unit tree of file to be processed.
| tab's ID |
proc ::alited::InitUnitTree {TID} { # Initializes the unit tree of file to be processed. # TID - tab's ID set wtxt [main::GetWTXT $TID] if {$wtxt ne {}} {unit::RecreateUnits $TID $wtxt} return 1 }
Check if the tab's file is of .tcl type.
| tab's info |
proc ::alited::isTclScript {tab} { # Check if the tab's file is of .tcl type. # tab - tab's info set TID [lindex $tab 0] set fn [alited::bar::FileName $TID] expr {[string tolower [file extension $fn]] eq {.tcl}} }
Checks if a tip on the tree/favorites can be shown.
proc ::alited::IsTipable {} { # Checks if a tip on the tree/favorites can be shown. variable al if {[set foc [focus]] eq {} || [string match *tearoff* $foc]} { return no ;# no tips while focusing on a tearoff menu } if {[winfo toplevel $foc] ne $al(WIN)} { return no ;# no tips while focusing on a toplevel other than alited's main } return yes }
Returns a list of apave objects for dialogues.
Returns a list of apave objects for dialogues.
proc ::alited::ListPaved {} { # Returns a list of apave objects for dialogues. list obDlg obDl2 obFND obFN2 obCHK obRun }
Gets names of main user directories for settings.
proc ::alited::main_user_dirs {} { # Gets names of main user directories for settings. set ::alited::USERDIR [file join $::alited::CONFIGDIR alited] set ::alited::INIDIR [file join $::alited::USERDIR ini] set ::alited::PRJDIR [file join $::alited::USERDIR prj] }
Maps wildcards and %% in a string.
| options of "string map" command |
| string |
| list of wildcards and values: {%w1 $val1 %w2 $val2 ...} |
proc ::alited::Map {opts str args} { # Maps wildcards and %% in a string. # opts - options of "string map" command # str - string # args - list of wildcards and values: {%w1 $val1 %w2 $val2 ...} set abra {*^e!`i@U50=|} set str [string map [list %% $abra] $str] foreach {wc val} $args { set str [string map {*}$opts [list $wc $val] $str] } set str [string map [list $abra %] $str] }
Maps some common wildcards in a command
| the command |
Wildcards:
%H | home directory |
%P | directory of current project |
%F | current file name |
%D | directory of current file |
%A | directory of alited |
%M | directory of e_menu's menus |
%E | Tcl/Tk executable as set in Preferences/Tools |
proc ::alited::MapWildCards {com} { # Maps some common wildcards in a command # com - the command # Wildcards: # %H - home directory # %P - directory of current project # %F - current file name # %D - directory of current file # %A - directory of alited # %M - directory of e_menu's menus # %E - Tcl/Tk executable as set in Preferences/Tools variable al variable DIR set filename [bar::FileName] set dirname [file dirname $filename] set com [Map {} $com %H [apave::HomeDir] %P $al(prjroot) %F $filename %D $dirname %A $DIR %M $al(EM,mnudir) %E [Tclexe]] }
Displays a message in statusbar.
| message |
| 1: simple; 2: bold; 3: bold color; 4: bold red bell; 5: static; 6: bold red; optional, default 2 |
| label's name to display the message in; optional, default "" |
| serves to recursively erase the message; optional, default yes |
proc ::alited::Message {msg {mode 2} {lab {}} {first yes}} { # Displays a message in statusbar. # msg - message # mode - 1: simple; 2: bold; 3: bold color; 4: bold red bell; 5: static; 6: bold red # lab - label's name to display the message in # first - serves to recursively erase the message variable al variable obPav if {[info commands $obPav] eq {} || [catch {lassign [FgFgBold] fg fgbold fgred bg}]} { return ;# at exiting app } if {$lab eq {}} {set lab [$obPav Labstat3]} if {$first} {set msg [msgcat::mc $msg]} if {!$first && $msg ne {} && [winfo exists $lab]} { set curmsg [$lab cget -text] # if a message changed or expired, don't touch it (don't cover it with old 'msg') if {[string first $msg $curmsg]<0} return } set font [[$obPav Labstat2] cget -font] set fontB [list {*}$font -weight bold] set msg [string range [string map [list \n { } \r {}] $msg] 0 500] set slen [string length $msg] if {[catch {$lab configure -text $msg}] || !$slen} return $lab configure -font $font -foreground $fg if {$mode > 1} { $lab configure -font $fontB if {$mode == 4} { $lab configure -foreground $fgred if {$first} bell } elseif {$mode == 3 || $mode == 5} { $lab configure -foreground $fgbold } elseif {$mode == 6} { $lab configure -foreground $fgred } } if {$mode == 5} { update return } if {$first} { set msec [expr {200*$slen}] if {$mode > 1} { set opts "-font {$fontB}" } else { set opts {} } set tip [string trim [string range $msg 0 130]] if {[string trim [string range $msg [string length $tip] end]] ne {}} { append tip ... } baltip::tip $lab $tip -command [list alited::TipMessage %w %t] -per10 0 {*}$opts } else { set msg [string range $msg 0 end-1] set msec 10 } catch {after cancel $al(afterID)} if {$msec>0} { set al(afterID) [after $msec [list ::alited::Message $msg $mode $lab no]] } }
Doubles error message: in infobar and in status bar.
| error message |
proc ::alited::MessageError {msg} { # Doubles error message: in infobar and in status bar. # msg - error message info::Put $msg {} yes yes yes -fg Message $msg 4 }
Shows "Don't disturb" message.
proc ::alited::MessageNotDisturb {} { # Shows "Don't disturb" message. variable al lassign [alited::complete::TextCursorCoordinates] X Y set msg "Working...\nDon't disturb." Message $msg 3 ::baltip::showBalloon $msg -geometry "+$X+$Y" -fg $al(MOVEFG) -bg $al(MOVEBG) }
Gets tags for texts shown with messages.
Returns "-tags option" for messages.
proc ::alited::MessageTags {} { # Gets tags for texts shown with messages. # Returns "-tags option" for messages. lassign [FgFgBold] -> fS set ::alited::textTags [list [list "r" "-font {$::apave::FONTMAINBOLD} -foreground $fS"] [list "b" "-foreground $fS"] [list "link" "openDoc %t@@https://%l@@"] ] return {-tags ::alited::textTags} }
Shows a message in text box.
| the message |
| icon; optional, default info |
| Optional arguments. |
proc ::alited::Msg {inf {ic info} args} { # Shows a message in text box. # inf - the message # ic - icon msg ok $ic $inf -text 1 -w 50 {*}$args }
Shows a message and asks for an answer.
| ok/yesno/okcancel/yesnocancel |
| info/warn/err |
| the message |
| default button (for not "ok" dialogs); optional, default "" |
| additional arguments (-title and font's option) |
For "ok" dialogue, 'defb' is omitted (being a part of args).
proc ::alited::msg {type icon message {defb {}} args} { # Shows a message and asks for an answer. # type - ok/yesno/okcancel/yesnocancel # icon - info/warn/err # message - the message # defb - default button (for not "ok" dialogs) # args - additional arguments (-title and font's option) # For "ok" dialogue, 'defb' is omitted (being a part of args). variable obDlg variable al if {$type eq {ok}} { set args [linsert $args 0 $defb] set defb {} } elseif {$defb eq {}} { set defb YES } lappend defb -centerme [::apave::rootModalWindow $al(WIN)] lassign [::apave::extractOptions args -title {} -noesc 0] title noesc if {$title eq {}} { switch $icon { warn {set title $al(MC,warning)} err {set title $al(MC,error)} ques {set title $al(MC,question)} default {set title $al(MC,info)} } } else { set title [msgcat::mc $title] } set message [msgcat::mc $message] if {[info exists al(obDlg-BUSY)]} { # the obDlg is engaged: no actions, just a message Message $message 4 set res 0 } else { set al(obDlg-BUSY) yes set res [$obDlg $type $icon $title "\n$message\n" {*}$defb -onclose destroy {*}$args] unset -nocomplain al(obDlg-BUSY) } return [lindex $res 0] }
Sets common localized messages.
proc ::alited::msgcatMessages {} { # Sets common localized messages. # alited_checked variable al ## _ common _ ## set al(MC,nofile) [msgcat::mc {No name}] set al(MC,info) [msgcat::mc Information] set al(MC,warning) [msgcat::mc Warning] set al(MC,error) [msgcat::mc Error] set al(MC,question) [msgcat::mc Question] set al(MC,wait) [msgcat::mc {Wait a little ...}] set al(MC,help) [msgcat::mc Help] set al(MC,select) [msgcat::mc Select] ;# verb set al(MC,notsaved) [msgcat::mc "\"%f\" wasn't saved.\n\nSave it?"] set al(MC,saving) [msgcat::mc Saving] set al(MC,files) [msgcat::mc Files] set al(MC,moving) [msgcat::mc Moving] set al(MC,run) [msgcat::mc Run] set al(MC,runAsIs) [msgcat::mc {Run as Is}] set al(MC,new) [msgcat::mc New] set al(MC,open...) [msgcat::mc Open...] set al(MC,openwith) [msgcat::mc {Open Selected Files with}] set al(MC,close) [msgcat::mc Close] set al(MC,save) [msgcat::mc Save] set al(MC,saveas...) [msgcat::mc {Save as...}] set al(MC,saveall) [msgcat::mc {Save All}] set al(MC,clall) [msgcat::mc {... All}] set al(MC,clallleft) [msgcat::mc {... All at Left}] set al(MC,clallright) [msgcat::mc {... All at Right}] set al(MC,detach) [msgcat::mc Detach] set al(MC,detachsel) [msgcat::mc {Detach Selected Files}] set al(MC,pref) [msgcat::mc Preferences] set al(MC,pref...) [msgcat::mc Preferences...] set al(MC,notrecomm) [msgcat::mc "Not recommended for projects\nwith large files (>2000 LOC)!"] set al(MC,quit) [msgcat::mc Quit] set al(MC,indent) [msgcat::mc Indent] set al(MC,unindent) [msgcat::mc Unindent] set al(MC,corrindent) [msgcat::mc {Correct Indentation}] set al(MC,comment) [msgcat::mc Comment] set al(MC,uncomment) [msgcat::mc Uncomment] set al(MC,findreplace) [msgcat::mc {Find / Replace}] set al(MC,findnext) [msgcat::mc {Find Next}] set al(MC,alloffile) [msgcat::mc "All of \"%f\""] set al(MC,lines) [msgcat::mc Lines] set al(MC,moveupU) [msgcat::mc {Move Unit Up}] set al(MC,movedownU) [msgcat::mc {Move Unit Down}] set al(MC,moveupF) [msgcat::mc {Move File Up}] set al(MC,movedownF) [msgcat::mc {Move File Down}] set al(MC,FavLists) [msgcat::mc {Saved Lists of Favorites}] set al(MC,swfiles) [msgcat::mc {Switch to Unit Tree}] set al(MC,swunits) [msgcat::mc {Switch to File Tree}] set al(MC,filesadd) [msgcat::mc {Create File}] set al(MC,filesadd...) [msgcat::mc {Create File...}] set al(MC,filesadd2) [msgcat::mc "Enter a name of file to create in:\n%d\n\nIf it is a directory, check 'Directory' box.\nThe directory can include subdirectories (a/b/c)."] set al(MC,filesdel) [msgcat::mc {Delete File}] set al(MC,fileexist) [msgcat::mc "\nFile \"%f\" already exists in\n%d\n"] set al(MC,filenoexist) [msgcat::mc "\nFile\n \"%f\"\ndoesn't exist.\n"] set al(MC,unitsdel) [msgcat::mc {Delete Unit(s)}] set al(MC,favoradd) [msgcat::mc {Add to Favorites}] set al(MC,favordel) [msgcat::mc {Delete}] set al(MC,favorren) [msgcat::mc {Rename}] set al(MC,favordelall) [msgcat::mc {Delete All}] set al(MC,updtree) [msgcat::mc {Update Tree}] set al(MC,movefile) [msgcat::mc "Move %f\nto\n%d\n?"] set al(MC,introln1) [msgcat::mc {First Lines}] set al(MC,introln2) [msgcat::mc {Can't touch the first %n lines.}] set al(MC,favorites) [msgcat::mc Favorites] set al(MC,currfavs) [msgcat::mc {Current list of favorites}] set al(MC,lastvisit) [msgcat::mc {Last Visited}] set al(MC,addfavor) [msgcat::mc "Add \"%n\" of %f\nto Favorites?"] set al(MC,addexist) [msgcat::mc "Item \"%n\" of %f\nis already in Favorites."] set al(MC,delfavor) [msgcat::mc "Remove \"%n\" of %f\nfrom Favorites?"] set al(MC,notfavor) [msgcat::mc "\"%n\" unit of %f is not in the list."] set al(MC,selfavor) [msgcat::mc "Click \"%t\""] set al(MC,copydecl) [msgcat::mc {Copy Declaration}] set al(MC,openofdir) [msgcat::mc "Open All Tcl Files of \"%n\""] set al(MC,delitem) [msgcat::mc "Remove \"%n\"\nfrom \"%f\"?"] set al(MC,delfile) [msgcat::mc "Delete \"%f\"?"] set al(MC,modiffile) [msgcat::mc "File \"%f\" was modified by some application.\n\nCancel your edition and reload the file?"] set al(MC,wasdelfile) [msgcat::mc "File \"%f\" was deleted by some application.\n\nSave the file?"] set al(MC,Row:) [msgcat::mc {Row }] set al(MC,Col:) [msgcat::mc { Col }] set al(MC,Item) [msgcat::mc Item] set al(MC,errmove) [msgcat::mc "\"%n\" contains unbalanced \{\}: %1!=%2"] set al(MC,afterstart) [msgcat::mc {For Start}] set al(MC,locale) [msgcat::mc "This is a language code: ru, uk, de...\nIn alited, \"en\" means American English."] set al(MC,noask) [msgcat::mc {Don't show anymore}] set al(MC,needcs) [msgcat::mc "These themes need\nlight / dark color schemes\naccordingly"] set al(MC,nocs) [msgcat::mc {No color scheme at all}] set al(MC,fitcs) [msgcat::mc {Fit for theme}] set al(MC,hue) [msgcat::mc {Makes colors darker .. lighter}] set al(MC,maxbak) [msgcat::mc {Maximum of backup copies per a file}] set al(MC,othertcl) [msgcat::mc {Do it in other Tcl files}] set al(MC,otherfiles) [msgcat::mc {Do it in other files}] set al(MC,inconsole) [msgcat::mc {in console}] set al(MC,intkcon) [msgcat::mc {in Tkcon}] set al(MC,asis) [msgcat::mc {as is}] set al(MC,on) [msgcat::mc on] set al(MC,test) [msgcat::mc Test] set al(MC,restart) [msgcat::mc "For the settings to be active,\nalited application should be restarted."] set al(MC,incorrname) [msgcat::mc {Incorrect name: "%n"}] set al(MC,allfiles) [msgcat::mc {All files}] set al(MC,currfile) [msgcat::mc {Current}] set al(MC,none) [msgcat::mc {None}] ## _ menu items _ ## set al(MC,lookdecl) [msgcat::mc {Look for Declaration}] set al(MC,lookword) [msgcat::mc {Look for Word}] set al(MC,toline) [msgcat::mc {Go to Line}] set al(MC,tomatched) [msgcat::mc {To Matched Bracket}] set al(MC,hlcolors) [msgcat::mc {Display Colors}] set al(MC,playtkl) [msgcat::mc {Play Macro}] set al(MC,quickmacro) {Quick macro} set al(MC,formatdesc) [msgcat::mc {Moving Unit Descriptions}] set al(MC,formatdesc...) [msgcat::mc {Moving Unit Descriptions...}] set al(MC,middlefont) [msgcat::mc {Middle font size:}] ## _ project options _ ## set al(MC,Ign:) [msgcat::mc {Skip files/directories:}] set al(MC,EOL:) [msgcat::mc {End of line:}] set al(MC,indent:) [msgcat::mc {Indentation:}] set al(MC,indentAuto) [msgcat::mc {Auto detection}] set al(MC,redunit) [msgcat::mc {Unit lines per 1 red bar:}] set al(MC,multiline) [msgcat::mc {Multi-line strings:}] set al(MC,trailwhite) [msgcat::mc {Remove trailing whitespaces:}] set al(MC,useleafRE) [msgcat::mc {Use leaf's regexp:}] set al(MC,leafRE) [msgcat::mc {Leaf's regexp:}] ## _ templates _ ## set al(MC,tpl) [msgcat::mc Templates] set al(MC,tplsel) [msgcat::mc {Click a template}] set al(MC,tplnew) [msgcat::mc {The template #%n added}] set al(MC,tplupd) [msgcat::mc {The template #%n updated}] set al(MC,tplrem) [msgcat::mc {The template #%n removed}] set al(MC,tplent1) [msgcat::mc {Enter a name of the template}] set al(MC,tplent2) [msgcat::mc {Enter a text of the template}] set al(MC,tplent3) [msgcat::mc "Choose a hot key combination\nfor the template insertion."] set al(MC,tplaft1) [msgcat::mc "Inserts a template\nbelow a current line"] set al(MC,tplaft2) [msgcat::mc "Inserts a template\nbelow a current unit"] set al(MC,tplaft3) [msgcat::mc "Inserts a template at the cursor\n(good for one-liners)"] set al(MC,tplaft4) [msgcat::mc "Inserts a template after 1st line of a file\n(License, Introduction etc.)"] set al(MC,tplexists) [msgcat::mc {A template with the attribute(s) already exists.}] set al(MC,tpldelq) [msgcat::mc {Delete a template #%n ?}] ## _ projects _ ## set al(MC,projects) [msgcat::mc Projects] set al(MC,prjgoing) [msgcat::mc {You are going to %n!}] set al(MC,prjadd) [msgcat::mc {Add a project}] set al(MC,prjchg) [msgcat::mc {Change a project}] set al(MC,prjdel1) [msgcat::mc {Delete a project}] set al(MC,prjcantdel) [msgcat::mc {Don't delete the current project!}] set al(MC,prjnew) [msgcat::mc "The project \"%n\" added"] set al(MC,prjupd) [msgcat::mc "The project \"%n\" updated"] set al(MC,prjdel2) [msgcat::mc "The project \"%n\" removed"] set al(MC,prjOptions) [msgcat::mc Options] set al(MC,prjName) [msgcat::mc {Project:}] set al(MC,prjaddfl) [msgcat::mc Add] set al(MC,prjsubstfl) [msgcat::mc Substitute] set al(MC,prjdelfl) [msgcat::mc Delete] set al(MC,prjnochfl) [msgcat::mc {Don't change}] set al(MC,prjsel) [msgcat::mc {Click a project}] set al(MC,prjdelq) [msgcat::mc "Delete a project \"%n\" ?"] set al(MC,prjexists) [msgcat::mc "A project \"%n\" already exists."] set al(MC,DEFopts) [msgcat::mc {Options for new projects are set in "Preferences/General/Projects"}] set al(MC,prjTdelete) [msgcat::mc {Erase a text}] set al(MC,prjTpaste) [msgcat::mc {Paste a text}] set al(MC,prjTundo) [msgcat::mc {Undo changes}] set al(MC,prjTredo) [msgcat::mc {Redo changes}] set al(MC,prjTtext) [msgcat::mc {Text of a reminder}] set al(MC,prjTprevious) [msgcat::mc {TODO previous day}] set al(MC,prjTprevious2) [msgcat::mc {TODO previous week}] set al(MC,prjTnext) [msgcat::mc {TODO next day}] set al(MC,prjTnext2) [msgcat::mc {TODO next week}] set al(MC,TemplPrj) [msgcat::mc "Enter a tree of directories for the project template.\nIndent them by equal indents to mean subdirectories.\n\nFiles like README*, CHANGELOG* will be created blank.\nFiles like LICENSE* will be taken from the current project."] set al(MC,CrTemplPrj) [msgcat::mc {Create a project by template}] set al(MC,ViewDir) [msgcat::mc {Project directory}] set al(MC,com) [msgcat::mc Command] set al(MC,coms) [msgcat::mc Commands] ## _ favorites _ ## set al(MC,favsel) [msgcat::mc {Click a list of favorites}] set al(MC,favnew) [msgcat::mc {The list #%n added}] set al(MC,favupd) [msgcat::mc {The list #%n updated}] set al(MC,favrem) [msgcat::mc {The list #%n removed}] set al(MC,favent1) [msgcat::mc {Enter a name of the list}] set al(MC,favent3) [msgcat::mc {The current list is empty!}] set al(MC,favexists) [msgcat::mc {This list already exists}] set al(MC,faverrsav) [msgcat::mc "This list not saved to\n\"%f\"."] set al(MC,favdelq) [msgcat::mc {Delete a favorites' list #%n ?}] set al(MC,unitprocsd) [msgcat::mc {%f processed, units affected: %n - ALREADY PROCESSED?}] ## _ find-replace dialogue _ ## set al(MC,frMatch) [msgcat::mc {Match: }] set al(MC,frWord) [msgcat::mc {Match whole word}] set al(MC,frExact) [msgcat::mc {Exact}] set al(MC,frCase) [msgcat::mc {Match case}] set al(MC,frres1) [msgcat::mc "Found %n matches for \"%s\"."] set al(MC,frres2) [msgcat::mc "Made %n replacements of \"%s\" with \"%r\" in \"%f\"."] set al(MC,frres3) [msgcat::mc "Made %n replacements of \"%s\" with \"%r\" in all of session."] set al(MC,frdoit1) [msgcat::mc "Replace all of \"%s\"\n\nwith \"%r\"\n\nin \"%f\" ?"] set al(MC,frdoit2) [msgcat::mc "Replace all of \"%s\"\n\nwith \"%r\"\n\nin all%Stexts?"] ## _ file & directory _ ## set al(MC,removed) [msgcat::mc "\"%f\" removed to \"%d\""] set al(MC,nottoopen) [msgcat::mc "The file \"%f\" seems to be not of types\n%s.\n\nStill do you want to open it?"] set al(MC,renamefile) [msgcat::mc {Rename File}] set al(MC,renamefile...) [msgcat::mc {Rename File...}] set al(MC,clonefile) [msgcat::mc {Clone File}] set al(MC,clonefile...) [msgcat::mc {Clone File...}] set al(MC,openselfile) [msgcat::mc {Open Selected Files}] set al(MC,filelist) [msgcat::mc {File List}] ## _ start and update _ ## set al(MC,chini1) [msgcat::mc {Choosing Directory for Settings}] set al(MC,chini2) [msgcat::mc "\n The \"alited\" needs a configuration directory to store its settings.\n You can pass its name to alited as an argument.\n\n The default configuration directory is \"%d\".\n It's preferable as used to run \"alited\" without arguments.\n"] set al(MC,chini3) [msgcat::mc {Choose a directory}] set al(MC,updateALE) [msgcat::mc {Updating alited}] set al(MC,updLab1) [msgcat::mc " You are highly recommended to accept\n these changes in order to complete updating:"] set al(MC,updmnu) [msgcat::mc {.em files for "Tools"}] set al(MC,updini) [msgcat::mc {.ini file for "Templates"}] set al(MC,updLab2) [msgcat::mc { Your previous files will be saved to:}] ## _ misc _ ## set al(MC,notes) [msgcat::mc "Sort of diary.\nList of TODOs etc."] set al(MC,checktcl) [msgcat::mc {Check Tcl}] set al(MC,checktcl...) [msgcat::mc {Check Tcl...}] set al(MC,colorpicker) [msgcat::mc {Color Picker}] set al(MC,datepicker) [msgcat::mc {Date Picker}] set al(MC,marks) [msgcat::mc Marks] ## _ icons of toolbar _ ## set al(MC,icofile) [msgcat::mc "Create a file\nCtrl+N"] set al(MC,icoOpenFile) [msgcat::mc "Open a file\nCtrl+O"] set al(MC,icoSaveFile) [msgcat::mc {Save the file}] set al(MC,icosaveall) [msgcat::mc "Save all files\nCtrl+Shift+S"] set al(MC,icohelp) [msgcat::mc "Tcl/Tk help on the selection\nF1"] set al(MC,icoreplace) [msgcat::mc "Find / Replace\nCtrl+F"] set al(MC,icook) $al(MC,checktcl) set al(MC,icocolor) $al(MC,colorpicker) set al(MC,icodate) $al(MC,datepicker) set al(MC,icoother) Tkcon set al(MC,icorun) [msgcat::mc {Run the file}] set al(MC,icoe_menu) [msgcat::mc {Run e_menu}] set al(MC,icoundo) [msgcat::mc "Undo changes\nCtrl+Z"] set al(MC,icoredo) [msgcat::mc "Redo changes\nCtrl+Shift+Z"] set al(MC,icobox) [msgcat::mc Projects] ## _ find units _ ## set al(MC,findunit) [msgcat::mc "Use glob patterns to find units' declarations\ne.g. \"s*rt\" would find \"start\" and \"insert\".\nThe letter case is ignored."] set al(MC,notfndunit) [msgcat::mc {Unit not found: %u}] }
Opens files of CLI.
| count of call |
| list of file names |
proc ::alited::open_files_and_raise {iin args} { # Opens files of CLI. # iin - count of call # args - list of file names # See also: bar::FillBar if {$iin<10} { # let the tab bar be filled first if {![info exists ::alited::al(BID)]} { after idle [list after 1000 [list ::alited::open_files_and_raise [incr iin] {*}$args]] return } foreach fname [lreverse $args] { set fname [string trim $fname "\"\{\}"] if {[file isfile $fname]} { file::OpenFile $fname yes } else { Balloon1 $fname file::NewFile $fname } } } raise_window }
Runs "Project Printer".
proc ::alited::PrinterRun {} { # Runs "Project Printer". ScriptSource printer printer::_run }
Transforms \n to "EOL chars" and vise versa.
| string to transform |
| if "in", gets \n-valued; if "out", gets EOL-valued. |
proc ::alited::ProcEOL {val mode} { # Transforms \n to "EOL chars" and vise versa. # val - string to transform # mode - if "in", gets \n-valued; if "out", gets EOL-valued. variable EOL if {$mode eq {in}} { return [string map [list $EOL \n] $val] } else { return [string map [list \n $EOL] $val] } }
Processes files according to Selected/All choice.
| name of command to run on files (TID passed) |
| what to process: 1 - selected, 2 - all |
Returns numbers of all and processed files.
proc ::alited::ProcessFiles {procname what} { # Processes files according to Selected/All choice. # procname - name of command to run on files (TID passed) # what - what to process: 1 - selected, 2 - all # Returns numbers of all and processed files. # See also: SessionList variable da set all [set processed 0] foreach tab [alited::SessionList $what] { incr all incr processed [$procname [lindex $tab 0]] } list $all $processed }
Raises the app's window.
proc ::alited::raise_window {} { # Raises the app's window. variable al catch { wm withdraw $al(WIN) wm deiconify $al(WIN) } }
Restores options of "Run..." dialogue.
proc ::alited::RestoreRunOptions {} { # Restores options of "Run..." dialogue. variable al lassign $al(_SavedRunOptions_) al(prjincons) al(comForce) al(comForceLs) al(comForceCh) al(prjbeforerun) }
Runs Tcl/Tk script.
| script's name and arguments |
proc ::alited::Run {args} { # Runs Tcl/Tk script. # args - script's name and arguments variable al set com [string trimright "$args" &] if {{TEST_ALITED} in $args} { set com [string map [list { TEST_ALITED} {}] $com] puts [Tclexe]\ $com } if {[set i [lsearch $args -dir]]>=0} { set dir [lindex $args [incr i]] } else { set dir $al(prjroot) } set curdir [pwd] catch {cd $dir} set res [pid [open |[list [Tclexe] {*}$com]]] cd $curdir return $res }
Runs a command that was started by another process.
| Not documented. |
| Optional arguments. |
proc ::alited::run_remote {cmd args} { # Runs a command that was started by another process. if {[catch { $cmd {*}$args } err]} { puts $err return -code error } }
Runs Tcl/Tk script by alited's Tcl/Tk runtime.
| script's name and arguments |
proc ::alited::Runtime {args} { # Runs Tcl/Tk script by alited's Tcl/Tk runtime. # args - script's name and arguments exec -- [info nameofexecutable] {*}$args & }
Saves options of "Run..." dialogue.
proc ::alited::SaveRunOptions {} { # Saves options of "Run..." dialogue. variable al set al(_SavedRunOptions_) [list $al(prjincons) $al(comForce) $al(comForceLs) $al(comForceCh) $al(prjbeforerun)] }
Sources script.tcl (at need).
| the script name |
proc ::alited::ScriptSource {script} { # Sources script.tcl (at need). # script - the script name variable SRCDIR if {[info commands ::alited::${script}::_run] eq {}} { source [file join $SRCDIR $script.tcl] } }
Returns a list of all tabs or selected tabs (if set).
| 0 get selected or all, 1 force selected, 2 force all; optional, default 0 |
Returns a list of all tabs or selected tabs (if set).
proc ::alited::SessionList {{mode 0}} { # Returns a list of all tabs or selected tabs (if set). # mode - 0 get selected or all, 1 force selected, 2 force all set res [alited::bar::BAR listFlag s] if {(!$mode && [llength $res]==1) || $mode==2} { set res [alited::bar::BAR listTab] } return $res }
Returns a list of all tabs or selected tabs of .tcl files.
| 0 get selected or all, 1 force selected, 2 force all; optional, default 0 |
Returns a list of all tabs or selected tabs of .tcl files.
proc ::alited::SessionTclList {{mode 0}} { # Returns a list of all tabs or selected tabs of .tcl files. # mode - 0 get selected or all, 1 force selected, 2 force all set ltabs [list] foreach tab [alited::SessionList $mode] { if {[alited::isTclScript $tab]} { lappend ltabs $tab } } return $ltabs }
Sources e_menu.tcl at need.
Gets colors for syntax highlighting.
proc ::alited::SyntaxColors {} { # Gets colors for syntax highlighting. variable al foreach nam [::hl_tcl::hl_colorNames] {lappend colors $al(ED,$nam)} lassign [::hl_tcl::addingColors] clrCURL clrCMN2 lappend colors $clrCURL $clrCMN2 return $colors }
Makes a text being syntax highlighted.
| language (tcl, c) |
| text's path |
| highlighting colors |
| color scheme; optional, default "" |
| other options |
proc ::alited::SyntaxHighlight {lng wtxt colors {cs {}} args} { # Makes a text being syntax highlighted. # lng - language (tcl, c) # wtxt - text's path # colors - highlighting colors # cs - color scheme # args - other options variable al if {$cs eq {}} {set cs [obj csCurrent]} ::hl_${lng}::hl_init $wtxt -dark [obj csDark $cs] -colors $colors -multiline 1 -font $al(FONT,txt) -cmdpos ::apave::None {*}$args ::hl_${lng}::hl_text $wtxt }
Gets Tcl's executable file.
proc ::alited::Tclexe {} { # Gets Tcl's executable file. variable al if {$al(EM,Tcl) eq {}} { if {$al(IsWindows)} { # important: refer to tclsh (not wish), to run it in Windows console # though not good for deployed Tcl/Tk 8.6- if {[set tclexe [::apave::autoexec tclsh .exe]] eq {}} { set tclexe [info nameofexecutable] } } else { set tclexe [info nameofexecutable] } } else { set tclexe $al(EM,Tcl) } return $tclexe }
Gets a picture from a character and vice versa.
| picture or character |
| "in" gets in-chars, "out" gets out-chars; optional, default out |
proc ::alited::TextIcon {ico {to out}} { # Gets a picture from a character and vice versa. # ico - picture or character # to - "in" gets in-chars, "out" gets out-chars set in [list 0 1 2 3 4 5 6 7 8 9 & ~ = @] set out [list ∀ ∃ ∏ ∑ ⁂ ⊍ ⋀ ⋁ ⋈ ⋒ ⌗ ⌛ ⌬ ⏏] if {$to eq {out}} { set lfrom $in set lto $out } else { set lfrom $out set lto $in } if {[set i [lsearch -exact $lfrom $ico]]>-1} { set tico [lindex $lto $i] } else { set tico $ico } return $tico }
Shows a tip on status message and clears the status message.
| message label's path |
| text of tip |
proc ::alited::TipMessage {lab tip} { # Shows a tip on status message and clears the status message. # lab - message label's path # tip - text of tip if {$tip ne {}} {$lab configure -text {}} return $tip }
Gets a temporary file's name.
| tailing part of the name |
proc ::alited::TmpFile {tname} { # Gets a temporary file's name. # tname - tailing part of the name variable al return [file join $al(EM,mnudir) $tname] }
Returns "next & prev widgets" for Tab & Shift/Tab keys, just to skip "Help".
| widget for Shift/Tab; optional, default "" |
Used by obPrf & obPrj objects.
Returns "next & prev widgets" for Tab & Shift/Tab keys, just to skip "Help".
proc ::alited::Tnext {{wprev {}}} { # Returns "next & prev widgets" for Tab & Shift/Tab keys, just to skip "Help". # wprev - widget for Shift/Tab # Used by obPrf & obPrj objects. list *.ButOK $wprev }
Shows "About" dialogue.
proc ::alited::about::About {} { # Shows "About" dialogue. # alited_checked namespace upvar ::alited al al DIR DIR variable textTags ## ________________________ Preparing tabs _________________________ ## ::alited::Source_e_menu ::alited::edit::MacroInit lassign [obj csGet] fg fg2 bg bg2 - bS fS ::apave::InitAwThemesPath $::alited::LIBDIR foreach _ {alited apave bartabs baltip hl_tcl playtkl} { if {[set v$_ v[package versions $_]] eq {v} && [catch {set v$_ v[package require $_]}]} { set v$_ {} } } set font [obj csFontDef] obj initLinkFont {*}$font -underline 1 -foreground $fg2 -background $bg2 append font " -weight bold" ### ________________________ Tags and links _________________________ ### set textTags [list [list "red" "-font {$font} -foreground $fS -background $bS"] [list "link1" "openDoc %t@@https://%l@@"] [list "link2" "openDoc %t@@https://wiki.tcl-lang.org/recent@@"] [list "linkapl" "openDoc %t@@https://github.com/aplsimple/@@"] [list "linkCN" "openDoc %t@@https://www.nemethi.de/@@"] [list "linkSH" "openDoc %t@@https://wiki.tcl-lang.org/page/Steve+Huntley@@"] [list "linkHE" "openDoc %t@@https://wiki.tcl-lang.org/page/HE@@"] [list "linkRD" "openDoc %t@@https://github.com/rdbende@@"] [list "linkPO" "openDoc %t@@https://wiki.tcl-lang.org/page/Paul+Obermeier@@"] [list "linkPW" "openDoc %t@@https://wiki.tcl-lang.org/page/PW@@"] [list "linkRK" "openDoc %t@@https://rkeene.org/projects/info@@"] [list "linkMIT" "openDoc %t@@https://en.wikipedia.org/wiki/MIT_License@@"] [list "linkJS" "openDoc %t@@https://wiki.tcl-lang.org/page/Jeff+Smith@@"] [list "linkRS" "openDoc %t@@http://wiki.tcl-lang.org/page/Richard+Suchenwirth@@"] [list "linkAN" "openDoc %t@@https://www.magicsplat.com/@@"] [list "linkDF" "openDoc %t@@https://wiki.tcl-lang.org/page/Donal+Fellows@@"] [list "linkJO" "openDoc %t@@https://www.johann-oberdorfer.eu/@@"] [list "linkTW" "openDoc %t@@https://github.com/phase1geo@@"] [list "linkCM" "openDoc %t@@https://wiki.tcl-lang.org/page/Colin+Macleod@@"] [list "linkDB" "openDoc %t@@https://wiki.tcl-lang.org/page/dbohdan"] [list "linkDG" "openDoc %t@@https://wiki.tcl-lang.org/page/Detlef+Groth"] [list "linkPY" "openDoc %t@@https://wiki.tcl-lang.org/page/Poor+Yorick"] [list "linkMH" "openDoc %t@@https://wiki.tcl-lang.org/page/Matthias+Hoffmann"] [list "linkNB" "openDoc %t@@https://github.com/sl1200mk2@@"] [list "linkTZ" "openDoc %t@@https://github.com/thanoulis@@"] [list "linkCW" "openDoc %t@@https://wiki.tcl-lang.org/page/chw@@"] [list "linkAK" "openDoc %t@@https://wiki.tcl-lang.org/page/Andreas+Kupries@@"] [list "linkAG" "openDoc %t@@https://wiki.tcl-lang.org/page/Andy+Goth@@"] [list "linkDA" "openDoc %t@@https://github.com/ray2501@@"] [list "linkET" "openDoc %t@@https://github.com/eht16"] [list "link-apave" "openDoc %t@@https://aplsimple.github.io/en/tcl/pave"] [list "link-e_menu" "openDoc %t@@https://aplsimple.github.io/en/tcl/e_menu"] [list "link-baltip" "openDoc %t@@https://aplsimple.github.io/en/tcl/baltip/baltip.html"] [list "link-bartabs" "openDoc %t@@https://aplsimple.github.io/en/tcl/bartabs"] [list "link-hl_tcl" "openDoc %t@@https://aplsimple.github.io/en/tcl/hl_tcl/hl_tcl.html"] [list "link-aloupe" "openDoc %t@@https://aplsimple.github.io/en/tcl/aloupe/aloupe.html"] [list "link-playtkl" "openDoc %t@@https://aplsimple.github.io/en/tcl/playtkl/playtkl.html"] [list "link-tkcc" "openDoc %t@@https://aplsimple.github.io/en/tcl/tkcc"] [list "link-repl" "openDoc %t@@https://github.com/apnadkarni/tcl-repl"] [list "link-ale_themes" "openDoc %t@@https://github.com/aplsimple/ale_themes"] [list "link-tkcon" "openDoc %t@@https://wiki.tcl-lang.org/page/Tkcon"] [list "link_" "openDoc %t@@https://aplsimple.github.io/en/misc/links/links.html@@"] [list "linkRH" "openDoc %t@@http://www.hwaci.com/drh/@@"] [list "linkBL" "openDoc %t@@https://wiki.tcl-lang.org/page/bll@@"] [list "linkFF" "openDoc %t@@https://wiki.tcl-lang.org/page/FF@@"] [list "linkSS" "openDoc %t@@https://github.com/antirez@@"] [list "linkML" "openDoc %t@@https://wiki.tcl-lang.org/page/Martin+Lemburg@@"] [list "linkDN" "openDoc %t@@https://github.com/par7133@@"] [list "linkAM" "openDoc %t@@https://en.wikipedia.org/wiki/Argentina@@"] [list "linkHO" "openDoc %t@@https://wiki.tcl-lang.org/page/Harald+Oehlmann@@"] [list "linkJM" "openDoc %t@@https://github.com/jgm@@"] [list "linkJN" "openDoc %t@@https://github.com/johannish@@"] [list "linkGN" "openDoc %t@@https://github.com/gregnix@@"] [list "linkGR" "openDoc %t@@https://github.com/georgtree@@"] ] ### ________________________ "General" tab _________________________ ### set head "alited $valited" set clog [readTextFile [file join $DIR CHANGELOG.md]] foreach line [textsplit $clog] { lassign [regexp -inline {Version `.+(\(.+\))`} $line] -> line if {$line ne {}} { append head " $line" break } } set long1 [msgcat::mc {And well fit for programming with it.}] set long2 __________________________________________ set long3 [file nativename [info nameofexecutable]] set msg " <red>$head</red>, a lite editor.\n\n [msgcat::mc {Written in pure Tcl/Tk.}] \n $long1\n\n [msgcat::mc {Details:}] \n\n \u2022 <link1>aplsimple.github.io/en/tcl/alited</link1>\n \u2022 <link1>github.com/aplsimple/alited</link1>\n \u2022 <link1>chiselapp.com/user/aplsimple/repository/alited</link1>\n\n [msgcat::mc {Authors:}] \n\n \u2022 <linkapl>Alex Plotnikov</linkapl>\n\n [msgcat::mc {License:}] <linkMIT>MIT</linkMIT>\n $long2\n \n <red> $long3 </red>\n \n <red> Tcl/Tk $::alited::tcltk_version </red> <link2></link2>\n \n <red> $::tcl_platform(os) $::tcl_platform(osVersion) </red>" ### ________________________ "Packages" tab _________________________ ### set packages [msgcat::mc {Packages used by <red>alited %ver</red>:}] set packages [string map [list %ver $valited] $packages] set vemenu v[lindex $::em::em_version 1] set ::alited::AboutPack "\n $packages\n\n \u2022 <link-apave>apave $vapave</link-apave>\n\n \u2022 <link-e_menu>e_menu $vemenu</link-e_menu>\n\n \u2022 <link-ale_themes>ale_themes</link-ale_themes>\n\n \u2022 <link-baltip>baltip $vbaltip</link-baltip>\n\n \u2022 <link-bartabs>bartabs $vbartabs</link-bartabs>\n\n \u2022 <link-hl_tcl>hl_tcl $vhl_tcl</link-hl_tcl>\n\n \u2022 <link-aloupe>aloupe v1.8.1</link-aloupe>\n\n \u2022 <link-playtkl>playtkl $vplaytkl</link-playtkl>\n\n \u2022 <link-tkcc>tkcc</link-tkcc>\n\n \u2022 <link-repl>tcl-repl</link-repl>\n\n \u2022 <link-tkcon>tkcon v2.7</link-tkcon>\n \n menus/*.em v$al(MNUversion) \n alited.ini v$al(INIversion)" ### ________________________ "Acknowledgements" tab _________________________ ### set ackn [msgcat::mc "Many thanks to the following people \n who have contributed to this project \n with their participation, advice and code"] set spec [msgcat::mc "Special thanks also to"] set ::alited::AboutAckn "\n $ackn\n\n \u2022 <linkSH>Steve Huntley</linkSH>\n \u2022 <linkHE>Holger Ewert</linkHE>\n \u2022 <linkCN>Csaba Nemethi</linkCN>\n \u2022 <linkPO>Paul Obermeier</linkPO>\n \u2022 <linkAN>Ashok P. Nadkarni</linkAN>\n \u2022 <linkRD>rdbende</linkRD>\n \u2022 <linkBL>Brad Lanam</linkBL>\n \u2022 <linkPW>Paul Walton</linkPW>\n \u2022 <linkJO>Johann Oberdorfer</linkJO>\n \u2022 <linkRS>Richard Suchenwirth</linkRS>\n \u2022 <linkCW>Christian Werner</linkCW>\n \u2022 <linkNB>Nicolas Bats</linkNB>\n \u2022 <linkTZ>Thanos Zygouris</linkTZ>\n \u2022 <linkFF>Federico Ferri</linkFF>\n \u2022 <linkSS>Salvatore Sanfilippo</linkSS>\n \u2022 <linkML>Martin Lemburg</linkML>\n \u2022 <linkDN>Daniele Bonini</linkDN>\n \u2022 <linkAM>Alexis Martin</linkAM>\n \u2022 <linkJN>Johann</linkJN>\n \u2022 <linkGN>Gregor</linkGN>\n \u2022 <linkGR>George</linkGR>\n \n $spec\n\n \u2022 <linkTW>Trevor Williams</linkTW>\n \u2022 <linkDF>Donal K. Fellows</linkDF>\n \u2022 <linkJS>Jeff Smith</linkJS>\n \u2022 <linkRK>Roy Keene</linkRK>\n \u2022 <linkDB>D. Bohdan</linkDB>\n \u2022 <linkDG>Detlef Groth</linkDG>\n \u2022 <linkCM>Colin Macleod</linkCM>\n \u2022 <linkPY>Nathan Coulter</linkPY>\n \u2022 <linkAK>Andreas Kupries</linkAK>\n \u2022 <linkRH>D. Richard Hipp</linkRH>\n \u2022 <linkMH>Matthias Hoffmann</linkMH>\n \u2022 <linkAG>Andy Goth</linkAG>\n \u2022 <linkDA>Danilo Chang</linkDA>\n \u2022 <linkET>Enrico Troeger</linkET>\n \u2022 <linkHO>Harald Oehlmann</linkHO>\n \u2022 <linkJM>John MacFarlane</linkJM>\n \n <link_>Excuse my memory if I omitted someone's name.</link_>\n" ### ________________________ Combining tabs _________________________ ### set wmax [expr {4+max([string length $long1], [string length $long2],[string length $long3])}] set tab2 [list General Packages "{fra - - 1 99 {-st nsew -rw 1 -cw 1}} {.TexPack - - - - {pack -side left -expand 1 -fill both} {-w $wmax -h 31 -rotext ::alited::AboutPack -tags ::alited::about::textTags}}" Acknowledgements "{fra - - 1 99 {-st nsew -rw 1 -cw 1}} {.TexAckn - - - - {pack -side left -expand 1 -fill both} {-w $wmax -h 34 -rotext ::alited::AboutAckn -tags ::alited::about::textTags}} {.sbv .texAckn L - - {pack -side right}}"] ## ________________________ Change default options _________________________ ## # invert link colors set aopts "{-fg $::apave::FGMAIN -bg $::apave::BGMAIN}" obj untouchWidgets "*.texM $aopts" "*.texPack $aopts" "*.texAckn $aopts" lassign [obj csGet] fg fg2 bg bg2 lappend textTags "FG $fg2" "FG2 $fg" "BG $bg2" "BG2 $bg" # tooltips to show in the left & bottom point from the mouse pointer lassign [::baltip cget -shiftX] -> shiftX ::baltip configure -shiftX 10 ## ________________________ Open dialogue _________________________ ## ::alited::msg ok {} $msg -title [msgcat::mc About] -t 1 -w $wmax -h {30 30} -scroll 0 -tags ::alited::about::textTags -my "after idle {alited::about::textImaged %w}" -tab2 $tab2 ## ________________________ Restore defaults _________________________ ## ::baltip configure -shiftX $shiftX obj touchWidgets *.texM *.texPack *.texAckn unset -nocomplain ::alited::AboutAckn unset -nocomplain ::alited::AboutPack }
Makes the feather blink.
| window's path |
proc ::alited::about::textImaged {w} { # Makes the feather blink. # w - window's path obj labelFlashing [obj textLink $w 5] "" 1 -data $::alited::img::_AL_IMG(feather) -pause 0.5 -incr 0.1 -after 40 }
Runs the tab bar's method.
| method's name and its arguments |
proc ::alited::bar::BAR {args} { # Runs the tab bar's method. # args - method's name and its arguments namespace upvar ::alited al al if {[lindex $args 0] eq {popList}} { if {[llength $args] eq 1} {lappend args {} {}} lappend args $al(sortList) } if {[lindex $args 1] eq {cget}} { if {![al(bts) isTab [lindex $args 0]]} { return {} ;# at closing tabs: cget must return "" to "after" proc } } return [al(bts) $al(BID) {*}$args] }
Makes the bar of tabs to have a "marked tab" color consistent with current color scheme.
proc ::alited::bar::ColorBar {} { # Makes the bar of tabs to have a "marked tab" color # consistent with current color scheme. namespace upvar ::alited obPav obPav set cs [$obPav csCurrent] if {$cs>-1} { lassign [$obPav csGet $cs] cfg2 cfg1 cbg2 cbg1 cfhh - - - - - - - - - - - - fgmark # %t wildcard means "a tooltip on the list of files": BAR configure -fgmark $fgmark -comlist {::alited::bar::SelFile %ID "%t"} } }
Compares two tabs by date.
| 1st tab |
| 2nd tab |
proc ::alited::bar::CompareByDate {t1 t2} { # Compares two tabs by date. # t1 - 1st tab # t2 - 2nd tab lassign [SortData $t1] fname1 - date1 lassign [SortData $t2] fname2 - date2 if {$date1 < $date2} { set res -1 } elseif {$date1 > $date2} { set res 1 } elseif {$::alited::al(incdec) eq {increasing}} { set res [string compare -nocase $fname1 $fname2] } else { set res [string compare -nocase $fname2 $fname1] } return $res }
Compares two tabs by extension.
| 1st tab |
| 2nd tab |
proc ::alited::bar::CompareByExtn {t1 t2} { # Compares two tabs by extension. # t1 - 1st tab # t2 - 2nd tab lassign [SortData $t1] fname1 ext1 lassign [SortData $t2] fname2 ext2 if {[set res [string compare -nocase $ext1 $ext2]]==0} { if {$::alited::al(incdec) eq {increasing}} { set res [string compare -nocase $fname1 $fname2] } else { set res [string compare -nocase $fname2 $fname1] } } return $res }
Compares two tabs by size.
| 1st tab |
| 2nd tab |
proc ::alited::bar::CompareBySize {t1 t2} { # Compares two tabs by size. # t1 - 1st tab # t2 - 2nd tab lassign [SortData $t1] fname1 - - size1 lassign [SortData $t2] fname2 - - size2 if {$size1 < $size2} { set res -1 } elseif {$size1 > $size2} { set res 1 } elseif {$::alited::al(incdec) eq {increasing}} { set res [string compare -nocase $fname1 $fname2] } else { set res [string compare -nocase $fname2 $fname1] } return $res }
Switches between last two active tabs.
proc ::alited::bar::ControlTab {} { # Switches between last two active tabs. variable ctrltablist alited::favor::SkipVisited yes set fname [CurrentControlTab] set found no while {[llength $ctrltablist]} { set fnext [lindex $ctrltablist 0] foreach tab [BAR listTab] { set TID [lindex $tab 0] if {$fnext eq [FileName $TID]} { set found yes break } } if {$found} break # if the file was closed, remove it from the ctrl-tabbed set ctrltablist [lreplace $ctrltablist 0 0] } if {$found} { CurrentControlTab $fname BAR $TID show } after idle "focus \[alited::main::CurrentWTXT\]; alited::favor::SkipVisited no" }
Keeps a list of last switched files, to switch between last two.
| file name; optional, default "" |
proc ::alited::bar::CurrentControlTab {{fname {}}} { # Keeps a list of last switched files, to switch between last two. # fname - file name variable ctrltablist if {[set ret [expr {$fname eq {}}]]} { set fname [FileName] } ::apave::PushInList ctrltablist $fname $ret return $fname }
Gets an attribute of the current tab.
| 0 to get ID, 1 - short name (tab label), 2 - full name, 3 - index |
| tab's ID; optional, default "" |
proc ::alited::bar::CurrentTab {io {TID {}}} { # Gets an attribute of the current tab. # io - 0 to get ID, 1 - short name (tab label), 2 - full name, 3 - index # TID - tab's ID if {$TID eq {}} {set TID [CurrentTabID]} switch $io { 0 {set res $TID} 1 {set res [BAR $TID cget -text]} 2 {set res [FileName $TID]} 3 {set res [lsearch -index 0 [BAR listTab] $TID]} default {set res {}} } return $res }
Gets ID of the current tab.
proc ::alited::bar::CurrentTabID {} { # Gets ID of the current tab. return [BAR cget -tabcurrent] }
Gets an attribute of the current tab.
| tab's ID |
proc ::alited::bar::Detach {TID} { # Gets an attribute of the current tab. # TID - tab's ID if {[llength [set TIDs [BAR listFlag s]]]<=1} { set TIDs $TID } set foc [focus] foreach TID $TIDs { alited::file::Detach {} $TID } after idle after 200 apave::focusByForce $foc }
Checks for left tabs to disable "select all at left".
| tab's ID |
Returns 1, if no left tab exists, thus disabling the menu's item.
proc ::alited::bar::DisableTabLeft {tab} { # Checks for left tabs to disable "select all at left". # tab - tab's ID # Returns 1, if no left tab exists, thus disabling the menu's item. set i [CurrentTab 3 $tab] if {$i} {return 0} return 1 }
Checks for right tabs to disable "select all at right".
| tab's ID |
Returns 1, if no right tab exists, thus disabling the menu's item.
proc ::alited::bar::DisableTabRight {tab} { # Checks for right tabs to disable "select all at right". # tab - tab's ID # Returns 1, if no right tab exists, thus disabling the menu's item. set i [CurrentTab 3 $tab] if {$i < ([llength [BAR listTab]]-1)} {return 0} return 1 }
Gets a file name of a tab.
| tab's ID; optional, default "" |
proc ::alited::bar::FileName {{TID {}}} { # Gets a file name of a tab. # TID - tab's ID if {$TID eq {}} {set TID [CurrentTabID]} set tip [BAR $TID cget -tip] return [lindex [split $tip \n] 0] }
Gets a list of pairs "filename & TID". Useful at massive calls of FileTID proc.
proc ::alited::bar::FilesTIDs {} { # Gets a list of pairs "filename & TID". # Useful at massive calls of FileTID proc. # See also: FileTID set filesTIDs [list] foreach tab [BAR listTab] { set TID [lindex $tab 0] lappend filesTIDs [list [FileName $TID] $TID] } return $filesTIDs }
Gets a tab's ID of a file name.
| file name |
| prepared list of pairs "filename & TID" optional, default "" |
The filesTIDs is useful at massive calls of this proc.
proc ::alited::bar::FileTID {fname {filesTIDs {}}} { # Gets a tab's ID of a file name. # fname - file name # filesTIDs - prepared list of pairs "filename & TID" # The *filesTIDs* is useful at massive calls of this proc. # See also: FilesTIDs if {[llength $filesTIDs]} { if {[set i [lsearch -exact -index 0 $filesTIDs $fname]]>=0} { return [lindex $filesTIDs $i 1] } } else { foreach tab [BAR listTab] { set TID2 [lindex $tab 0] if {$fname eq [FileName $TID2]} { return $TID2 } } } return {} }
Fills the bar of tabs.
| frame's path to place the bar in |
| if yes, creates the bar from scratch; optional, default no |
proc ::alited::bar::FillBar {wframe {newproject no}} { # Fills the bar of tabs. # wframe - frame's path to place the bar in # newproject - if yes, creates the bar from scratch namespace upvar ::alited al al obPav obPav update ;# to get real sizes of -wbase set wbase [$obPav LbxInfo] set lab0 [msgcat::mc (Un)Select] set lab1 [msgcat::mc {... Visible}] set lab2 [msgcat::mc {... All at Left}] set lab3 [msgcat::mc {... All at Right}] set lab4 [msgcat::mc {... All}] if {$al(ED,btsbd)} {set bd {-bd 2 -relief sunken}} {set bd {}} set bar1Opts [list -wbar $wframe -wbase $wbase -pady 2 -scrollsel no -lifo $al(lifo) -lowlist $al(FONTSIZE,small) -lablen $al(INI,barlablen) -tiplen $al(INI,bartiplen) -bg [lindex [$obPav csGet] 3] -popuptip ::alited::bar::PopupTip -menu [list sep "com {$lab0} {::alited::bar::SelTab %t} {} {}" "com {$lab1} {::alited::bar::SelTabVis} {} {}" "com {$lab2} {::alited::bar::SelTabLeft %t} {} {{\[::alited::bar::DisableTabLeft %t\]}}" "com {$lab3} {::alited::bar::SelTabRight %t} {} {{\[::alited::bar::DisableTabRight %t\]}}" "com {$lab4} {::alited::bar::SelTabAll} {} {}"] -separator no -font apaveFontDefTypedsmall -csel2 {alited::bar::OnTabSelection %t} -csel3 alited::bar::OnControlClick -cdel {alited::file::CloseFile %t yes} -cmov2 alited::bar::OnTabMove -cmov3 {alited::bar::OnTabMove3 %t} -title $al(MC,filelist) -expand 9 -padx 0 {*}$bd] set tabs [set files [set posis [set wraps [list]]]] foreach tab $al(tabs) { lassign [split $tab \t] tab pos wrap lappend files $tab lappend posis $pos lappend wraps $wrap set tab [UniqueTab $tabs [file tail $tab]] lappend tabs $tab lappend bar1Opts -tab $tab } set byname [msgcat::mc Sort] set bydate [msgcat::mc {... by date}] set bysize [msgcat::mc {... by size}] set byextn [msgcat::mc {... by extension}] set ttl [msgcat::mc {Files to Beginning}] set tip [msgcat::mc "If it's checked, open files would be placed\nonto the beginning page of the bar."] lappend bar1Opts -menu [list sep "com {$byname} {alited::bar::Sort Name}" "com {$bydate} {alited::bar::Sort Date {\n$bydate}}" "com {$bysize} {alited::bar::Sort Size {\n$bysize}}" "com {$byextn} {alited::bar::Sort Extn {\n$byextn}}" sep "com {$al(MC,detach)} {alited::bar::Detach %t}" sep "chb {$ttl} alited::bar::Lifo {} {} {$tip} ::alited::al(lifo)" ] set curname [lindex $tabs $al(curtab)] catch {BAR removeAll} catch {::bartabs::Bars create al(bts)} ;# al(bts) is Bars object if {$newproject || [catch {set al(BID) [al(bts) create al(bt) $bar1Opts $curname]}]} { foreach tab $tabs {BAR insertTab $tab} } set tabs [BAR listTab] foreach tab $tabs fname $files pos $posis wrap $wraps { set tid [lindex $tab 0] SetTabState $tid --fname $fname --pos $pos --wrap $wrap BAR $tid configure -tip [alited::file::FileStat $fname] } set curname [lindex $files $al(curtab)] SetBarState -1 $curname [$obPav Text] [$obPav SbvText] ColorBar alited::file::CheckForNew }
Gets attributes of a tab that are specific for alited.
proc ::alited::bar::GetBarState {} { # Gets attributes of a tab that are specific for alited. return [BAR cget -ALITED] }
Gets attributes of a tab.
| tab's ID (current one by default); optional, default "" |
| list of attributes + values |
proc ::alited::bar::GetTabState {{TID {}} args} { # Gets attributes of a tab. # TID - tab's ID (current one by default) # args - list of attributes + values if {$TID eq {}} {set TID [CurrentTabID]} if {![BAR isTab $TID]} {return {}} return [BAR $TID cget {*}$args] }
Inserts a new tab into the beginning of bar of tabs.
| the tab |
| the tab's tip |
proc ::alited::bar::InsertTab {tab tip} { # Inserts a new tab into the beginning of bar of tabs. # tab - the tab # tip - the tab's tip namespace upvar ::alited al al set TID [BAR insertTab $tab 0] BAR $TID configure -tip $tip SetTabState $TID --fname $tip alited::ini::SaveCurrentIni $al(INI,save_onadd) return $TID }
Sets -lifo option of the bar.
proc ::alited::bar::Lifo {} { # Sets -lifo option of the bar. namespace upvar ::alited al al BAR configure -lifo $al(lifo) }
Shows a number of tabs selected by Ctrl+Click.
proc ::alited::bar::OnControlClick {} { # Shows a number of tabs selected by Ctrl+Click. set llen [llength [alited::bar::BAR cget -select]] set msg [string map "%n $llen" [msgcat::mc {Selected files: %n}]] alited::Message $msg 3 }
Handles moving a tab in the bar.
proc ::alited::bar::OnTabMove {} { # Handles moving a tab in the bar. namespace upvar ::alited al al alited::ini::SaveCurrentIni $al(INI,save_onmove) }
Handles moving selected tab(s) in the bar.
| if empty, the selected tabs are moved; optional, default "" |
proc ::alited::bar::OnTabMove3 {{TID {}}} { # Handles moving selected tab(s) in the bar. # TID - if empty, the selected tabs are moved namespace upvar ::alited al al alited::ini::SaveCurrentIni $al(INI,save_onmove) if {$TID eq {}} { # no selection of tabs after moving BAR unselectTab OnControlClick } }
Handles selecting a tab in the bar.
| tab's ID |
proc ::alited::bar::OnTabSelection {TID} { # Handles selecting a tab in the bar. # TID - tab's ID namespace upvar ::alited al al variable whilesorting if {$whilesorting} return alited::favor::SkipVisited yes set fname [FileName $TID] alited::main::ShowText alited::file::SbhText alited::find::ClearTags alited::ini::SaveCurrentIni $al(INI,save_onselect) alited::edit::CheckSaveIcons [alited::file::IsModified $TID] alited::edit::CheckUndoRedoIcons [alited::main::CurrentWTXT] $TID if {[alited::edit::CommentChar] ne {}} {set cmnst normal} {set cmnst disabled} if {[set wtxt [alited::main::GetWTXT $TID]] ne {}} { set al(wrapwords) [expr {[$wtxt cget -wrap] eq {word}}] } CurrentControlTab $fname alited::menu::FillRunItems $fname alited::main::HighlightLine lassign [alited::main::CalcIndentation $wtxt] indent indentchar ::apave::setTextIndent $indent $indentchar if {$al(prjindentAuto)} {alited::main::UpdateProjectInfo $indent} after 10 { ::alited::tree::SeeSelection ::alited::main::UpdateGutter ::alited::favor::SkipVisited no } if {![alited::file::IsNoName $fname] && ![file exists $fname]} { after idle [list alited::Balloon1 $fname] } }
Makes tooltips (full file names) for popup menu items.
| path to popup menu |
| index of item |
| ID of item's tab |
proc ::alited::bar::PopupTip {wmenu idx TID} { # Makes tooltips (full file names) for popup menu items. # wmenu - path to popup menu # idx - index of item # TID - ID of item's tab if {[$wmenu cget -tearoff]} {incr idx} ::baltip::tip $wmenu [alited::file::FileStat [FileName $TID]] -index $idx -shiftX 10 -ontop 1 }
After closing a tab, seeks and renames synonyms of tabs: "name (2)", "name (3)"
| closed tab's ID |
proc ::alited::bar::RenameTitles {TID} { # After closing a tab, seeks and renames synonyms of tabs: "name (2)", "name (3)" # TID - closed tab's ID set names [list] foreach tab [BAR listTab] { set TID2 [lindex $tab 0] if {$TID2 ne $TID} { set name [file tail [FileName $TID2]] set icnt 1 if {[set i [lsearch -exact -index 1 $names $name]]>-1} { lassign [lindex $names $i] tid name icnt incr icnt set names [lreplace $names $i $i [list $tid $name $icnt]] set name "$name ($icnt)" } lappend names [list $TID2 $name $icnt] } } set doupdate no foreach name $names { lassign $name TID2 name if {[BAR $TID2 cget -text] ne $name} { set doupdate yes BAR $TID2 configure -text $name } } if {$doupdate} {BAR draw no} }
Open a file from the file list even when it's closed (the file list may be open due to -tearoff option).
| tab's ID |
| tip of tab |
proc ::alited::bar::SelFile {TID tip} { # Open a file from the file list even when it's closed # (the file list may be open due to -tearoff option). # TID - tab's ID # tip - tip of tab lassign [split $tip \n] fname if {[alited::file::OpenFile $fname yes] eq {}} { BAR $TID show after idle [list alited::Balloon1 $fname] } }
Makes a tab selected / unselected.
| tab's ID |
| if 1, selects the tab; optional, default -1 |
proc ::alited::bar::SelTab {tab {mode -1}} { # Makes a tab selected / unselected. # tab - tab's ID # mode - if 1, selects the tab set selected [BAR cget -select] if {$mode == 1 || $tab in $selected} { BAR unselectTab $tab } elseif {$mode == 0 || $tab ni $selected} { BAR selectTab $tab } }
Makes all tabs selected / unselected.
proc ::alited::bar::SelTabAll {} { # Makes all tabs selected / unselected. set mode [expr {[llength [BAR cget -select]]>0}] foreach tab [BAR listTab] { SelTab [lindex $tab 0] $mode } }
Makes all left tabs selected / unselected.
| tab's ID |
proc ::alited::bar::SelTabLeft {tab} { # Makes all left tabs selected / unselected. # tab - tab's ID foreach t [BAR listTab] { set t [lindex $t 0] if {$t eq $tab} break SelTab $t } }
Makes all right tabs selected / unselected.
| tab's ID |
proc ::alited::bar::SelTabRight {tab} { # Makes all right tabs selected / unselected. # tab - tab's ID set cntrd no foreach t [BAR listTab] { set t [lindex $t 0] if {$t eq $tab} { set cntrd yes } elseif {$cntrd} { SelTab $t } } }
Makes visible tabs selected / unselected.
proc ::alited::bar::SelTabVis {} { # Makes visible tabs selected / unselected. foreach tab [BAR listFlag v] { SelTab $tab } }
Sets attributes of the tab bar that are specific for alited.
| tab's ID |
| list of attributes + values |
proc ::alited::bar::SetBarState {TID args} { # Sets attributes of the tab bar that are specific for alited. # TID - tab's ID # args - list of attributes + values BAR configure -ALITED [list $TID {*}$args] }
Sets attributes of a tab.
| tab's ID |
| list of attributes + values |
proc ::alited::bar::SetTabState {TID args} { # Sets attributes of a tab. # TID - tab's ID # args - list of attributes + values if {![BAR isTab $TID]} return BAR $TID configure {*}$args }
Sorts tabs.
| sort type (by name is default) |
| sort title; optional, default "" |
proc ::alited::bar::Sort {by {ttl {}}} { # Sorts tabs. # by - sort type (by name is default) # ttl - sort title namespace upvar ::alited obDl2 obDl2 variable whilesorting set ::alited::al(incdec) [set ::alited::al(incdec$by)] lassign [$obDl2 input {} [msgcat::mc Sort] [list radA {{ }} {"$::alited::al(incdec)" increasing decreasing} ] -head [msgcat::mc {Sort files}]$ttl] res ::alited::al(incdec) if {$res} { set whilesorting yes SortData if {$by eq {Name}} {set cmd {}} {set cmd alited::bar::CompareBy$by} if {$::alited::al(incdec) in [list increasing [msgcat::mc increasing]]} { set ::alited::al(incdec) increasing } else { set ::alited::al(incdec) decreasing } BAR sort -$::alited::al(incdec) $cmd set ::alited::al(incdec$by) $::alited::al(incdec) set whilesorting no } }
Sets or gets data for sorting bar tabs.
| tab info (if empty, sets all tabs' data); optional, default "" |
Returns a list of file's name, extension, date and size.
proc ::alited::bar::SortData {{tab {}}} { # Sets or gets data for sorting bar tabs. # tab - tab info (if empty, sets all tabs' data) # Returns a list of file's name, extension, date and size. if {$tab eq {}} { set sortdata [list] foreach tab [BAR listTab] { set tid [lindex $tab 0] set fname [FileName $tid] if {![catch {file stat $fname ares}]} { BAR $tid configure --sortdate $ares(mtime) --sortsize $ares(size) } } return {} } else { set tid [lindex $tab 0] lassign [BAR $tid cget -text --sortdate --sortsize] fname date size set ext [file extension $fname] if {[set i [string first " \(" $ext]]>-1} { set ext [string range $ext 0 $i-1] } return [list $fname $ext $date $size] } }
Gets a tab's title.
| tab's ID; optional, default "" |
proc ::alited::bar::TabName {{TID {}}} { # Gets a tab's title. # TID - tab's ID if {$TID eq {}} {set TID [CurrentTabID]} return [BAR $TID cget -text] }
Returns a unique tab name for a file.
| file name |
Returns a unique tab name for a file.
proc ::alited::bar::UniqueListTab {fname} { # Returns a unique tab name for a file. # fname - file name UniqueTab [BAR listTab] [file tail $fname] -index 1 }
Returns a unique name for a tab.
| list of tabs |
| tab name to be checked for its duplicate |
| options of lsearch to find a duplicate name |
If some file has a tail name (tab name) equal to an existing one's, the new tab name should get "(N)" suffix to be unique. This is required by bartabs package: no duplicates allowed.
Returns a unique name for a tab.
proc ::alited::bar::UniqueTab {tabs tab args} { # Returns a unique name for a tab. # tabs - list of tabs # tab - tab name to be checked for its duplicate # args - options of lsearch to find a duplicate name # If some file has a tail name (tab name) equal to an existing one's, # the new tab name should get "(N)" suffix to be unique. # This is required by bartabs package: no duplicates allowed. set cnttab 1 set taborig $tab while {1} { if {[lsearch {*}$args $tabs $tab]==-1} break set tab "$taborig ([incr cnttab])" } return $tab }
Creates "Checking" dialogue.
proc ::alited::check::_create {} { # Creates "Checking" dialogue. namespace upvar ::alited al al obCHK obCHK variable win catch {destroy $win} $obCHK makeWindow $win.fra $al(MC,checktcl) $obCHK paveWindow $win.fra { {v_ - -} {labHead v_ T 1 1 {-st w -pady 4 -padx 8} {-t "Checks available:"}} {chb1 labHead T 1 1 {-st sw -pady 1 -padx 22} {-var ::alited::check::chBrace -t {Consistency of {} }}} {chb2 + T 1 1 {-st sw -pady 5 -padx 22} {-var ::alited::check::chBracket -t {Consistency of []}}} {chb3 + T 1 1 {-st sw -pady 1 -padx 22} {-var ::alited::check::chParenthesis -t {Consistency of ()}}} {chb4 + T 1 1 {-st sw -pady 5 -padx 22} {-var ::alited::check::chQuotes -t {Consistency of ""}}} {chb9 + T 1 1 {-st sw -pady 1 -padx 22} {-var ::alited::check::chDuplUnits -t {Duplicate units}}} {v_2 + T} {fra + T 1 1 {-st nsew -pady 0 -padx 3} {-padding {5 5 5 5} -relief groove}} {fra.lab - - - - {pack -side left} {-t "Check:"}} {fra.radA - - - - {pack -side left -padx 9} {-t "current file" -var ::alited::check::what -value 1}} {fra.radB - - - - {pack -side left -padx 9} {-t "all of session files" -var ::alited::check::what -value 2}} {fra2 fra T 1 1 {-st nsew -pady 3 -padx 3} {-padding {5 5 5 5} -relief groove}} {.ButHelp - - - - {pack -side left} {-t {$al(MC,help)} -tip F1 -com alited::check::Help}} {.h_ - - - - {pack -side left -expand 1 -fill both}} {.ButOK - - - - {pack -side left -padx 2} {-t "Check" -com ::alited::check::Check}} {.butCancel - - - - {pack -side left} {-t Cancel -com ::alited::check::Cancel}} } bind $win <F1> "[$obCHK ButHelp] invoke" if {[set geo $al(checkgeo)] ne {}} { set geo [string range $geo [string first + $geo] end] set geo "-geometry $geo" } $obCHK showModal $win -modal no -waitvar no -onclose alited::check::Cancel -focus [$obCHK ButOK] {*}$geo }
Runs "Checking" dialogue.
proc ::alited::check::_run {} { # Runs "Checking" dialogue. namespace upvar ::alited al al obCHK obCHK variable win variable atopen set atopen yes if {[::apave::repaintWindow $win "$obCHK ButOK"]} { wm deiconify $win } else { after idle alited::check::Check _create } }
Handles hitting "Cancel" button.
| Optional arguments. |
proc ::alited::check::Cancel {args} { # Handles hitting "Cancel" button. namespace upvar ::alited al al variable win set al(checkgeo) [wm geometry $win] alited::CloseDlg destroy $win }
Runs checking.
proc ::alited::check::Check {} { # Runs checking. namespace upvar ::alited al al variable what variable atopen variable errors variable fileerrors alited::info::Clear alited::info::Put $al(MC,wait) {} yes yes alited::main::UpdateUnitTree set errors [set fileerrors 0] if {$atopen || $what==1} { ;# at start, check a current file CheckFile } elseif {$what==2} { CheckAll } ShowResults }
Checks all files of session.
proc ::alited::check::CheckAll {} { # Checks all files of session. update set allfnd [list] foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] lassign [alited::main::GetText $TID] curfile wtxt CheckFile $curfile $wtxt $TID } }
Checks a file.
| file name; optional, default "" |
| the file's text widget; optional, default "" |
| the file's tab ID; optional, default "" |
proc ::alited::check::CheckFile {{fname {}} {wtxt {}} {TID {}}} { # Checks a file. # fname - file name # wtxt - the file's text widget # TID - the file's tab ID variable errors variable fileerrors variable errors1 variable errors2 variable errors3 variable errors4 variable chDuplUnits if {$fname eq {}} { set fname [alited::bar::FileName] set wtxt [alited::main::CurrentWTXT] set TID [alited::bar::CurrentTabID] } if {$fname ne [alited::bar::FileName] && ![alited::file::IsTcl $fname]} { # do check only a current file and Tcl scripts return } set curfile [file tail $fname] set textcont [$wtxt get 1.0 end] set unittree [alited::unit::GetUnits $TID $textcont] # check for errors of a whole file set errors1 [set errors2 [set errors3 [set errors4 0]]] set fileerrs [CheckUnit $wtxt 1.0 end] # check for duplicate units set errduplist [list] if {$chDuplUnits} { set prevtitle "\{\$\}" set errmsg [msgcat::mc {duplicate unit:}] set uniterr 0 foreach item [lsort -index 3 $unittree] { lassign $item lev leaf fl1 title l1 if {$prevtitle eq $title && $title ni {constructor destructor}} { set uniterr 1 lappend errduplist [list "$curfile: $errmsg $title" $l1] } set prevtitle $title } if {!$fileerrs} {set fileerrs $uniterr} } # put a whole file's statistics on errors incr fileerrors $fileerrs set und [string repeat _ 30] set pos1 [alited::bar::GetTabState $TID --pos] if {![string is double -strict $$pos1]} {set pos1 1.0} set info [list $TID [expr {int($pos1)}]] alited::info::Put "$und $fileerrs ($errors1/$errors2/$errors3/$errors4) file errors of $curfile $und$und$und" $info # put a list of duplicate units foreach errdup $errduplist { lassign $errdup msg pos1 alited::info::Put $msg [PosInfo $TID $pos1] } # check for errors of specific units foreach item $unittree { lassign $item lev leaf fl1 title l1 l2 if {!$leaf || $title eq {}} continue set title "$curfile: $title" set err [CheckUnit $wtxt $l1.0 $l2.end $TID $title] if {$err} { incr errors $err } } }
Checks a unit.
| text's path |
| starting position of the unit in the text |
| ending position of the unit in the text |
| tab's ID; optional, default "" |
| title of the unit; optional, default "" |
| if yes, displays errors bolded; optional, default no |
| if yes, displays errors in red color; optional, default no |
proc ::alited::check::CheckUnit {wtxt pos1 pos2 {TID {}} {title {}} {bold no} {see no}} { # Checks a unit. # wtxt - text's path # pos1 - starting position of the unit in the text # pos2 - ending position of the unit in the text # TID - tab's ID # title - title of the unit # bold - if yes, displays errors bolded # see - if yes, displays errors in red color # See also: info::Put variable chBrace variable chBracket variable chParenthesis variable chQuotes variable chDuplUnits variable errors1 variable errors2 variable errors3 variable errors4 set cc1 [set cc2 [set ck1 [set ck2 [set cp1 [set cp2 [set cq1 0]]]]]] set mapB1 [list "{\[}" {}] ;# skip this usage (not regexp's alas) set mapB2 [list "{\]}" {}] set mapP1 [list "{\(}" {}] set mapP2 [list "{\)}" {}] set mapQ [list "{\"}" {}] foreach line [split [$wtxt get $pos1 $pos2] \n] { if {[string match -nocase *#*alited*check* $line] || [string match -nocase *#*check*alited* $line]} { # if a line is "checked by alited", skip this unit as checked by a human return 0 } if {$chBrace} { incr cc1 [::apave::countChar $line \{] incr cc2 [::apave::countChar $line \}] } if {$chBracket} { incr ck1 [::apave::countChar [string map $mapB1 $line] \[] incr ck2 [::apave::countChar [string map $mapB2 $line] \]] } if {$chParenthesis} { incr cp1 [::apave::countChar [string map $mapP1 $line] (] incr cp2 [::apave::countChar [string map $mapP2 $line] )] } if {$chQuotes} { incr cq1 [::apave::countChar [string map $mapQ $line] \"] } } set err 0 set arg [list [PosInfo $TID $pos1] $bold $see] if {$cc1 != $cc2} { incr err incr errors1 if {$TID ne {}} {alited::info::Put "$title: inconsistent \{\}: $cc1 != $cc2" {*}$arg} } if {$ck1 != $ck2} { incr err incr errors2 if {$TID ne {}} {alited::info::Put "$title: inconsistent \[\]: $ck1 != $ck2" {*}$arg} } if {$cp1 != $cp2} { incr err incr errors3 if {$TID ne {}} {alited::info::Put "$title: inconsistent (): $cp1 != $cp2" {*}$arg} } if {$cq1 % 2} { incr err incr errors4 if {$TID ne {}} {alited::info::Put "$title: inconsistent \"\": $cq1" {*}$arg} } return $err }
Handles hitting "Help" button.
| Optional arguments. |
proc ::alited::check::Help {args} { # Handles hitting "Help" button. variable win alited::Help $win }
Gets an info on a unit's position (for Put procedure).
| tab's ID |
| starting position of the unit in the text |
Returns a list of TID and the normalized unit's position.
proc ::alited::check::PosInfo {TID pos1} { # Gets an info on a unit's position (for Put procedure). # TID - tab's ID # pos1 - starting position of the unit in the text # Returns a list of TID and the normalized unit's position. # See also: info::Put if {$TID eq {}} { set res {} } else { set res [list $TID [expr {[string is double -strict $pos1] ? int($pos1) : 1}]] } return $res }
Displays results of checking.
proc ::alited::check::ShowResults {} { # Displays results of checking. variable errors variable fileerrors variable atopen if {$errors || $fileerrors} { set msg [msgcat::mc {Found %f file error(s), %u unit error(s).}] set msg [string map [list %f $fileerrors %u $errors] $msg] if {$atopen} bell } else { set msg [msgcat::mc {No errors found.}] } alited::info::Put $msg {} yes set atopen no }
Gets all commands available in Tcl/Tk and in session files.
| ID of a current tab; optional, default "" |
| starting position of the current word; optional, default 0 |
If currentTID is set, the commands of this TID are shown unqualified.
Returns a list of "proc variables + commands" and a flag "with commands"
proc ::alited::complete::AllSessionCommands {{currentTID {}} {idx1 0}} { # Gets all commands available in Tcl/Tk and in session files. # currentTID - ID of a current tab # idx1 - starting position of the current word # If currentTID is set, the commands of this TID are shown unqualified. # Returns a list of "proc variables + commands" and a flag "with commands" namespace upvar ::alited al al if {[set isread [info exists al(_SessionCommands)]]} { unset al(_SessionCommands) } else { alited::info::Put $al(MC,wait) {} yes yes update } set al(_SessionCommands) [dict create] set res [list] # first, add variables set wtxt [alited::main::CurrentWTXT] lassign [alited::favor::CurrentName] itemID name l1 l2 if {$l2 eq {}} {set l1 [set l2 0]} catch { # get variables from the current proc's header lassign [split [$wtxt get $l1.0 [expr {$l1+4}].0] \n] h1 h2 h3 h4 foreach i {2 3 4} { incr l1 if {[string index $h1 end] eq "\\"} { set h1 [string trimright $h1 \\]\ [set h$i] } else { break } } lassign [string trimright $h1 \{] typ - argums if {$typ in {proc method}} { foreach v $argums { lappend res \$[lindex $v 0] } } } # get variables from the current proc's body set RE {(?:(((^\s*|\[\s*|\{\s*)+((set|unset|append|lappend|incr|variable|global)\s+)} append RE {)|\$)([:a-zA-Z0-9_]*[\(]*[:a-zA-Z0-9_,\$]*[\)]*))} foreach line [split [$wtxt get $l1.0 [incr l2].0] \n] { foreach {- - - - - - v} [regexp -all -inline $RE $line] { if {[string match *(* $v] || [string match *)* $v]} { if {![string match *(*) $v]} { set v [string trim $v ()] } } if {$v ni {{} : ::} && [lsearch -exact $res $v]==-1} { if {![string match \$* $v]} {set v \$$v} lappend res $v } } } set idx1 [expr {int([$wtxt index insert])}].$idx1 # check for $ dollar char set isdol [expr {[$wtxt get "$idx1 -1 c"] eq {$}}] set isdol1 [expr {[$wtxt get "$idx1 -2 c" $idx1] eq {$:}}] set isdol2 [expr {[$wtxt get "$idx1 -3 c" $idx1] eq {$::}}] if {$isdol1 || $isdol2} { foreach v [info vars ::*] { if {[llength $v]==1} {lappend res \$$v} } } # if it isn't a variable's value, add also commands if {[set withcom [expr {!$isdol && !$isdol1 && !$isdol2}]]} { # get commands available in files of current session foreach tab [alited::SessionList] { set TID [lindex $tab 0] lassign [alited::main::GetText $TID no no] curfile wtxt foreach it $al(_unittree,$TID) { lassign $it lev leaf fl1 ttl l1 l2 if {$leaf && [llength $ttl]==1} { if {$TID eq $currentTID} { set ttl [lindex [split $ttl :] end] } lappend res $ttl # save arguments of proc/method set h [alited::unit::GetHeader {} {} 0 $wtxt $ttl $l1 $l2] catch {dict set al(_SessionCommands) $ttl [lindex [split $h \n] 0 2]} } } } if {[llength $al(ED,TclKeyWords)]} { lappend res {*}$al(ED,TclKeyWords) ;# user's commands } } if {!$isread} {alited::info::Clear end} list $res $withcom }
Runs auto completion of commands.
proc ::alited::complete::AutoCompleteCommand {} { # Runs auto completion of commands. namespace upvar ::alited al al variable tclcoms variable wordorig set wtxt [alited::main::CurrentWTXT] set pos [$wtxt index insert] set row [expr {int($pos)}] set charsOn [string trim [$wtxt get "$pos -1 char" "$pos +1 char"]] set leftpart [string trim [$wtxt get $row.0 $pos]] if {$al(acc_19) eq {Tab} && $charsOn ne {$} && (![regexp {[[:alnum:]_]} $charsOn] || $leftpart eq {})} { # (if the cursor isn't over a word) # Tab is the indentation on the line's beginning or Tab char otherwise if {$leftpart eq {}} { $wtxt insert $pos [alited::main::CalcPad $wtxt] } else { $wtxt insert $pos \t } return } if {![llength $tclcoms]} { set tclcoms [::hl_tcl::hl_commands] foreach cmd {exit break continue pwd pid} { # these commands mostly without arguments: below, don't add { } after them if {[set i [lsearch -exact $tclcoms $cmd]]>-1} { set tclcoms [lreplace $tclcoms $i $i] } } } lassign [MatchedCommands] wordorig idx1 idx2 while 1 { set com [PickCommand $wtxt] if {[llength $com]==2 && [lindex $com 0] eq {_alited_}} { set wordorig [lindex $com 1] MatchedCommands $wordorig $idx1 $idx2 } else { break } } if {$com ne {}} { set isvar [string match \$* $com] if {[$wtxt get "$row.$idx1 -1 c"] eq "\$"} { incr idx1 -1 } elseif {[$wtxt get "$row.$idx1 -2 c" $row.$idx1] eq "\$:"} { incr idx1 -2 } elseif {[$wtxt get "$row.$idx1 -3 c" $row.$idx1] eq "\$::"} { incr idx1 -3 } elseif {[$wtxt get $row.$idx1] eq "\$"} { # replace $variable } elseif {$isvar} { set com [string range $com 1 end] } $wtxt delete $row.$idx1 $row.[incr idx2] set pos $row.$idx1 if {!$isvar} { if {[dict exists $al(_SessionCommands) $com] && [set argums [dict get $al(_SessionCommands) $com]] ne {}} { # add all of the unit's arguments catch { foreach ar $argums { if {[llength $ar]==1} { append com " \$$ar" } else { append com " {\$$ar}" ;# default value to be seen } } } } elseif {$com in $tclcoms} { append com { } } } $wtxt insert $pos $com ::alited::main::HighlightLine } focus -force $wtxt }
Sets colors for pick list.
| text's path |
proc ::alited::complete::ColorPick {wtxt} { # Sets colors for pick list. # wtxt - text's path variable obj variable comms set lbx [$obj Lbx] set llen [llength $comms] lassign [::hl_tcl::hl_colors $wtxt] fgcom - - fgvar set i 0 foreach com $comms { if {[string index $com 0] eq {$}} { $lbx itemconfigure $i -foreground $fgvar ;# variable } else { $lbx itemconfigure $i -foreground $fgcom ;# command } incr i } }
Gets cursor's screen coordinates and a character under cursor in a text.
| text's path; optional, default "" |
| shift from the cursor where to get non-empty char; optional, default "" |
Returns a list of X, Y coordinates and a character under the cursor.
proc ::alited::complete::CursorCoordsChar {{wtxt {}} {shift {}}} { # Gets cursor's screen coordinates and a character under cursor in a text. # wtxt - text's path # shift - shift from the cursor where to get non-empty char # Returns a list of X, Y coordinates and a character under the cursor. if {$wtxt eq {}} {set wtxt [alited::main::CurrentWTXT]} focus $wtxt set poi [$wtxt index insert] set ch [$wtxt get $poi [$wtxt index {insert +1c}]] set nl [expr {int($poi)}] if {[$wtxt get $nl.0 $nl.end] eq {}} { lassign [$wtxt bbox insert] X Y - h set w 0 set ch - } else { if {[string trim $ch] eq {} || $shift eq {linestart}} { set pos "insert $shift" } else { set pos insert } set pos [$wtxt index $pos] lassign [$wtxt bbox $pos] X Y w h } if {$h eq {}} {set X [set Y [set w [set h 0]]]} incr X $w incr Y $h set p [winfo parent $wtxt] while 1 { lassign [split [winfo geometry $p] x+] w h x y incr X $x incr Y $y if {[catch {set p [winfo parent $p]}] || $p in {{} {.}}} break } list $X $Y $ch }
Handles pressing Return on entry.
proc ::alited::complete::EntReturn {} { # Handles pressing Return on entry. variable win variable obj variable word set lbx [$obj Lbx] set idx [$lbx curselection] if {$idx eq {} || [set com [$lbx get $idx]] eq {}} { set com $word } if {$com ne {}} {$obj res $win $com} }
Check matching a word to a command.
| the word |
| the command |
proc ::alited::complete::IsMatch {curword com} { # Check matching a word to a command. # curword - the word # com - the command set res 0 catch {set res [expr {[string match $curword* $com] || [string match $curword* [namespace tail $com]] || [regexp "^\[\$\]?$curword" $com]}]} return $res }
Gets commands that are matched to a current (under cursor) word.
| current word to match; optional, default "" |
| contains idx1, idx2 indices |
Returns list of current word, begin and end of it.
proc ::alited::complete::MatchedCommands {{curword {}} args} { # Gets commands that are matched to a current (under cursor) word. # curword - current word to match # args - contains idx1, idx2 indices # Returns list of current word, begin and end of it. variable comms variable commsorig variable maxwidth if {$curword eq {}} { lassign [alited::find::GetWordOfText noselect2 yes] curword idx1 idx2 } else { lassign $args idx1 idx2 } if {![namespace exists ::alited::repl]} { namespace eval ::alited { source [file join $::alited::LIBDIR repl repl.tcl] } } lassign [AllSessionCommands [alited::bar::CurrentTabID] $idx1] allcomms withcomms if {$withcomms} { lappend allcomms {*}[lindex [::alited::repl::complete command {}] 1] } set comms [list] set excluded [list {[._]*} alimg_* bts_*] set maxwidth 20 foreach com $allcomms { set incl 1 foreach ex $excluded { if {[string match $ex $com]} { set incl 0 break } } if {$incl && [IsMatch $curword $com]} { lappend comms $com set maxwidth [expr {max($maxwidth,[string length $com])}] } } set commsorig $comms set comms [lsort -dictionary -unique $comms] list $curword $idx1 $idx2 }
Shows a frame of commands for auto completion, allowing a user to select from it.
| text's path |
proc ::alited::complete::PickCommand {wtxt} { # Shows a frame of commands for auto completion, # allowing a user to select from it. # wtxt - text's path variable win variable obj variable word variable comms variable commsorig variable wordorig if {[set llen [llength $comms]]==0} {return {}} set word $wordorig # check for variables if any exist for {set il 0; set icv -1} {$il<$llen} {incr il} { set cv [lindex $comms $il] if {[string first \$ $cv]<0} break if {$cv eq "\$$wordorig"} {set icv $il} } if {$icv>=0 && $il>1 && [string length $wordorig]==1} { set i 0 foreach c $commsorig {if {$c eq "\$wordorig"} {incr i}} if {$i<2} { ;# 1 occurence of 1 letter => remove it set comms [lreplace $comms $icv $icv] incr llen -1 incr il -1 } } set commsorig $comms set mlen 16 set lht [expr {max(min($llen,$mlen),1)}] set obj ::alited::pavedPickCommand catch {destroy $win} catch {$obj destroy} if {$::alited::al(IsWindows)} { toplevel $win } else { toplevel $win # the line below is of an issue in kubuntu (KDE?): small sizes of the popup window after idle [list ::alited::complete::WinGeometry $lht] } wm withdraw $win wm overrideredirect $win 1 ::apave::APave create $obj $win set lwidgets [list "Ent - - - - {pack -fill x} {-w $::alited::complete::maxwidth -tvar ::alited::complete::word -validate key -validatecommand {alited::complete::PickValid $wtxt %V %d %i %s %S}}" "fra - - - - {pack -expand 1 -fill both}" ".Lbx - - - - {pack -side left -expand 1 -fill both} {-h $lht -w $::alited::complete::maxwidth -lvar ::alited::complete::comms -exportselection 0}" ] if {$llen>$mlen} { # add vertical scrollbar if number of items exceeds max.height lappend lwidgets {.sbvPick + L - - {pack -side left -fill both} {}} } $obj paveWindow $win $lwidgets set ent [$obj Ent] set lbx [$obj Lbx] foreach ev {ButtonPress-1 Return KP_Enter KeyPress-space} { catch {bind $lbx <$ev> "after idle {::alited::complete::SelectCommand $obj $lbx}"} } ColorPick $wtxt $lbx selection set 0 lassign [TextCursorCoordinates $wtxt] X Y if {$::alited::al(IsWindows)} { incr X 10 incr Y 40 after 100 "wm deiconify $win" } after idle "wm withdraw $win; ::apave::CursorAtEnd $ent; wm deiconify $win" bind $ent <Return> {+ alited::complete::EntReturn} bind $win <FocusOut> {alited::complete::PickFocusOut %W} set res [$obj showModal $win -focus $ent -modal no -geometry +$X+$Y] catch {destroy $win} catch {$obj destroy} if {$res ne "0"} {return $res} return {} }
Closes the word picker at "focus out" event.
| a current widget |
proc ::alited::complete::PickFocusOut {w} { # Closes the word picker at "focus out" event. # w - a current widget variable win variable obj if {[focus] ni [list [$obj Ent] [$obj Lbx]]} { $obj res $win 0 } }
Validates the word picker's input.
| text's path |
| %V of -validatecommand: validation condition |
| %d of -validatecommand: 1 for insert, 0 for delete |
| %i of -validatecommand: index of character |
| %s of -validatecommand: current value of entry |
| %S of -validatecommand: string being inserted/deleted |
proc ::alited::complete::PickValid {wtxt V d i s S} { # Validates the word picker's input. # wtxt - text's path # V - %V of -validatecommand: validation condition # d - %d of -validatecommand: 1 for insert, 0 for delete # i - %i of -validatecommand: index of character # s - %s of -validatecommand: current value of entry # S - %S of -validatecommand: string being inserted/deleted variable win variable obj variable comms variable commsorig variable wordorig if {$V eq {focusin}} { ::apave::CursorAtEnd [$obj Ent] } switch $d { 0 { set curword [string replace $s $i $i] set lc [string length $curword] if {$lc && $lc<[string length $wordorig]} { $obj res $win [list _alited_ $curword] ;# to remake the list } } 1 { set curword [string range $s 0 $i]$S[string range $s $i end] if {[string length $curword]==1 && $curword ne $wordorig} { $obj res $win [list _alited_ $curword] ;# to remake the list } } } if {$d != -1} { set fltcomms [list] foreach com $commsorig { if {[IsMatch $curword $com]} { lappend fltcomms $com } } set comms $fltcomms ColorPick $wtxt update } catch { set lbx [$obj Lbx] $lbx selection clear 0 end $lbx selection set 0 $lbx activate 0 $lbx see 0 lassign [$obj csGet] - - - - - bg fg $lbx itemconfigure 0 -selectbackground $bg -selectforeground $fg } return 1 }
Handles a selection of command for auto completion.
| apave object |
| listbox's path |
proc ::alited::complete::SelectCommand {obj lbx} { # Handles a selection of command for auto completion. # obj - apave object # lbx - listbox's path variable win $obj res $win [lindex $::alited::complete::comms [$lbx curselection]] }
Gets cursor's screen coordinates under cursor in a text. Also, sets the focus on the text (to make this task be possible at all).
| text's path; optional, default "" |
Returns a list of X and Y coordinates.
proc ::alited::complete::TextCursorCoordinates {{wtxt {}}} { # Gets cursor's screen coordinates under cursor in a text. # Also, sets the focus on the text (to make this task be possible at all). # wtxt - text's path # Returns a list of X and Y coordinates. set res [CursorCoordsChar $wtxt] lassign $res X Y ch if {$ch eq {} || $ch eq "\n"} { # EOL => get a previous char's coordinates set res [CursorCoordsChar $wtxt -1c] } return $res }
Checks and corrects the completion window's geometry (esp. for KDE).
| height of completion list |
proc ::alited::complete::WinGeometry {lht} { # Checks and corrects the completion window's geometry (esp. for KDE). # lht - height of completion list variable win update lassign [TextCursorCoordinates] x y lassign [split [wm geometry $win] x+] w h set w2 [winfo reqwidth $win] ; set w3 [winfo width $win] set h2 [winfo reqheight $win]; set h3 [winfo height $win] set w [expr {max($w,$w2,$w3)}] set h [expr {max($h,$h2,$h3)}] if {$w>20 && $h>20} { wm geometry $win ${w}x${h}+${x}+${y} } else { wm geometry $win 220x325+${x}+${y} } }
Handles detached editor.
| edited file's name |
proc ::alited::detached::_create {fname} { # Handles detached editor. # fname - edited file's name namespace upvar ::alited al al lassign [Options] id pobj win geo if {$id eq {}} return if {![file isfile $fname]} { alited::Balloon1 $fname return } set $pobj $geo if {$geo ne {}} {set geo "-geometry $geo"} set al(detachtools) {} foreach icon {SaveFile undo redo cut copy paste} { set img [alited::ini::CreateIcon $icon] append al(detachtools) " $img \{{} " switch $icon { SaveFile { append al(detachtools) "-com {alited::detached::SaveFile $pobj $fname $win} -state disabled" set tip $::alited::al(MC,ico$icon) } undo - redo - cut - copy - paste { append al(detachtools) "-com {alited::detached::Tool $pobj $icon}" if {$icon in {undo redo}} {append al(detachtools) " -state disabled"} set tip [string totitle $icon] } } append al(detachtools) " -tip {$tip@@ -under 4}\}" if {$icon in {SaveFile redo}} { append al(detachtools) " sev 6" } } append al(detachtools) " sev 16 lab1 {{Find: }} CbxFind {-font {$::apave::FONTMAIN}}" ::apave::APave create $pobj $win $pobj makeWindow $win.fra $fname $pobj paveWindow $win.fra { {fra1 - - 1 1 {-st nsew -rw 1 -cw 1}} {.ToolTop - - - - {pack -side top -fill x} {-array {$::alited::al(detachtools)} -relief groove -borderwidth 1}} {.GutText - - - - {pack -side left -expand 0 -fill both}} {.FrAText - - - - {pack -side left -expand 1 -fill both -padx 0 -pady 0 -ipadx 0 -ipady 0} {-background $::apave::BGMAIN2}} {.frAText.Text - - - - {pack -expand 1 -fill both} {-w 50 -h 20 -gutter GutText -gutterwidth $al(ED,gutterwidth) -guttershift $al(ED,guttershift)}} {.sbv + L - - {pack -side right -fill y}} } set wtxt [$pobj Text] set cbx [$pobj CbxFind] foreach ev {Return KP_Enter F3} { bind $cbx <$ev> "alited::detached::Find $pobj $wtxt" } foreach ev {f F} {bind $wtxt <Control-$ev> "focus $cbx"} bind $wtxt <F3> "alited::detached::Find $pobj $wtxt 1" foreach ev [alited::pref::BindKey2 0 -] { bind $win <$ev> "alited::detached::SaveFile $pobj $fname $win" } if {$al(fontdetach)} {set fsz $al(FONTSIZE,std)} {set fsz {}} after 50 after idle "$pobj fillGutter $wtxt; alited::file::MakeThemHighlighted {} $wtxt; alited::detached::DisplayText $pobj {$fname}; alited::main::HighlightText {} {$fname} $wtxt {alited::detached::Modified $pobj $win} {} $fsz; " $pobj showModal $win -modal no -waitvar no -resizable 1 -minsize {300 200} -onclose [list alited::detached::Close $id $pobj $win $fname] -focus $wtxt {*}$geo }
Open files in detached editors.
| file name list |
proc ::alited::detached::_run {fnames} { # Open files in detached editors. # fnames - file name list foreach fn $fnames { _create $fn } }
Closes detached editor.
| editor's index |
| apave object |
| editor's window |
| file name |
| Optional arguments. |
proc ::alited::detached::Close {id pobj win fname args} { # Closes detached editor. # id - editor's index # pobj - apave object # win - editor's window # fname - file name if {$id<=8} { # save only first ones' geometry (avoiding fat history) set $pobj [wm geometry $win] } set wtxt [$pobj Text] if {[$wtxt edit modified]} { set msg [msgcat::mc {Save changes made to the text?}] switch [alited::msg yesnocancel warn $msg {} -centerme $win] { 1 {SaveFile $pobj $fname $win} 2 {} default {return} } } catch {destroy $win} $pobj destroy alited::ini::SaveIni }
Displays file's text.
| apave object of detached editor |
| file name |
proc ::alited::detached::DisplayText {pobj fname} { # Displays file's text. # pobj - apave object of detached editor # fname - file name $pobj displayText [$pobj Text] [readTextFile $fname] }
Finds string in text.
| apave object of detached editor |
| text's path |
| "1" means 'from a current position'; optional, default 0 |
proc ::alited::detached::Find {pobj wtxt {donext 0}} { # Finds string in text. # pobj - apave object of detached editor # wtxt - text's path # donext - "1" means 'from a current position' variable varFind set cbx [$pobj CbxFind] if {[set varFind [$cbx get]] ne {}} { $pobj findInText $donext $wtxt ::alited::detached::varFind set values [$cbx cget -values] if {$varFind ni $values} { $cbx configure -values [linsert $values 0 $varFind] } } focus [$pobj Text] }
Callback for modifying text.
| apave object of detached editor |
| window's path |
| text's path |
| Optional arguments. |
proc ::alited::detached::Modified {pobj win wtxt args} { # Callback for modifying text. # pobj - apave object of detached editor # win - window's path # wtxt - text's path catch { set ttl [string trimleft [wm title $win] *] if {[$wtxt edit modified]} { set ttl *$ttl set state normal } else { set state disabled } wm title $win $ttl [$pobj ToolTop].buT_alimg_SaveFile configure -state $state foreach do {undo redo} { if {[$wtxt edit can$do]} {set state normal} else {set state disabled} [$pobj ToolTop].buT_alimg_$do configure -state $state } } }
Gets options of new detached editor.
Returns a list of index, apave object name, window path, geometry. The geometry is of some previously used window or "".
proc ::alited::detached::Options {} { # Gets options of new detached editor. # Returns a list of index, apave object name, window path, geometry. # The geometry is of some previously used window or "". while {[incr id]<99} { lassign [alited::file::DetachedInfo $id] pobj win if {![info exists $pobj]} { set geo {} ;# vacant yet } elseif {![winfo exists $win]} { set geo [::apave::checkGeometry [set $pobj]] ;# was used } else { continue } return [list $id $pobj $win $geo] } alited::Balloon "Too many requests for detachments!" return {} }
Saves changed text.
| apave object of detached editor |
| file name |
| window's path |
proc ::alited::detached::SaveFile {pobj fname win} { # Saves changed text. # pobj - apave object of detached editor # fname - file name # win - window's path set wtxt [$pobj Text] if {[alited::file::SaveText $wtxt $fname]} { $wtxt edit modified no alited::detached::Modified $pobj $win $wtxt } }
Applies tool to text.
| apave object of detached editor |
| tool of toolbar |
proc ::alited::detached::Tool {pobj tool} { # Applies tool to text. # pobj - apave object of detached editor # tool - tool of toolbar event generate [$pobj Text] <<[string totitle $tool]>> }
Gets directory and file names for backuping.
| current tab's ID |
Returns a list of names: directory, source file, target original file
proc ::alited::edit::BackupDirFileNames {TID} { # Gets directory and file names for backuping. # TID - current tab's ID # Returns a list of names: # directory, source file, target original file namespace upvar ::alited al al if {$al(BACKUP) eq {}} {return {}} set dir [file join $al(prjroot) $al(BACKUP)] set fname [alited::bar::FileName $TID] set fname2 [file join $dir [file tail $fname]] if {![file exists $dir] && [catch {file mkdir $dir} err]} { alited::msg ok err $err return {} } set fname3 [file join $dir [file tail $fname]] list $dir $fname $fname2 }
Makes a backup copy of a file after the first modification of it.
| tab's ID of the file |
| if {orig}, makes an original copy of a file, otherwise makes .bak copy; optional, default "" |
proc ::alited::edit::BackupFile {TID {mode {}}} { # Makes a backup copy of a file after the first modification of it. # TID - tab's ID of the file # mode - if {orig}, makes an original copy of a file, otherwise makes .bak copy namespace upvar ::alited al al lassign [BackupDirFileNames $TID] dir fname fname2 if {$dir ne {}} { if {$mode eq {}} { set fname2 [BackupFileName $fname2] } catch { file copy -force $fname $fname2 ::apave::logMessage "backup $fname -> $fname2" } } }
Gets a backup name for a file (checking for backup's maximum).
| name of target file |
| incrementation for backup index; optional, default 1 |
The iincr parameter is used to get the last backup's name: if no backups, the empty string is returned.
proc ::alited::edit::BackupFileName {fname {iincr 1}} { # Gets a backup name for a file (checking for backup's maximum). # fname - name of target file # iincr - incrementation for backup index # The iincr parameter is used to get the last backup's name: # if no backups, the empty string is returned. namespace upvar ::alited al al if {$al(MAXBACKUP)>1} { if {[set baks [glob -nocomplain ${fname}*]] eq {}} { set nbak 1 if {!$iincr} {return {}} ;# no backups yet } else { foreach bak $baks { lappend bakdata [list [file mtime $bak] $bak] } set bakdata [lsort -decreasing $bakdata] set bak1 [lindex $bakdata 0 1] set nbak [lindex [split $bak1 -.] end-1] foreach delbak [lrange $bakdata $al(MAXBACKUP) end] { catch {file delete [lindex $delbak 1]} } if {[catch {incr nbak $iincr}] || $nbak>$al(MAXBACKUP)} {set nbak 1} } append fname -$nbak.bak } return $fname }
Binds pluginable formatters to the edited text.
| text's path |
proc ::alited::edit::BindPluginables {wtxt} { # Binds pluginable formatters to the edited text. # wtxt - text's path namespace upvar ::alited al al set lformat [array names al -glob FORMATS,*] if {[llength $lformat]} { SourceFormatTcl foreach n $lformat { lassign $al($n) fullformname ev set fn [file tail $fullformname] if {[set i [lsearch -index 0 $al(FORMATNAMES) $fn]]>-1} { set fullformname [lindex $al(FORMATNAMES) $i 1] ;# truly source name } set fform [FormatterName $fullformname] if {[info exists ::alited::format::bind6($fform)] && [llength $::alited::format::bind6($fform)]} { foreach b $::alited::format::bind6($fform) { lassign $b ev com catch { bind $wtxt $ev $com } } } else { RunFormat $fullformname yes } } } }
Checks for states of save buttons at modifications of files.
| yes, if a file has been modified |
proc ::alited::edit::CheckSaveIcons {modif} { # Checks for states of save buttons at modifications of files. # modif - yes, if a file has been modified namespace upvar ::alited al al set marked [alited::bar::BAR listFlag "m"] set b_save [alited::tool::ToolButName SaveFile] set b_saveall [alited::tool::ToolButName saveall] if {![llength $marked]} { foreach but {SaveFile saveall} { [alited::tool::ToolButName $but] configure -state disabled } } else { if {$modif} {set stat normal} {set stat disabled} $b_save configure -state $stat $b_saveall configure -state normal } $al(MENUFILE) entryconfigure 5 -state [$b_save cget -state] $al(MENUFILE) entryconfigure 7 -state [$b_saveall cget -state] }
Checks for states of undo/redo button for a file being modified.
| text's path |
| tab's ID of the file |
proc ::alited::edit::CheckUndoRedoIcons {wtxt TID} { # Checks for states of undo/redo button for a file being modified. # wtxt - text's path # TID - tab's ID of the file set TIDundo [alited::bar::BAR cget --TIDundo] set oldundo [alited::bar::BAR $TID cget --undo] set oldredo [alited::bar::BAR $TID cget --redo] set newundo [$wtxt edit canundo] set newredo [$wtxt edit canredo] if {$TIDundo ne $TID || $oldundo ne $newundo} { if {$newundo} {set stat normal} {set stat disabled} [alited::tool::ToolButName undo] configure -state $stat alited::bar::BAR $TID configure --undo $newundo } if {$TIDundo ne $TID || $oldredo ne $newredo} { if {$newredo} {set stat normal} {set stat disabled} [alited::tool::ToolButName redo] configure -state $stat alited::bar::BAR $TID configure --redo $newredo } if {$oldundo ne {} && !$oldundo && !$oldredo && $newundo} { BackupFile $TID orig } alited::bar::BAR configure --TIDundo $TID }
Comments selected lines of text.
proc ::alited::edit::Comment {} { # Comments selected lines of text. # See also: UnComment namespace upvar ::alited obPav obPav al al set ch [CommentChar] set sels [SelectedLines] set wtxt [lindex $sels 0] undoIn $wtxt foreach {l1 l2} [lrange $sels 1 end] { for {set l $l1} {$l<=$l2} {incr l} { set line [$wtxt get $l.0 $l.end] set col [$obPav leadingSpaces $line] switch $al(commentmode) { 1 {$wtxt insert $l.0 $ch} 2 {$wtxt insert $l.$col $ch} default { if {$ch eq "#"} { # comment-out with TODO comment: to see / to find / to do them afterwards # for Tcl code: it needs to disable also all braces with #\{ #\} patterns $wtxt replace $l.0 $l.end [string map [list \} #\\\} \{ #\\\{] $line] } $wtxt insert $l.0 $ch! } } } } undoOut $wtxt SelectLines $wtxt $l1 $l2 after idle alited::tree::RecreateTree }
Returns the commenting chars for a current file.
Returns the commenting chars for a current file.
proc ::alited::edit::CommentChar {} { # Returns the commenting chars for a current file. set fname [alited::bar::FileName] if {[alited::file::IsClang $fname]} { return // } return # }
Compares two string by length.
| 1st string |
| 2nd string |
proc ::alited::edit::CompareByLength {s1 s2} { # Compares two string by length. # s1 - 1st string # s2 - 2nd string set l1 [string length $s1] set l2 [string length $s2] if {$l1>$l2} { return 1 } elseif {$l1<$l2} { return -1 } return 0 }
Goes to a previous word's start/end as seen from programmer's viewpoint.
| text's path |
| key state |
The code is rather efficient with long sequences of non-word chars.
Going_on_words_with_Ctrl+arrow, text_index_{insert_wordstart}
proc ::alited::edit::ControlLeft {txt s} { # Goes to a previous word's start/end as seen from programmer's viewpoint. # txt - text's path # s - key state # The code is rather efficient with long sequences of non-word chars. # See also: # [Going_on_words_with_Ctrl+arrow](https://core.tcl-lang.org/tk/tktview/168f3ef130) # [text_index_{insert_wordstart}](https://core.tcl-lang.org/tk/tktview/57b821d2db) if {$s % 2} return set pos [$txt index insert] lassign [split $pos .] -> col set linestart [expr {int($pos)}] while {$linestart>=0} { set line [$txt get $linestart.0 $linestart.$col] for {set i [string length $line]} {[incr i -1]>=0} {} { if {[string is wordchar -strict [string index $line $i]]} { if {![string is wordchar -strict [string index $line [expr {$i-1}]]]} { set pos1 $linestart.$i set pos2 [$txt index "$pos1 wordend"] if {[$txt compare $pos2 < $pos]} {set pos1 $pos2} ::tk::TextSetCursor $txt $pos1 return -code break } } } incr linestart -1 set col {end +1c} } return -code break }
Goes to a next word's start as seen from programmer's viewpoint.
| text's path |
| key state |
The code is rather efficient with long sequences of non-word chars. Going_on_words_with_Ctrl+arrow text_index_{insert_wordstart}
proc ::alited::edit::ControlRight {txt s} { # Goes to a next word's start as seen from programmer's viewpoint. # txt - text's path # s - key state # The code is rather efficient with long sequences of non-word chars. # [Going_on_words_with_Ctrl+arrow](https://core.tcl-lang.org/tk/tktview/168f3ef130) # [text_index_{insert_wordstart}](https://core.tcl-lang.org/tk/tktview/57b821d2db) if {$s % 2} return set pos [$txt index "insert wordend"] lassign [split $pos .] -> col set linestart [expr {int([$txt index insert])}] set lineend [expr {int([$txt index end])}] while {$linestart <= $lineend} { set line [$txt get $linestart.0 $linestart.end] if {int($pos)>$linestart} { set col [string length $line] } set res [regexp -indices -start $col -inline "\\w{1}" $line] if {[llength $res]} { ::tk::TextSetCursor $txt $linestart.[lindex $res 0 0] break } set pos [incr linestart].[set col 0] } return -code break }
Dispatches macro actions.
| what to do; optional, default "" |
proc ::alited::edit::DispatchMacro {{mode {}}} { # Dispatches macro actions. # mode - what to do namespace upvar ::alited al al variable macrosmode MacroInit if {$mode ne {}} {set macrosmode $mode} switch -glob $macrosmode { "item*" {InputMacro [string range $macrosmode 4 end]} "record" { set fname [MacroFileName $al(activemacro)] if {![info exists al(macrocomment)]} {ReadMacroComment $fname} ;# get the comment ::playtkl::end $al(macrocomment) set macrosmode {} } "quickrec" { set al(activemacro) $al(MC,quickmacro) set al(macromouse) no DoMacro record $al(MC,quickmacro) } "init" { # the very first call of DispatchMacro: activate an old active macro MacroMenu $al(activemacro) yes DoMacro play $al(activemacro) set macrosmode {} after idle {set alited::edit::macrosmode play} } "play" { DoMacro play set macrosmode {} after idle {set alited::edit::macrosmode play} } } }
Plays or records a macro.
| play / record |
| name of recorded file; optional, default "" |
proc ::alited::edit::DoMacro {mode {fname {}}} { # Plays or records a macro. # mode - play / record # fname - name of recorded file namespace upvar ::alited al al variable macrosmode MacroInit if {$macrosmode eq "record"} { ;# repeated recording? ::playtkl::end WatchMacro return no } set name [file rootname [file tail $fname]] if {$fname ne {}} { set fname [MacroFileName $fname] if {$mode eq "play"} { if {[MacroExists $fname]} { # play the macro after a pause to dismiss intervening events after 50 [list after idle [list after 50 [list after idle alited::edit::DoMacro $mode]]] } return no } } set wtxt [alited::main::CurrentWTXT] after idle "focus $wtxt" set macrosmode $mode switch $mode { "record" { set al(activemacro) $name after 100 [list ::playtkl::record $fname $al(acc_16) $al(macromouse)] after 200 alited::edit::WatchMacro alited::Message "[msgcat::mc Recording:] $name" 5; bell bell } "play" { if {$fname ne {}} { alited::Message "[msgcat::mc Playing:] $name" 3 } else { alited::Message {} } focus $wtxt undoIn $wtxt ::playtkl::replay $fname "::apave::undoOut $wtxt" [list *frAText.text* $wtxt] yes $wtxt } } return yes }
Escapes a value's backslashes and braces.
| the value |
proc ::alited::edit::EscapeValue {value} { # Escapes a value's backslashes and braces. # value - the value string map [list \\ \\\\ \} \\\} \{ \\\{] $value }
Finds color values.
| 1 for "find in all text", 2 for "find in current page", 3 "return RF" |
proc ::alited::edit::FindColorValues {mode} { # Finds color values. # mode - 1 for "find in all text", 2 for "find in current page", 3 "return RF" namespace upvar ::alited obPav obPav set RF {#([0-9a-fA-F]{3,6})} if {$mode==3} {return $RF} set RE {#([0-9a-f]{3}([^0-9a-z]|$)|[0-9a-f]{6}([^0-9a-z]|$))} set txt [alited::main::CurrentWTXT] set l1 1.0 set l2 end if {$mode in {2 12} && ![catch {set gcon [$obPav gutterContents $txt]}] && [llength $gcon]} { set l1 [string trim [lindex $gcon 0 1]].0 set l2 [string trim [lindex $gcon end 1]].end } set lenList [set hlcolors [list]] set posList [$txt search -count lenList -regexp -nocase -all -strictlimits $RE $l1 $l2] foreach pos $posList len $lenList { if {$len eq {}} { set st [$txt get $pos "$pos lineend + 1 char"] set len [lindex [regexp -nocase -indices -inline $RE $st] 1 1] } set pos2 [$txt index "$pos + $len char"] set hlc [$txt get $pos $pos2] catch { lassign [apave::InvertBg $hlc] fg bg $txt tag configure $hlc -foreground $fg -background $bg $txt tag add $hlc $pos $pos2 lappend hlcolors $hlc } } list [llength $hlcolors] $RF }
Gets formatter's file name from its full name.
| full name of formatter file |
proc ::alited::edit::FormatterName {fname} { # Gets formatter's file name from its full name. # fname - full name of formatter file file tail $fname }
proc ::alited::edit::FormatUnitDesc {} { SourceFormatTcl alited::format::UnitDesc }
Shows Play Macro help.
proc ::alited::edit::HelpOnMacro {} { # Shows Play Macro help. alited::Help $::alited::al(WIN) macro }
Unhighlights color values.
proc ::alited::edit::HideColorValues {} { # Unhighlights color values. set RF [FindColorValues 3] set txt [alited::main::CurrentWTXT] foreach hlc [$txt tag names] { if {[regexp $RF $hlc]} { $txt tag remove $hlc 1.0 end } } }
Indent selected lines of text.
proc ::alited::edit::Indent {} { # Indent selected lines of text. set indent $::apave::_AP_VARS(INDENT) set len [string length $::apave::_AP_VARS(INDENT)] set sels [SelectedLines] set wtxt [lindex $sels 0] undoIn $wtxt foreach {l1 l2} [lrange $sels 1 end] { for {set l $l1} {$l<=$l2} {incr l} { set line [$wtxt get $l.0 $l.end] if {[string trim $line] eq {}} { $wtxt replace $l.0 $l.end {} } else { set leadsp [obj leadingSpaces $line] set sp [expr {$leadsp % $len}] # align by the indent edge if {$sp==0} { set ind $indent } else { set ind [string repeat " " [expr {$len - $sp}]] } $wtxt insert $l.0 $ind } } } undoOut $wtxt alited::main::HighlightLine }
Gets parameter value from a line of ini-file.
| parameter name (can contain several names separated with comma) |
| line content |
| option "-nocase" for regexp (default) or any other option; optional, default -nocase |
| default value; optional, default "" |
proc ::alited::edit::IniParameter {parname line {case -nocase} {defval {}}} { # Gets parameter value from a line of ini-file. # parname - parameter name (can contain several names separated with comma) # line - line content # case - option "-nocase" for regexp (default) or any other option # defval - default value foreach pname [split $parname ,] { if {[regexp {*}$case "^\\s*$pname\\s*=\\s*" $line]} { set i [string first = $line] set res [string range $line [incr i] end] if {[string trim $res] eq {}} {set res -} return [string trim $res] } } return {} }
Enters/changes a macro.
| index in macro menu |
proc ::alited::edit::InputMacro {idx} { # Enters/changes a macro. # idx - index in macro menu namespace upvar ::alited al al obDl2 obDl2 variable macrosmode set win $al(WIN).macro if {[winfo exists $win]} { focusByForce [$obDl2 chooserPath Fil] return } set m $al(MENUEDIT).playtkl incr idx ;# for -tearoff menu set al(macromouse) no set al(_macro) [$m entrycget $idx -label] set al(_macroDir) {} set dir [MacroDir] ReadMacroComment $al(_macro) set head [msgcat::mc "The macro is updated at its recording.\nPress %s to play it."] set head [string map [list %s $al(acc_16)] $head] $obDl2 makeWindow $win.fra $al(MC,playtkl) $obDl2 paveWindow $win.fra { {lab - - 1 4 {-padx 4} {-t {$head}}} {Fil + T 1 4 {-pady 4 -padx 4 -st ew} "-tvar ::alited::al(_macro) -validate all -validatecommand alited::edit::ValidMacro -w 30 -initialdir {$dir} -filetypes {{{Macros} $al(macroext)} {{All files} .*}}"} {chb + T 1 4 {-st w -pady 4} {-t {Record mouse} -var ::alited::al(macromouse)}} {seh + T 1 4 {-pady 4}} {lab2 + T 1 4 {} {-t Comment:}} {fra0 + T 1 4 {-rw 1 -st nsew}} {.TexCmn L + - - {pack -side left -expand 1 -fill both -padx 3} {-h 4 -w 40 -wrap word -tabnext *.buth -rotext ::alited::al(macrocomment) -ro 0}} {.sbvText + L - - pack} {seh2 fra0 T 1 4 {-pady 4}} {fra + T 1 1 {-st w}} {.ButPlay - - 1 1 {-padx 4} {-com 1 -tip "Play Macro" -image alimg_run}} {.ButRec + L 1 1 {} {-com 2 -tip "Record Macro" -image alimg_change}} {.ButDel + L 1 1 {-padx 4} {-com 3 -tip "Delete Macro" -image alimg_delete}} {h_ fra L 1 1 {-st we -cw 1}} {buth + L 1 1 {-st e} {-t Help -com alited::edit::HelpOnMacro}} {but + L 1 1 {-st e} {-com 0 -t Cancel}} } set tex [$obDl2 TexCmn] bind $win <F1> alited::edit::HelpOnMacro set butplay [$obDl2 ButPlay] bind $win <$al(acc_16)> "if {\[$butplay cget -state\] eq {normal}} {$butplay invoke}" after 200 ::apave::MouseOnWidget $butplay set res [$obDl2 showModal $win -resizable 1 -focus $win.fra.entfil -geometry pointer+10+10] set al(macrocomment) [$tex get 1.0 end] catch {destroy $win} set name [::apave::NormalizeFileName [file root [file tail $al(_macro)]]] set fname [MacroFileName $name] if {$al(_macroDir) ni {. ""}} { # if chosen macro doesn't exist in user's dir, copy it there set fchosen [MacroFileName $name $al(_macroDir)] if {$fchosen ne $fname && ![file exists $fname]} { catch {file copy $fchosen $fname} after idle alited::menu::FillMacroItems } set fname $fchosen } unset al(_macro) unset al(_macroDir) if {!$res} { set macrosmode "init" return } if {[string length $name]>99 || $name eq {}} { alited::Msg [string map [list %n $name] $al(MC,incorrname)] err return } switch $res { 1 { MacroMenu $name no if {[DoMacro play $name]} { set macrosmode "play" } } 2 { if {[file exists $fname]} { if {![info exists al(macrotorew)] || ![string match *10 $al(macrotorew)]} { set msg [string map [list %f [file tail $fname] %d [file dirname $fname]] $al(MC,fileexist)] set dlg [::apave::APave new] set al(macrotorew) [$dlg misc warn $al(MC,playtkl) $msg {"Rewrite" File "Edit" Change "Cancel" 0} 0 -ch $al(MC,noask) -centerme $al(WIN)] $dlg destroy } switch -glob $al(macrotorew) { File* {} Change* {alited::file::OpenFile $fname yes; return} default {set al(macrotorew) {}; return} } } after idle [list alited::edit::DoMacro record $name] } 3 { if {![MacroExists $fname]} return if {![info exists al(macrotodel)] || $al(macrotodel)<10} { set msg [string map [list %f [file tail $fname]] $al(MC,delfile)] set al(macrotodel) [alited::msg yesno warn $msg NO -ch $al(MC,noask)] } if {$al(macrotodel)} { file delete $fname if {$name eq $al(activemacro)} { set al(activemacro) {} } set macrosmode "init" after idle alited::menu::FillMacroItems } } } }
Inverts cases in a string (e.g. InversE -> iNVERSe).
| the string |
proc ::alited::edit::InvertStringCase {str} { # Inverts cases in a string (e.g. InversE -> iNVERSe). # str - the string set res {} lmap ch [split $str {}] { if {[string is lower $ch]} { set ch [string toupper $ch] } else { set ch [string tolower $ch] } append res $ch } return $res }
Gets a directory name of macros.
proc ::alited::edit::MacroDir {} { # Gets a directory name of macros. return [file dirname [MacroFileName .]] }
Checks for existing macro. If the macro doesn't exist, shows a message and updates the macros list menu.
| macro file name |
proc ::alited::edit::MacroExists {fname} { # Checks for existing macro. # If the macro doesn't exist, shows a message and updates the macros list menu. # fname - macro file name if {[file exists $fname]} {return yes} alited::Balloon1 $fname after idle alited::menu::FillMacroItems return no }
Gets a file name for a macro.
| macro's name |
| macro's directory; optional, default "" |
proc ::alited::edit::MacroFileName {name {dir {}}} { # Gets a file name for a macro. # name - macro's name # dir - macro's directory namespace upvar ::alited al al USERDIR USERDIR if {[file extension $name] ne $al(macroext)} { append name $al(macroext) } if {$dir eq {}} { set dir [file join $USERDIR macro] } return [file normalize [file join $dir [file tail $name]]] }
Initializes macro stuff.
proc ::alited::edit::MacroInit {} { # Initializes macro stuff. MacroSource ::playtkl::inform no }
Recreate macros' menu.
| current macro |
| yes if update anyway |
proc ::alited::edit::MacroMenu {name doit} { # Recreate macros' menu. # name - current macro # doit - yes if update anyway namespace upvar ::alited al al MacroSource set fname [MacroFileName $name] if {$doit || $al(activemacro) ne $name} { set al(activemacro) $name playtkl::readcontents $fname alited::menu::FillMacroItems } elseif {$al(activemacro) eq $name} { playtkl::readcontents $fname } }
Loads playtkl package.
proc ::alited::edit::MacroSource {} { # Loads playtkl package. if {[info command ::playtkl::play] eq {}} { namespace eval :: { source [file join $::alited::LIBDIR playtkl playtkl.tcl] } } }
If a file is a macro, updates macros' list.
| file name |
proc ::alited::edit::MacroUpdate {fname} { # If a file is a macro, updates macros' list. # fname - file name namespace upvar ::alited al al if {[file extension $fname] eq $al(macroext)} { after idle [list alited::edit::MacroMenu $fname yes] } }
Selects a rectangle.
| the current text's path |
| starting row |
| starting column |
| current row |
| current column |
proc ::alited::edit::makeRect {wtxt alnl alnc nl nc} { # Selects a rectangle. # wtxt - the current text's path # alnl - starting row # alnc - starting column # nl - current row # nc - current column set l1 [expr {min($alnl,$nl)}] set l2 [expr {max($alnl,$nl)}] set c1 [expr {min($alnc,$nc)}] set c2 [expr {max($alnc,$nc)}] if {$c1==$c2} {set c2 end} ;# to select "all to line ends" for {set l $l1} {$l<=$l2} {incr l} { $wtxt tag add sel $l.$c1 $l.$c2 } }
Handles a modification of file, recreating the unit tree at need.
| tab's ID |
| text's path |
| 1st line of unit; optional, default 0 |
| last line of unit; optional, default 0 |
| Optional arguments. |
proc ::alited::edit::Modified {TID wtxt {l1 0} {l2 0} args} { # Handles a modification of file, recreating the unit tree at need. # TID - tab's ID # wtxt - text's path # l1 - 1st line of unit # l2 - last line of unit namespace upvar ::alited al al obPav obPav if {[alited::bar::BAR isTab $TID]} { set old [alited::file::IsModified $TID] set new [$wtxt edit modified] if {$old != $new} { if {$new} { alited::bar::BAR markTab $TID } else { alited::bar::BAR unmarkTab $TID } CheckSaveIcons $new } CheckUndoRedoIcons $wtxt $TID if {$al(TREE,isunits)} { set pos [$wtxt index insert] set wtree [$obPav Tree] set todoTree no catch {set todoTree [$wtree tag has tagTODO [alited::tree::CurrentItem]]} # when text's TODO tag isn't equal to tree's, recreate the tree lassign [$wtxt tag nextrange tagCMN2 [$wtxt index "$pos linestart"] [$wtxt index "$pos lineend"]] p1 p2 if {$p2 ne {} && [$wtxt compare $pos >= $p1] && [$wtxt compare $pos <= $p2]} { set todo [expr {!$todoTree}] } else { set todo $todoTree } if {$todo} { alited::tree::RecreateTree } elseif {![info exists al(RECREATE)] || $al(RECREATE)} { set doit no if {[set llen [llength $al(_unittree,$TID)]]} { set lastrow [lindex $al(_unittree,$TID) $llen-1 5] set doit [expr {$lastrow != int([$wtxt index {end -1c}])}] } set l1 [expr {int($pos)}] set line [$wtxt get $l1.0 $l1.end] if {$doit || (![catch {set ifound [lsearch -index 4 $al(_unittree,$TID) $l1]}] && $ifound>-1) || [regexp [alited::unit::UnitRegexp] $line]} { alited::tree::RecreateTree } else { set REtd {(#\s*(!|TODO))|(//\s*(!|TODO))} ;# RE for todo in Tcl and C if {$al(INI,LEAF) && [regexp $al(RE,leaf) $line] || [regexp $REtd $line] || !$al(INI,LEAF) && [regexp $al(RE,proc) $line] || [regexp $al(RE,branch) $line]} { alited::tree::RecreateTree } } } } } alited::main::ShowHeader }
Normalizes a current text's indenting.
proc ::alited::edit::NormIndent {} { # Normalizes a current text's indenting. alited::main::CalcIndentation {} yes alited::main::UpdateProjectInfo if {![namespace exists ::alited::indent]} { namespace eval ::alited { source [file join $::alited::SRCDIR indent.tcl] } } alited::indent::normalize }
Opens file(s) from data/format directory or its subdirectories.
| (sub)directory name |
proc ::alited::edit::OpenFormatFile {dir} { # Opens file(s) from data/format directory or its subdirectories. # dir - (sub)directory name namespace upvar ::alited al al obPav obPav DATADIR DATADIR set ::alited::al(TMPfname) {} if {[glob -nocomplain -directory $dir *] eq {}} { set dir [file dirname $dir] } set fnames [$obPav chooser tk_getOpenFile ::alited::al(TMPfname) -initialdir $dir -parent $al(WIN) -multiple 1] unset ::alited::al(TMPfname) foreach fn [lreverse [lsort $fnames]] { alited::file::OpenFile $fn yes } }
Opens a file of macro.
proc ::alited::edit::OpenMacroFile {} { # Opens a file of macro. namespace upvar ::alited al al obDl2 obDl2 set al(TMPfname) [MacroFileName $al(MC,quickmacro)] set types [list [list {Macro Files} $al(macroext)]] set fname [$obDl2 chooser tk_getOpenFile ::alited::al(TMPfname) -initialdir [MacroDir] -filetypes $types -parent $al(WIN)] unset al(TMPfname) if {$fname ne {}} {alited::file::OpenFile $fname} }
Pastes a rectangle.
| the current text's path |
| current row |
| current column |
proc ::alited::edit::pasteRect {wtxt nl nc} { # Pastes a rectangle. # wtxt - the current text's path # nl - current row # nc - current column namespace upvar ::alited al al if {[llength $al(rectSel,text)]} { undoIn $wtxt $wtxt tag remove sel 1.0 end set sels [list] foreach line $al(rectSel,text) { if {$line ne {}} { $wtxt insert $nl.$nc $line set pos2 $nl.[expr {$nc+[string length $line]}] lappend sels $nl.$nc $pos2 if {![info exists pos1]} {set pos1 $pos2} } incr nl } catch {::tk::TextSetCursor $wtxt $pos1} catch {$wtxt tag add sel {*}$sels} undoOut $wtxt } }
Adds -accelerator to Formats menu item or returns a list of accelerators used by pluginables.
| menu path |
| item's title; optional, default "" |
| event; optional, default "" |
| Not documented; optional, default "" |
proc ::alited::edit::PluginAccelerator {mnu {itemttl {}} {ev {}} {retlist {}}} { # Adds -accelerator to Formats menu item or returns a list of # accelerators used by pluginables. # mnu - menu path # itemttl - item's title # ev - event set nitems [$mnu index end] for {set i 0} {$i<=$nitems} {incr i} { set typ [$mnu type $i] if {[catch {set ttl [$mnu entrycget $i -label]}]} {set ttl {}} switch $typ { command { if {$itemttl ne {} && $itemttl eq $ttl} { $mnu entryconfigure $i -accelerator [::apave::KeyAccelerator $ev] break ;# it's call to set an accelerator } set acc [$mnu entrycget $i -accelerator] if {$acc ne {}} { set acc [string map {+ - Ctrl Control} $acc] lappend retlist $acc } } cascade { set cascade [$mnu entrycget $i -menu] if {$cascade ne {}} { set retlist [PluginAccelerator $cascade $itemttl $ev $retlist] continue } } separator - tearoff {} } } return $retlist }
Reads macro's comment.
| the macro's file name |
proc ::alited::edit::ReadMacroComment {fname} { # Reads macro's comment. # fname - the macro's file name namespace upvar ::alited al al set fcont [readTextFile [MacroFileName $fname]] set al(macrocomment) {} foreach ln [split $fcont \n] { set ln [string trim $ln] if {[string match #* $ln]} { append al(macrocomment) [string trimleft $ln #] \n } } }
Starts, ends, does, cuts, copies and pastes a rectangular selection. mode: 0 for start/end, 1 do, 2 cut, 3 copy, 4 paste
| Not documented. |
proc ::alited::edit::RectSelection {mode} { # Starts, ends, does, cuts, copies and pastes a rectangular selection. # mode: 0 for start/end, 1 do, 2 cut, 3 copy, 4 paste namespace upvar ::alited al al if {$mode==1 && !$al(rectSel)} return set TID [alited::bar::CurrentTabID] set wtxt [alited::main::CurrentWTXT] lassign [split [$wtxt index insert] .] nl nc if {$mode==0} { if {$al(rectSel)} { set al(rectSel,TID) $TID ;# starts selecting set al(rectSel,nl) $nl set al(rectSel,nc) $nc set al(rectSel,text) [list] set mode 1 alited::Message [msgcat::mc {Move the cursor to select a rectangle.}] 3 } else { set al(rectSel,TID) {} ;# ends selecting } } switch $mode { 1 { if {$al(rectSel) && $al(rectSel,TID) eq $TID} { makeRect $wtxt $al(rectSel,nl) $al(rectSel,nc) $nl $nc } else { set al(rectSel,TID) {} ;# at switching tabs set al(rectSel) 0 } } 2 - 3 {saveRect $mode $wtxt} 4 {pasteRect $wtxt $nl $nc} } if {$al(rectSel)} {set ico none} {set ico run} $al(MENUEDIT).rectsel entryconfigure 1 -image alimg_$ico focus $wtxt }
Removes trailing spaces of lines - all of lines or a selection of lines.
| tab ID; optional, default "" |
| if yes, trimright all of text without questions; optional, default no |
| if yes, no updating GUI; optional, default no |
proc ::alited::edit::RemoveTrailWhites {{TID {}} {doit no} {skipGUI no}} { # Removes trailing spaces of lines - all of lines or a selection of lines. # TID - tab ID # doit - if yes, trimright all of text without questions # skipGUI - if yes, no updating GUI namespace upvar ::alited al al set ans 1 if {!$doit} { set TID [alited::bar::CurrentTabID] # ask about trailing all lines of a current file (with option: all of other files) set msg [msgcat::mc "Remove trailing whitespaces of all lines\nof \"%f\"?"] set msg [string map [list %f [file tail [alited::bar::FileName]]] $msg] set ans [alited::msg yesno ques $msg YES -title {Remove trailing whitespaces} -ch $al(MC,otherfiles)] if {![set doit $ans]} return } set waseditcurr no foreach tab [alited::bar::BAR listTab] { set tid [lindex $tab 0] if {$ans==11 || $tid eq $TID} { if {[set curt [expr {$tid eq [alited::bar::CurrentTabID]}]]} { set curl [expr {int([[alited::main::GetWTXT $tid ] index insert])}] } lassign [alited::main::GetText $tid no no] -> wtxt set l1 1 set l2 [expr {int([$wtxt index {end -1c}])}] set wasedit no for {set l $l1} {$l<=$l2} {incr l} { set line [$wtxt get $l.0 $l.end] if {[set trimmed [string trimright $line]] ne $line && $curt && $l!=$curl} { if {!$wasedit} {undoIn $wtxt} set wasedit yes $wtxt replace $l.0 $l.end $trimmed } } if {$wasedit} { undoOut $wtxt alited::bar::BAR markTab $tid if {$wtxt eq [alited::main::CurrentWTXT]} { set waseditcurr yes ;# update the current text's view only } } } } if {!$skipGUI} { if {$waseditcurr} { alited::main::UpdateTextGutterTreeIcons } else { alited::main::UpdateIcons } } }
The same as "string reverse", but counts escaping braces made in format::Mode2.
| the string to reverse |
proc ::alited::edit::ReverseString {str} { # The same as "string reverse", but counts escaping braces made in format::Mode2. # str - the string to reverse # See also: format::Mode2 set str [UnEscapeValue $str] set str [string reverse $str] EscapeValue $str }
Does format according to a format file.
| format file's name |
| if no, called from menu; optional, default no |
proc ::alited::edit::RunFormat {fname {forbind no}} { # Does format according to a format file. # fname - format file's name # forbind - if no, called from menu namespace upvar ::alited al al SourceFormatTcl set initfile [file join [file dirname $fname] init.tcl] if {[file exists $initfile]} {catch {source $initfile}} set fcont [split [readTextFile $fname] \n] set fform [FormatterName $fname] unset -nocomplain al(FORMATS,$fform) set mode 0 set cont [list] set backslashed {} foreach line $fcont { set line [string trimright $line] if {[string index $line end] eq "\\"} { append backslashed { } [string trimright $line \\] continue } elseif {$backslashed ne {}} { set line "$backslashed $line" set backslashed {} } lappend cont $line } foreach line $cont { incr iline set mode [IniParameter mode $line] if {$mode in {1 2 3 4 5 6}} { set ev [alited::format::Mode$mode [lrange $cont $iline end] $fname [alited::bar::FileName]] if {!$forbind && $mode==6 && $ev ne {}} { set ev [string trim $ev <>] set mitem [alited::menu::FormatsItemName $fform] set msg [msgcat::mc {Use %e to run "%m"}] set msg [string map [list %e $ev %m $mitem] $msg] alited::Message $msg 3 alited::ini::SaveIni } break } } }
Cuts & copies a rectangle.
| 2 cut, 3 copy |
| the current text's path |
proc ::alited::edit::saveRect {mode wtxt} { # Cuts & copies a rectangle. # mode - 2 cut, 3 copy # wtxt - the current text's path namespace upvar ::alited al al set selection [$wtxt tag ranges sel] if {[llength $selection]} { undoIn $wtxt set ln1 999999999 set al(rectSel,text) [list] foreach {from to} $selection { set ln2 [::apave::pint $from] while {[incr ln1]<$ln2} { ;# empty intermediate lines lappend al(rectSel,text) {} ;# to be included too } lappend al(rectSel,text) [$wtxt get $from $to] if {$mode==2} {$wtxt delete $from $to} set ln1 [::apave::pint $to] } if {$mode==2} { catch {::tk::TextSetCursor $wtxt [lindex $selection 0 0]} } undoOut $wtxt } set al(rectSel) 0 }
Gets a range of lines of text that are selected at least partly.
| text's path; optional, default "" |
| if yes, only a real selection is counted; optional, default no |
Returns a list of the text widget's path and ranges of selected lines.
proc ::alited::edit::SelectedLines {{wtxt {}} {strict no}} { # Gets a range of lines of text that are selected at least partly. # wtxt - text's path # strict - if yes, only a real selection is counted # Returns a list of the text widget's path and ranges of selected lines. if {$wtxt eq {}} {set wtxt [alited::main::CurrentWTXT]} set res [list $wtxt] if {[catch {$wtxt tag ranges sel} sels] || ![llength $sels]} { if {$strict} { set sels [list] } else { set pos1 [set pos2 [$wtxt index insert]] set sels [list $pos1 $pos2] } } foreach {pos1 pos2} $sels { if {$pos1 ne {}} { set pos21 [$wtxt index "$pos2 linestart"] if {[$wtxt get $pos21 $pos2] eq {}} { set pos2 [$wtxt index "$pos2 - 1 line"] } } set l1 [expr {int($pos1)}] set l2 [expr {max($l1,int($pos2))}] lappend res $l1 $l2 } return $res }
Selects lines (all their contents) of text.
| text's path |
| starting line |
| ending line |
proc ::alited::edit::SelectLines {wtxt l1 l2} { # Selects lines (all their contents) of text. # wtxt - text's path # l1 - starting line # l2 - ending line $wtxt tag remove sel 1.0 end $wtxt tag add sel $l1.0 [incr l2].0 ;# $l1.0 $l2.end }
Highlights color values.
proc ::alited::edit::ShowColorValues {} { # Highlights color values. namespace upvar ::alited al al obFND obFND variable hlcolors variable ans_hlcolors if {$ans_hlcolors<10} { set ans_hlcolors [alited::msg yesnocancel ques [msgcat::mc {Display colors in the whole text?}] YES -title $al(MC,hlcolors) -ch $al(MC,noask)] } if {!$ans_hlcolors} return HideColorValues lassign [FindColorValues $ans_hlcolors] llen RF if {[winfo exists $::alited::find::win] && [winfo ismapped $::alited::find::win]} { set ::alited::find::data(en1) $RF ;# if "Find/Replace" is shown, set Find = RE [$obFND Cbx1] selection clear set msg " ([msgcat::mc {check RE in Find/Replace box}])" set mode 3 } else { set msg {} set mode 1 } alited::Message $al(MC,hlcolors):\ $llen\ $msg $mode }
Sources format.tcl.
proc ::alited::edit::SourceFormatTcl {} { # Sources format.tcl. if {![namespace exists ::alited::format]} { namespace eval ::alited { source [file join $::alited::SRCDIR format.tcl] } } }
Squeezes a list of lines.
| the list |
proc ::alited::edit::SqueezeLines {strlist} { # Squeezes a list of lines. # strlist - the list set res [list] foreach str $strlist {lappend res [SqueezeString $str]} return $res }
Squeezes multiple spaces to one space (except for leading spaces) and removes tailing spaces, e.g. " a b c " => " a b c".
| the string |
proc ::alited::edit::SqueezeString {str} { # Squeezes multiple spaces to one space (except for leading spaces) # and removes tailing spaces, e.g. " a b c " => " a b c". # str - the string set isp [obj leadingSpaces $str] set substring [string range $str $isp end] set splist [regexp -inline -all {[ ]+} $substring] set splist [lsort -decreasing -command alited::edit::CompareByLength $splist] foreach sp $splist { set substring [string map [list $sp { }] $substring] } set res [string repeat { } $isp] append res [string trimright $substring] }
Uncomments selected lines of text.
proc ::alited::edit::UnComment {} { # Uncomments selected lines of text. # See also: Comment namespace upvar ::alited obPav obPav al al set ch [CommentChar] set lch [string length $ch] set lch0 [expr {$lch-1}] set sels [SelectedLines] set wtxt [lindex $sels 0] undoIn $wtxt foreach {l1 l2} [lrange $sels 1 end] { for {set l $l1} {$l<=$l2} {incr l} { set line [$wtxt get $l.0 $l.end] set isp [$obPav leadingSpaces $line] if {[string range $line $isp $isp+$lch0] eq $ch} { set lch2 $lch if {[regexp "^\\s*$ch!" $line]} {incr lch2} ;# remove TODO comment $wtxt delete $l.$isp "$l.$isp + ${lch2}c" if {$ch eq "#" && !$al(commentmode)} { # for Tcl code: it needs to enable also all braces with #\{ #\} patterns set line [$wtxt get $l.0 $l.end] $wtxt replace $l.0 $l.end [string map [list #\\\} \} #\\\{ \{] $line] } } } } undoOut $wtxt SelectLines $wtxt $l1 $l2 after idle alited::tree::RecreateTree }
Unescapes a value's backslashes and braces.
| the value |
proc ::alited::edit::UnEscapeValue {value} { # Unescapes a value's backslashes and braces. # value - the value string map [list \\\\ \\ \\\} \} \\\{ \{] $value }
Unindent selected lines of text.
proc ::alited::edit::UnIndent {} { # Unindent selected lines of text. set len [string length $::apave::_AP_VARS(INDENT)] set spaces [list { } \t] set sels [SelectedLines] set wtxt [lindex $sels 0] undoIn $wtxt foreach {l1 l2} [lrange $sels 1 end] { for {set l $l1} {$l<=$l2} {incr l} { set line [$wtxt get $l.0 $l.end] if {[string trim $line] eq {}} { $wtxt replace $l.0 $l.end {} } elseif {[string index $line 0] in $spaces} { set leadsp [obj leadingSpaces $line] # align by the indent edge set sp [expr {$leadsp % $len}] if {$sp==0} {set sp $len} $wtxt delete $l.0 "$l.0 + ${sp}c" } } } undoOut $wtxt }
Validates the macro name.
proc ::alited::edit::ValidMacro {} { # Validates the macro name. after idle alited::edit::ValidMacroReal return yes }
Gets "root tail" of the file name and saves its directory name. Changes the record icon depending on the macro file exists or not.
proc ::alited::edit::ValidMacroReal {} { # Gets "root tail" of the file name and saves its directory name. # Changes the record icon depending on the macro file exists or not. namespace upvar ::alited al al obDl2 obDl2 set tmpdir [file dirname $al(_macro)] if {$tmpdir ni {. ""}} {set al(_macroDir) $tmpdir} set al(_macro) [file rootname [file tail $al(_macro)]] if {[file exists [MacroFileName [string trim $al(_macro)]]]} { set icon change set mstate normal } else { set icon add set mstate disabled } set icon alimg_$icon set but [$obDl2 ButRec] if {[$but cget -image] ne $icon} {::apave::blinkWidgetImage $but $icon} [$obDl2 ButPlay] configure -state $mstate [$obDl2 ButDel] configure -state $mstate }
Watch the end of recording.
proc ::alited::edit::WatchMacro {} { # Watch the end of recording. namespace upvar ::alited al al variable macrosmode if {[::playtkl::isend]} { alited::Message {Recording: done} 5; bell MacroMenu $al(activemacro) yes set macrosmode "play" bell } else { after 200 alited::edit::WatchMacro } }
Initializes and shows favorite / last visited units' view.
proc ::alited::favor::_init {} { # Initializes and shows favorite / last visited units' view. namespace upvar ::alited al al obPav obPav set wtree [$obPav TreeFavor] alited::tree::AddTags $wtree $wtree tag bind tagNorm <Return> {::alited::favor::Select} $wtree tag bind tagNorm <ButtonRelease-1> {::alited::favor::Select} $wtree tag bind tagNorm <ButtonPress-3> {after idle {alited::favor::PopupMenu %x %y %X %Y}} $wtree heading #1 -text [msgcat::mc $al(MC,favorites)] ShowFavVisit }
Adds a unit to favorites.
| if yes, run by mouse click; optional, default yes |
| list of unit's ID and names to add; optional, default "" |
proc ::alited::favor::Add {{undermouse yes} {idnames {}}} { # Adds a unit to favorites. # undermouse - if yes, run by mouse click # idnames - list of unit's ID and names to add namespace upvar ::alited al al obPav obPav set fname [alited::bar::FileName] set sname [file tail $fname] if {[set idnlen [llength $idnames]]>2} { set geo {} ;# for a list (of popup menu: id1 name1 id2 name2...) - no 'under mouse' } else { set geo [GeoForQuery $undermouse] } if {$idnlen==0} { lassign [CurrentName] itemID name l1 l2 if {$name eq {}} return set idnames [list $itemID $name] } if {![info exists al(ANSWER,favor::Add)]} { set al(ANSWER,favor::Add) 0 } foreach {itemID name} $idnames { set err no foreach it [alited::tree::GetTree {} TreeFavor] { lassign [lindex $it 4] name2 fname2 if {$name eq $name2 && $fname eq $fname2} { set msg [string map [list %n $name %f $sname] $al(MC,addexist)] alited::Message $msg 4 set err yes break } } if {$err} continue set msg [string map [list %n $name %f $sname] $al(MC,addfavor)] if {$al(ANSWER,favor::Add)==11 || [set al(ANSWER,favor::Add) [alited::msg yesnocancel ques $msg YES -ch $al(MC,noask) {*}$geo]] in {1 11}} { set wtree [$obPav Tree] set header [alited::unit::GetHeader [$obPav Tree] $itemID] if {$idnlen==0} { set pos [[alited::main::CurrentWTXT] index insert] set line [expr {($l1 eq {} || $l2 eq {} || $l1>$pos || $l2<$pos) ? 0 : [::apave::p+ $pos -$l1]}] } else { set line 0 ;# favorites added from the tree } set wt2 [$obPav TreeFavor] set ID2 [$wt2 insert {} 0 -values [list $name $fname $header $line]] $wt2 tag add tagNorm $ID2 } if {!$al(ANSWER,favor::Add)} break } }
Adds a list of selected items of the tree to Favorites.
proc ::alited::favor::AddFromTree {} { # Adds a list of selected items of the tree to Favorites. namespace upvar ::alited al al obPav obPav set wtree [$obPav Tree] set IDs [$wtree selection] if {$IDs eq {}} {bell; return} foreach ID $IDs { lappend idnames $ID [string trim [$wtree item $ID -text]] } Add no $idnames }
Copies a current unit's declaration to the clipboard.
| tree widget's path |
| tree item's ID |
proc ::alited::favor::CopyDeclaration {wtree ID} { # Copies a current unit's declaration to the clipboard. # wtree - tree widget's path # ID - tree item's ID clipboard clear clipboard append [lindex [$wtree item $ID -values] 2] }
Gets ID of a currently selected favorite.
| if yes, run by mouse click |
Returns favorite's ID & name & file name & tree list & header or {} if a favorite not selected.
proc ::alited::favor::CurrentID {undermouse} { # Gets ID of a currently selected favorite. # undermouse - if yes, run by mouse click # Returns favorite's ID & name & file name & tree list & header or {} if a favorite not selected. set favID [set fname {}] set treelist [alited::tree::GetTree {} TreeFavor] if {$undermouse} { set name [lindex [CurrentName yes] 1] foreach it $treelist { lassign $it - - ID2 - values lassign $values name2 fname header if {$name2 eq $name} { set favID $ID2 break } } } if {$favID eq {}} { if {![IsSelected favID name2 fname sname header line]} { lassign [lindex $treelist 0] - - favID - values lassign $values name2 fname header if {$favID eq {}} {return {}} } } list $favID $name2 $fname $treelist $header }
Gets data of a current favorite.
| if yes, bells at empty unit tree; optional, default no |
Returns a list of the favorite's data: ID, title, 1st line, last line.
proc ::alited::favor::CurrentName {{dobell no}} { # Gets data of a current favorite. # dobell - if yes, bells at empty unit tree # Returns a list of the favorite's data: ID, title, 1st line, last line. lassign [alited::tree::CurrentItemByLine {} 1] itemID - - - name l1 l2 set name [string trim $name] if {$name eq {} && $dobell} bell list $itemID $name $l1 $l2 }
Deletes an item from favorites.
| if yes, run by mouse click; optional, default yes |
proc ::alited::favor::Delete {{undermouse yes}} { # Deletes an item from favorites. # undermouse - if yes, run by mouse click namespace upvar ::alited al al obPav obPav lassign [CurrentID $undermouse] favID name fname if {$favID eq {} || ![info exists fname] || $fname eq {}} { bell return ;# for empty list } set sname [file tail $fname] if {$favID eq {}} { set msg [string map [list %n $name %f $sname] $al(MC,notfavor)] alited::Message $msg 4 return } set msg [string map [list %n $name %f $sname] $al(MC,delfavor)] set geo [GeoForQuery $undermouse] if {!$al(FAV,IsFavor) || [alited::msg yesno warn $msg YES {*}$geo]} { DeleteLastVisited $favID } }
Deletes all items from favorites.
| if yes, run by mouse click; optional, default yes |
proc ::alited::favor::DeleteAll {{undermouse yes}} { # Deletes all items from favorites. # undermouse - if yes, run by mouse click namespace upvar ::alited al al obPav obPav set geo [GeoForQuery $undermouse] if {$al(FAV,IsFavor)} { set msg {Delete all of Favorites?} set listvar al(FAV,current) } else { set msg {Delete all of the last visited?} set listvar al(FAV,visited) } set favlist [alited::tree::GetTree {} TreeFavor] if {$favlist eq {}} {bell; return} if {[alited::msg yesno warn [msgcat::mc $msg] YES {*}$geo -title $al(MC,favordelall)]} { foreach curfav $favlist { [$obPav TreeFavor] delete [lindex $curfav 2] } set $listvar [list] } }
Deletes last visited item.
| ID of the item |
proc ::alited::favor::DeleteLastVisited {id} { # Deletes last visited item. # id - ID of the item namespace upvar ::alited al al obPav obPav if {!$al(FAV,IsFavor)} { catch { set treelist [alited::tree::GetTree {} TreeFavor] set i [lsearch -exact -index 2 $treelist $id] set al(FAV,visited) [lreplace $al(FAV,visited) $i $i] } } [$obPav TreeFavor] delete $id }
Gets geometry for a query.
| if yes, run by mouse click |
proc ::alited::favor::GeoForQuery {undermouse} { # Gets geometry for a query. # undermouse - if yes, run by mouse click if {$undermouse} {set y -100} {set y -150} ;# y is a shift for Y axis return "-geometry pointer+10+$y" }
Gets a tip of favorite / last visited unit's declaration.
| ID of treeview item |
proc ::alited::favor::GetTooltip {ID} { # Gets a tip of favorite / last visited unit's declaration. # ID - ID of treeview item namespace upvar ::alited al al obPav obPav if {!$al(TIPS,TreeFavor) && $al(FAV,IsFavor) || ![::alited::IsTipable]} { # no tips while switched off return {} } set wtree [$obPav TreeFavor] set decl [lindex [$wtree item $ID -values] 2] set fname [lindex [$wtree item $ID -values] 1] append tip $decl \n $fname return $tip }
Enters a unit.
| tab's ID |
| name of the unit |
| header of the unit |
| yes, if Favorites list is clicked and must be updated; optional, default no |
| item selected in Favorites (for forfavor=yes); optional, default "" |
| values of item selected in Favorites (for forfavor=yes); optional, default "" |
Returns yes, if the unit is open successfully.
proc ::alited::favor::GoToUnit {TID name header {forfavor no} {it1 {}} {values {}}} { # Enters a unit. # TID - tab's ID # name - name of the unit # header - header of the unit # forfavor - yes, if Favorites list is clicked and must be updated # it1 - item selected in Favorites (for forfavor=yes) # values - values of item selected in Favorites (for forfavor=yes) # Returns yes, if the unit is open successfully. # See also: tree::SaveCursorPos namespace upvar ::alited al al obPav obPav if {[catch {lassign $header - nameorig}]} {set nameorig $header} foreach it $al(_unittree,$TID) { set treeID [alited::tree::NewItemID [incr iit]] lassign $it lev leaf fl1 title l1 l2 set name2 [alited::tree::UnitTitle $title $l1 $l2] if {$nameorig eq $name2 || $name eq $name2} { if {$forfavor} { set wtree [$obPav TreeFavor] $wtree delete $it1 set favID [$wtree insert {} 0 -values $values] $wtree tag add tagNorm $favID } if {[regexp $al(RE,proc) $header]} {set name $nameorig} LastVisited [list -text $name] $header set pos [lindex $it 7] ;# saved cursor position if {$pos ne {}} {set pos "$pos yes"} after idle "alited::tree::NewSelection $treeID $pos; alited::main::HighlightLine" return yes } } return no }
Initializes favorites list for possible "Back" of "Favorites' Lists".
| initial list of project's favorites |
proc ::alited::favor::InitFavorites {favs} { # Initializes favorites list for possible "Back" of "Favorites' Lists". # favs - initial list of project's favorites # See also: ini::ReadIniPrj variable initialFavs set initialFavs $favs }
Checks if the selected favorites list is a list of file names
| content of the list |
proc ::alited::favor::IsFavoritesFiles {cont} { # Checks if the selected favorites list is a list of file names # cont - content of the list expr {[lindex $cont 0 0] eq {FILE}} }
Gets data of currently selected item of favorites.
| variable name of item's ID |
| variable name of item's name |
| variable name of item's file name |
| variable name of item's tail file name |
| variable name of item's header |
| variable name of item's 1st line |
proc ::alited::favor::IsSelected {IDN nameN fnameN snameN headerN lineN} { # Gets data of currently selected item of favorites. # IDN - variable name of item's ID # nameN - variable name of item's name # fnameN - variable name of item's file name # snameN - variable name of item's tail file name # headerN - variable name of item's header # lineN - variable name of item's 1st line namespace upvar ::alited al al obPav obPav upvar 1 $IDN ID $nameN name $fnameN fname $snameN sname $headerN header $lineN line if {[set ID [alited::tree::CurrentItem TreeFavor]] eq {}} {return no} set wtree [$obPav TreeFavor] lassign [$wtree item $ID -values] name fname header line set sname [file tail $fname] return yes }
Puts an item to "Last visited" list.
| list of tree's item data (first two: -text {label}) |
| header of item |
| starting line of a last visited unit, if any; optional, default -1 |
proc ::alited::favor::LastVisited {item header {l1 -1}} { # Puts an item to "Last visited" list. # item - list of tree's item data (first two: -text {label}) # header - header of item # l1 - starting line of a last visited unit, if any namespace upvar ::alited al al obPav obPav if {[SkipVisited]} { # avoid a false run at switching to a file from infobar/favorites SkipVisited no return } # check for "All of..." - don't save it set allof [string range $al(MC,alloffile) 0 [string first \" $al(MC,alloffile)]] if {[string first $allof $header]==0} return # check for "Lines..." - don't save it if {[regexp "^$al(MC,lines) \\d+-\\d+\$" $header]} return # check for an empty item - don't save it set name [string trim [lindex $item 1]] if {[string trim $name] eq {} || [string range $name end-1 end] eq {::}} { return } # checks done, save this last visit set fname [alited::bar::FileName] set lvisit [list $name $fname $header] if {$lvisit eq [lindex $al(FAV,visited) 0 4]} { return ;# already 1st: no need to put it } # search an old item set found no set i 0 set ln "[expr {int([[alited::main::CurrentWTXT] index insert])}]" foreach it $al(FAV,visited) { lassign $it - - ID - values lassign $values name2 fname2 header2 if {$fname eq $fname2 && $header eq $header2} { if {!$i} return ;# already 1st: no need to put it set found yes # if found, move it to 0th position set al(FAV,visited) [lreplace $al(FAV,visited) $i $i] break } incr i } if {!$found && $ln eq $l1} { # already 1st in last visits, maybe with a changed name set al(FAV,visited) [lreplace $al(FAV,visited) 0 0] } set al(FAV,visited) [linsert $al(FAV,visited) 0 [list - - - - $lvisit]] # delete last items if the list's limit is exceeded catch {set al(FAV,visited) [lreplace $al(FAV,visited) $al(FAV,MAXLAST) end]} # update the tree widget if {!$al(FAV,IsFavor)} { SetFavorites $al(FAV,visited) set wtree [$obPav TreeFavor] if {[set id0 [lindex [$wtree children {}] 0]] ne {}} { $wtree see $id0 } } }
Runs "Lists of Favorites" dialogue, sets a list of favorites at a choice.
proc ::alited::favor::Lists {} { # Runs "Lists of Favorites" dialogue, sets a list of favorites at a choice. namespace upvar ::alited al al variable initialFavs if {![llength $initialFavs]} { set initialFavs [alited::tree::GetTree {} TreeFavor] } lassign [::alited::favor_ls::_run] pla cont switch $pla { 1 {SetFavorites $cont} 2 {SetAndClose $cont} 3 {SetFavorites $initialFavs} 5 - 6 {OpenFiles $pla $cont} } }
Opens files with current favorites.
| if 5, current files remain; if 6, current files close |
| list of favorites |
proc ::alited::favor::OpenFiles {pla cont} { # Opens files with current favorites. # pla - if 5, current files remain; if 6, current files close # cont - list of favorites variable ansOpenFiles set fnames [list] foreach fname $cont { if {$fname ne {}} {lappend fnames $fname} } if {[set llen [llength $fnames]]} { if {$ansOpenFiles<10} { set msg [msgcat::mc {Number of files to open: %n}] set msg [string map [list %n $llen] $msg] set ansOpenFiles [alited::msg okcancel warn $msg OK -ch $::alited::al(MC,noask)] } if {$ansOpenFiles} { # try to show them all on the 1st page of tabbar if {$pla==6} {alited::file::CloseAll 1} foreach fname [lreverse $fnames] { if {[set TID [alited::file::OpenFile $fname]] ne {}} { alited::bar::BAR moveTab $TID 0 } } alited::bar::BAR update } } }
Opens a file from a selected item of favorites/last visited.
| file name |
Returns tab's ID, if the file is open successfully.
proc ::alited::favor::OpenSelectedFile {fname} { # Opens a file from a selected item of favorites/last visited. # fname - file name # Returns tab's ID, if the file is open successfully. namespace upvar ::alited al al set al(dolastvisited) no set TID [alited::file::OpenFile $fname yes] set al(dolastvisited) yes if {$TID eq {}} {alited::Balloon1 $fname} return $TID }
Prepares and runs a popup menu at clicking Favorites / last visited list.
| x-coordinate to identify tree item |
| y-coordinate to identify tree item |
| x-coordinate of the mouse pointer |
| y-coordinate of the mouse pointer |
proc ::alited::favor::PopupMenu {x y X Y} { # Prepares and runs a popup menu at clicking Favorites / last visited list. # x - x-coordinate to identify tree item # y - y-coordinate to identify tree item # X - x-coordinate of the mouse pointer # Y - y-coordinate of the mouse pointer namespace upvar ::alited al al obPav obPav set wtree [$obPav TreeFavor] set ID [$wtree identify item $x $y] if {![$wtree exists $ID]} return if {[set sel [$wtree selection]] ne {}} { $wtree selection remove $sel } $wtree selection add $ID ShowPopupMenu $ID $X $Y }
Renames a current favorite.
| if yes, run by mouse click; optional, default yes |
proc ::alited::favor::Rename {{undermouse yes}} { # Renames a current favorite. # undermouse - if yes, run by mouse click namespace upvar ::alited al al obPav obPav obDl2 obDl2 lassign [CurrentID $undermouse] favID name - - header if {$favID eq {}} { bell return ;# for empty list } if {![regexp $al(RE,proc) $header]} { alited::Message [msgcat::mc {For leaf units only!}] 4 return } set geo [GeoForQuery $undermouse] lassign [$obDl2 input {} $al(MC,favorren) [list ent "{} {} {-w 32}" "{$name}"] -head [msgcat::mc {Favorite name:}] {*}$geo] res name2 set name2 [string trim $name2] if {$res && $name2 ne {} && $name2 ne $name} { set wtree [$obPav TreeFavor] set values [$wtree item $favID -values] set values [lreplace $values 0 0 $name2] $wtree item $favID -values $values after 200 alited::main::FocusText } }
Handles selecting an item of "Favorites / Last visited" treeview.
proc ::alited::favor::Select {} { # Handles selecting an item of "Favorites / Last visited" treeview. namespace upvar ::alited al al obPav obPav set msec [clock milliseconds] if {[info exists al(_MSEC)] && [expr {($msec-$al(_MSEC))<800}]} { return ;# disables double click } set al(_MSEC) $msec set wtree [$obPav TreeFavor] if {![IsSelected favID name fname sname header line]} { return } set values [$wtree item $favID -values] if {[set TID [OpenSelectedFile $fname]] eq {}} { DeleteLastVisited $favID return } # scan Favorites/last-visited tree, to find the selected item # and remake favorites and last visits; then go to the selected unit foreach it1 [$wtree children {}] { lassign [$wtree item $it1 -values] name2 - header2 if {$header eq $header2} { if {[GoToUnit $TID $name2 $header2 $al(FAV,IsFavor) $it1 $values]} return break } } foreach it1 [$wtree children {}] { lassign [$wtree item $it1 -values] name2 - header2 if {$name eq $name2} { if {[GoToUnit $TID $name2 $header2 $al(FAV,IsFavor) $it1 $values]} return DeleteLastVisited $it1 break } } set msg [string map [list %u $name] $al(MC,notfndunit)] alited::Message $msg 3 alited::main::FocusText }
Sets favorites list, opens files from favorites list, closes other files.
| list of favorites |
proc ::alited::favor::SetAndClose {cont} { # Sets favorites list, opens files from favorites list, closes other files. # cont - list of favorites SetFavorites $cont set fnamecont {} set fnamecurr [alited::bar::FileName] set iscurr yes foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] set fname [alited::bar::FileName $TID] set found no foreach fit $cont { set fnamecont [lindex $fit 4 1] if {$fname eq $fnamecont} { set found yes break } } if {!$found} { if {![alited::file::CloseFile $TID no]} break alited::bar::BAR $TID close no if {$fname eq $fnamecurr} {set iscurr no} } } if {![llength [alited::bar::BAR listTab]]} { # no tabs open if {$fnamecont ne {}} { alited::file::OpenFile $fnamecont yes ;# open a file from favorites } else { alited::file::CheckForNew ;# ... or create "no name" tab } } alited::bar::BAR update if {!$iscurr} { # if a current file was closed, open 1st of the open catch {alited::bar::BAR [lindex [alited::bar::BAR listTab] 0 0] show} } }
Sets favorites/last visited list in the treeview.
| list of favorites/last visited |
proc ::alited::favor::SetFavorites {cont} { # Sets favorites/last visited list in the treeview. # cont - list of favorites/last visited namespace upvar ::alited al al obPav obPav set wtree [$obPav TreeFavor] foreach it [alited::tree::GetTree {} TreeFavor] { $wtree delete [lindex $it 2] } foreach curfav $cont { catch { lassign $curfav - - - - values if {$values ne {}} { set itemID [$wtree insert {} end -values $values] $wtree tag add tagNorm $itemID } } } }
Shows a list of favorites / last visited units.
proc ::alited::favor::Show {} { # Shows a list of favorites / last visited units. namespace upvar ::alited al al obPav obPav set wtree [$obPav TreeFavor] if {$al(FAV,IsFavor)} { pack [$obPav BtTAddF] -side left -after [$obPav SevF] pack [$obPav BtTRenF] -side left -after [$obPav BtTAddF] [$obPav BtTVisitF] configure -image alimg_misc set tip $::alited::al(MC,lastvisit) set state normal SetFavorites $al(FAV,current) $wtree heading #1 -text [msgcat::mc $al(MC,favorites)] } else { pack forget [$obPav BtTAddF] pack forget [$obPav BtTRenF] set al(FAV,current) [list] foreach it [alited::tree::GetTree {} TreeFavor] { lappend al(FAV,current) $it } [$obPav BtTVisitF] configure -image alimg_heart set tip $al(MC,favorites) set state disable SetFavorites $al(FAV,visited) $wtree heading #1 -text [msgcat::mc $al(MC,lastvisit)] } baltip::tip [$obPav BtTVisitF] $tip }
Show favorites/last visits, depending on the mode.
proc ::alited::favor::ShowFavVisit {} { # Show favorites/last visits, depending on the mode. namespace upvar ::alited al al SetFavorites $al(FAV,current) if {!$al(FAV,IsFavor)} Show }
Displays a popup menu at clicking Favorites / last visited list.
| tree item's ID |
| x-coordinate of the mouse pointer |
| y-coordinate of the mouse pointer |
proc ::alited::favor::ShowPopupMenu {ID X Y} { # Displays a popup menu at clicking Favorites / last visited list. # ID - tree item's ID # X - x-coordinate of the mouse pointer # Y - y-coordinate of the mouse pointer namespace upvar ::alited al al obPav obPav ::baltip sleep 1000 set wtree [$obPav TreeFavor] set popm $wtree.popup catch {destroy $popm} menu $popm -tearoff 0 set sname [lindex [$wtree item $ID -values] 0] if {[string length $sname]>25} {set sname "[string range $sname 0 21]..."} set msgsel [string map [list %t $sname] $al(MC,selfavor)] if {$al(FAV,IsFavor)} { set img alimg_misc set lab $al(MC,lastvisit) } else { set img alimg_heart set lab $al(MC,favorites) } $popm add command -label $lab {*}[$obPav iconA none] -command alited::favor::SwitchFavVisit -image $img $popm add separator if {$al(FAV,IsFavor)} { $popm add command -label $al(MC,FavLists) {*}[$obPav iconA none] -command ::alited::favor::Lists -image alimg_SaveFile $popm add separator $popm add command -label $al(MC,favoradd) {*}[$obPav iconA none] -command ::alited::favor::Add -image alimg_add $popm add command -label $al(MC,favorren) {*}[$obPav iconA change] -command {::alited::favor::Rename no} } $popm add command -label $al(MC,favordel) {*}[$obPav iconA none] -command {::alited::favor::Delete no} -image alimg_delete $popm add command -label $al(MC,favordelall) {*}[$obPav iconA none] -command {::alited::favor::DeleteAll no} -image alimg_trash $popm add separator $popm add command -label $al(MC,copydecl) {*}[$obPav iconA none] -command "::alited::favor::CopyDeclaration $wtree $ID" $obPav themePopup $popm tk_popup $popm $X $Y }
Sets/gets a flag to skip remembering a last visit.
| Not documented; optional, default "" |
proc ::alited::favor::SkipVisited {{flag {}}} { # Sets/gets a flag to skip remembering a last visit. namespace upvar ::alited al al set fln _FLAGSKIPLV if {$flag eq {}} { return [expr {[info exists al($fln)] && $al($fln)}] } set al($fln) $flag }
Switches favorites / last visited units' view.
proc ::alited::favor::SwitchFavVisit {} { # Switches favorites / last visited units' view. namespace upvar ::alited al al set al(FAV,IsFavor) [expr {!$al(FAV,IsFavor)}] Show }
Creates "Favorites lists" dialogue.
proc ::alited::favor_ls::_create {} { # Creates "Favorites lists" dialogue. namespace upvar ::alited al al favgeometry favgeometry variable obFav variable win variable favlist variable fav set tipson [baltip::cget -on] baltip::configure -on $al(TIPS,SavedFavorites) if {$al(FAV,IsFavor)} {set forget {}} {set forget forget} ::apave::APave create $obFav $win $obFav makeWindow $win $al(MC,FavLists) $obFav paveWindow $win { {fraLbxFav - - 1 2 {-st nswe -rw 1 -pady 4} {}} {.fra - - - - {pack $forget -side right -fill both} {}} {.fra.btTAd - - - - {pack -side top -anchor n} {-com ::alited::favor_ls::Add -tip "Add a list of favorites" -image alimg_add-big}} {.fra.btTChg - - - - {pack -side top} {-com ::alited::favor_ls::Change -tip "Change a list of favorites" -image alimg_change-big}} {.fra.btTDel - - - - {pack -side top} {-com ::alited::favor_ls::Delete -tip "Delete a list of favorites" -image alimg_delete-big}} {.fra.v_ - - - - {pack -side top -expand 1 -fill y}} {.fra.btTFil - - - - {pack $forget -side top} {-com ::alited::favor_ls::AddFiles -tip "Add .tcl files of current session\nas the favorites" -image alimg_plus-big}} {.fra.btTCur - - - - {pack $forget -side top} {-com ::alited::favor_ls::DisplayFavorText -tip "$al(MC,currfavs)" -image alimg_heart-big}} {.LbxFav - - - - {pack -side left -expand 1 -fill both} {-h 10 -w 40 -lvar ::alited::favor_ls::favlist}} {.sbvFavs + L - - {pack -side left -fill y} {}} {fra1 fraLbxFav T 1 2 {-st nswe}} {.h_ - - 1 1 {pack -side top -expand 1 -fill both -pady 10}} {fra1.fraEnt - - 1 1 {pack -side top -expand 1 -fill both -pady 4}} {.labFav - - 1 1 {pack $forget -side left -padx 4} {-t "$al(MC,currfavs):"}} {.EntFav - - 1 1 {pack $forget -side left -expand 1 -fill both} {-tvar ::alited::favor_ls::fav -tip {$al(MC,favent1)}}} {fratex fra1 T 1 2 {-st nswe -rw 1 -cw 1}} {.TexFav - - - - {pack -side left -expand 1 -fill both} {-h 10 -w 72 -tip "Favorites of the current list" -ro 1 -wrap none}} {.sbvFav + L - - {pack -side left -fill y}} {fra2 fratex T 1 2 {-st nswe} {-padding {5 5 5 5} -relief groove}} {.labBA - - - - {pack $forget -side left} {-t "Non-favorite files to be:"}} {.radA - - - - {pack $forget -side left -padx 8} {-t kept -var ::alited::favor_ls::place -value 1 -tip "Doesn't close any tab without favorites\nat choosing Favorites' list"}} {.radB - - - - {pack $forget -side left -padx 8} {-t closed -var ::alited::favor_ls::place -value 2 -tip "Closes all tabs without favorites\nat choosing Favorites' list"}} {LabMess fra2 T 1 2 {-st nsew -pady 0 -padx 3} {-style TLabelFS}} {fra3 + T 1 2 {-st nswe}} {.ButHelp - - - - {pack -side left} {-t {$al(MC,help)} -tip F1 -com ::alited::favor_ls::Help}} {.h_ - - - - {pack -side left -expand 1 -fill both -padx 4}} {.ButOK - - - - {pack $forget -side left} {-t "$al(MC,select)" -com ::alited::favor_ls::Ok}} {.ButOpenFile - - - - {pack -side left -padx 2} {-t Open... -com {::alited::favor_ls::Ok 4} -tip {Opens files with current favorites.}}} {.butUndo - - - - {pack $forget -side left} {-t Back -com {::alited::favor_ls::Ok 3} -tip "Sets a list of Favorites\nthat was active initially."}} {.butCancel - - - - {pack -side left -padx 2} {-t Cancel -com ::alited::favor_ls::Cancel}} } set fav {} set lbx [$obFav LbxFav] DisplayFavorText Restore_favlist if {!$al(FAV,IsFavor)} {after idle "alited::favor_ls::Select 0 ; focus $lbx"} bind $lbx <<ListboxSelect>> ::alited::favor_ls::Select bind $lbx <FocusIn> ::alited::favor_ls::Select bind $lbx <Double-Button-1> ::alited::favor_ls::DoubleClick bind $lbx <Return> ::alited::favor_ls::DoubleClick bind $win <F1> "[$obFav ButHelp] invoke" bind [$obFav LabMess] <Button-1> alited::favor_ls::ProcMessage after 500 ::alited::favor_ls::HelpMe ;# show an introduction after a short pause set geo {-resizable 1 -minsize {600 400}} if {$favgeometry ne {}} {append geo " -geometry $favgeometry"} set res [$obFav showModal $win -onclose ::alited::favor_ls::Cancel -focus [$obFav EntFav] {*}$geo] set favgeometry [wm geometry $win] baltip::configure {*}$tipson catch {destroy $win} $obFav destroy return $res }
Runs "Favorites lists" dialogue.
proc ::alited::favor_ls::_run {} { # Runs "Favorites lists" dialogue. variable win if {[winfo exists $win]} {return 0} set res [_create] return $res }
Handles hitting "Add favorites' list" button.
proc ::alited::favor_ls::Add {} { # Handles hitting "Add favorites' list" button. namespace upvar ::alited al al variable obFav variable favlist variable favcont variable favpla variable currents variable fav variable place set cont $currents set found no set isel 0 foreach f $favlist p $favpla c $favcont { if {$fav eq $f || ($p eq $place && $c eq $cont)} { set found yes break } incr isel } set fav [string trim $fav] if {$fav ne "" && $cont ne "" && $found} { Message $al(MC,favexists) 4 Select $isel return } elseif {$fav eq ""} { focus [$obFav EntFav] Message $al(MC,favent1) 4 return } elseif {[string trim $cont] eq ""} { Message $al(MC,favent3) 4 return } else { set isel end lappend favlist $fav lappend favcont $cont lappend favpla $place set msg [string map [list %n [llength $favlist]] $al(MC,favnew)] Message $msg 3 } Save_favlist Focus $isel }
Adds .tcl files of current session as the favorites.
proc ::alited::favor_ls::AddFiles {} { # Adds .tcl files of current session as the favorites. namespace upvar ::alited al al variable currents variable place variable fav variable obFav if {$fav eq ""} { focus [$obFav EntFav] Message $al(MC,favent1) 4 return } set tsel [alited::SessionTclList 1] set tall [alited::SessionTclList 2] set isel [llength $tsel] set iall [llength $tall] set msgNoTcl {No .tcl files found in the session} if {$iall<1} { Message $msgNoTcl 4 return } set msg [msgcat::mc "\n Save as favorites list: selected (%s) or all (%a) files?\n"] set msg [string map [list %s $isel %a $iall] $msg] if {$isel>1} {set res 1} {set res 2} set res [$obFav misc ques $al(MC,question) $msg {Selected 1 {All files} 2 Cancel 0} $res] switch $res { 1 {set tabs $tsel} 2 {set tabs $tall} default {return} } # scan all .tcl to get the favorites' list from them set fnames [list] foreach tab $tabs { set TID [lindex $tab 0] set wtxt [alited::main::GetWTXT $TID] if {$wtxt eq {}} { alited::main::GetText $TID no no } set it [lindex $al(_unittree,$TID) 0] if {$it ne {}} { lappend fnames [alited::bar::FileName $TID] } } # create the sorted list of favorite files set text [set currents {}] foreach fname [lsort -dictionary $fnames] { if {$text ne {}} { append text \n append currents $::alited::EOL } append text $fname append currents [list FILE $fname] } if {$text eq {}} { Message $msgNoTcl 4 } else { DisplayText $text Add } }
Handles hitting Cancel button.
| Optional arguments. |
proc ::alited::favor_ls::Cancel {args} { # Handles hitting Cancel button. variable obFav variable win alited::CloseDlg Save_favlist $obFav res $win 0 }
Handles hitting "Change favorites' list" button.
proc ::alited::favor_ls::Change {} { # Handles hitting "Change favorites' list" button. namespace upvar ::alited al al variable favlist variable favpla variable favcont variable place variable fav variable currents if {[set isel [Selected]] eq {}} return if {[set isl1 [lsearch -exact $favlist $fav]]!=$isel && $isl1!=-1} { Message $al(MC,favexists) 4 Select $isl1 } else { set favlist [lreplace $favlist $isel $isel $fav] set favpla [lreplace $favpla $isel $isel $place] set favcont [lreplace $favcont $isel $isel $currents] set msg [string map [list %n [incr isel]] $al(MC,favupd)] Message $msg 3 Save_favlist } }
Composes a current text of favorites or files of favorites.
| "yes" to get favorites, "no" to get files of favorites |
| a list of favorites |
If args is omitted, the current favorites tree's contents will be the list.
proc ::alited::favor_ls::ComposeText {isfavor args} { # Composes a current text of favorites or files of favorites. # isfavor - "yes" to get favorites, "no" to get files of favorites # args - a list of favorites # If args is omitted, the current favorites tree's contents will be the list. variable currents set text [set currents {}] set prevnames [list] if {![llength $args]} {set args [alited::tree::GetTree {} TreeFavor]} set isfiles [alited::favor::IsFavoritesFiles $args] foreach it $args { if {$text ne {}} { append text \n append currents $::alited::EOL } if {$isfiles} { set fname [lindex $it 1] if {$fname ni $prevnames} {lappend prevnames $fname} } elseif {$isfavor} { append text [lindex $it 4 0] } else { set fname [lindex $it 4 1] if {$fname ni $prevnames} {lappend prevnames $fname} } append currents $it } if {!$isfavor || $isfiles} { foreach fname [lsort -dictionary $prevnames] { if {$text ne {}} {append text \n} append text $fname } } return $text }
Handles hitting "Delete favorites' list" button.
proc ::alited::favor_ls::Delete {} { # Handles hitting "Delete favorites' list" button. namespace upvar ::alited al al variable favlist variable favcont variable favpla if {[set isel [Selected]] eq ""} return set nsel [expr {$isel+1}] set msg [string map [list %n $nsel] $al(MC,favdelq)] if {![alited::msg yesno warn $msg NO -title $al(MC,warning)]} { return } set favlist [lreplace $favlist $isel $isel] set favcont [lreplace $favcont $isel $isel] set favpla [lreplace $favpla $isel $isel] set llen [expr {[llength $favlist]-1}] if {$isel>$llen} {set isel $llen} if {$llen>=0} {Select $isel} set msg [string map [list %n $nsel] $al(MC,favrem)] Message $msg 3 Save_favlist }
Displays text of favorites or their files.
| a list of favorites |
proc ::alited::favor_ls::DisplayFavorText {args} { # Displays text of favorites or their files. # args - a list of favorites # See also: ComposeText, DisplayText namespace upvar ::alited al al DisplayText [ComposeText $al(FAV,IsFavor) {*}$args] }
Displays text of favorites or their files.
| text's content |
proc ::alited::favor_ls::DisplayText {cont} { # Displays text of favorites or their files. # cont - text's content # See also: DisplayFavorText variable obFav set w [$obFav TexFav] $obFav readonlyWidget $w no $obFav displayText $w $cont $obFav readonlyWidget $w yes }
Handles double clicking on the list: in "Favorites" mode, invokes "Select" button, otherwise "Open...".
proc ::alited::favor_ls::DoubleClick {} { # Handles double clicking on the list: # in "Favorites" mode, invokes "Select" button, otherwise "Open...". namespace upvar ::alited al al variable obFav if {$al(FAV,IsFavor)} {set but ButOK} {set but ButOpenFile} [$obFav $but] invoke }
Focuses on an item of the list.
| the item to focus on |
proc ::alited::favor_ls::Focus {isel} { # Focuses on an item of the list. # isel - the item to focus on variable obFav set lbx [$obFav LbxFav] $lbx selection clear 0 end $lbx selection set $isel $isel $lbx see $isel }
Reads favorites' lists data, stored in the ini file.
| Not documented. |
proc ::alited::favor_ls::GetIni {lines} { # Reads favorites' lists data, stored in the ini file. variable favlist variable favlistsaved variable favcont variable favpla variable currents variable fav variable place set lines [Split $lines] if {[llength $lines]<3} { # initialize arrays set favlist [list] set favlistsaved [list] set favcont [list] set favpla [list] set currents [list] set fav {} set place 1 } elseif {[set cont [lrange $lines 2 end]] ne {}} { lappend favlist [lindex $lines 0] lappend favpla [lindex $lines 1] lappend favcont [join $cont $::alited::EOL] } Save_favlist no }
Handles hitting Help button.
| Optional arguments. |
proc ::alited::favor_ls::Help {args} { # Handles hitting Help button. variable win alited::Help $win }
'Help' for start.
| Optional arguments. |
proc ::alited::favor_ls::HelpMe {args} { # 'Help' for start. variable win alited::HelpMe $win }
Returns the ini file's name to store favorites' lists.
Returns the ini file's name to store favorites' lists.
proc ::alited::favor_ls::IniFile {} { # Returns the ini file's name to store favorites' lists. return [file join $::alited::INIDIR favor_ls.ini] }
Displays a message in statusbar of favorites dialogue.
| message |
| mode of Message; optional, default 2 |
proc ::alited::favor_ls::Message {msg {mode 2}} { # Displays a message in statusbar of favorites dialogue. # msg - message # mode - mode of Message variable obFav alited::Message $msg $mode [$obFav LabMess] }
Handles hitting OK button.
| if 0, sets the dialogue's result from a current favorites item; optional, default 0 |
proc ::alited::favor_ls::Ok {{res 0}} { # Handles hitting OK button. # res - if 0, sets the dialogue's result from a current favorites item. variable obFav variable win variable favcont variable favpla alited::CloseDlg if {!$res || $res==4} { if {[set isel [Selected]] eq {}} { focus [$obFav LbxFav] return } set cont [lindex $favcont $isel] set isfiles [alited::favor::IsFavoritesFiles [Split $cont]] if {$isfiles} {set res 4} set pla [lindex $favpla $isel] if {$res!=4} { # list of fav.units } else { # list of files of fav.units if {$::alited::al(FAV,IsFavor) && !$isfiles} { set cont [ComposeText no {*}[Split $cont]] } else { set cont [Text] } } set res [list [incr pla $res] [Split $cont]] } Save_favlist $obFav res $win $res }
Handles clicking on message label.
proc ::alited::favor_ls::ProcMessage {} { # Handles clicking on message label. variable obFav set msg [baltip cget [$obFav LabMess] -text] Message $msg 3 }
Makes favorites' lists data to store to the ini file.
proc ::alited::favor_ls::PutIni {} { # Makes favorites' lists data to store to the ini file. variable favlist variable favcont variable favpla Restore_favlist set res [list] foreach fav $favlist pla $favpla cont $favcont { set r1 $fav append r1 $::alited::EOL append r1 $pla append r1 $::alited::EOL append r1 $cont lappend res $r1 } return $res }
Restores favorites' list.
proc ::alited::favor_ls::Restore_favlist {} { # Restores favorites' list. variable favlist variable favlistsaved set favlist $favlistsaved }
Saves favorites' list.
| save templates in ini-file; optional, default yes |
proc ::alited::favor_ls::Save_favlist {{saveini yes}} { # Saves favorites' list. # saveini - save templates in ini-file variable favlist variable favlistsaved set favlistsaved $favlist if {$saveini} alited::ini::SaveIniPrj }
Handles a selection in the list of favorites' lists.
| a selected item of the list; optional, default "" |
proc ::alited::favor_ls::Select {{isel {}}} { # Handles a selection in the list of favorites' lists. # isel - a selected item of the list variable obFav variable favlist variable favcont variable favpla variable fav variable place set lbx [$obFav LbxFav] if {$isel eq {}} {set isel [$lbx curselection]} if {$isel eq {} && [llength $favlist]} {set isel 0} if {$isel ne {} && [set fav [lindex $favlist $isel]] ne {}} { set place [lindex $favpla $isel] set cont [Split [lindex $favcont $isel]] DisplayFavorText {*}$cont Focus $isel } }
Gets a selected item of favorites list.
proc ::alited::favor_ls::Selected {} { # Gets a selected item of favorites list. variable obFav if {[set isel [[$obFav LbxFav] curselection]] eq {}} { Message $::alited::al(MC,favsel) 4 } return $isel }
Splits a saved list by the list's dividers.
| Not documented. |
proc ::alited::favor_ls::Split {lines} { # Splits a saved list by the list's dividers. return [split [::alited::ProcEOL $lines in] \n] }
Gets the text widget's content.
proc ::alited::favor_ls::Text {} { # Gets the text widget's content. variable obFav return [[$obFav TexFav] get 1.0 {end -1 char}] }
Creates a file at the file tree.
| tree item's ID |
proc ::alited::file::Add {ID} { # Creates a file at the file tree. # ID - tree item's ID namespace upvar ::alited al al obPav obPav obDl2 obDl2 if {$ID eq {}} {set ID [alited::tree::CurrentItem]} set wtree [$obPav Tree] set dname [lindex [$wtree item $ID -values] 1] if {[file isdirectory $dname]} { set fname {} } else { set fname [file tail $dname] set dname [file dirname $dname] } set head [string map [list %d $dname] $al(MC,filesadd2)] while {1} { set res [$obDl2 input {} $al(MC,filesadd) [list seh {{} {-pady 10}} {} ent {{File name:} {} {-w 40}} "{$fname}" chb [list {} {-padx 5} [list -toprev 1 -t Directory]] {0} ] -head $head -family "{[obj basicTextFont]}"] lassign $res res fname isdir if {$res && $fname eq {}} bell else break } if {$res} { set fname [file join $dname $fname] if {[catch { if {$isdir} { file mkdir $fname } else { if {[file extension $fname] eq {}} {append fname .tcl} if {![file exists $fname]} {close [open $fname w]} OpenFile $fname } $wtree selection set {} alited::tree::RecreateTree $wtree - if {$isdir} { # find the created directory foreach item [alited::tree::GetTree] { lassign $item - - ID - data if {[set dname [lindex $data 1]] eq $fname} { catch {$wtree selection remove [$wtree selection]} SelectInTree $wtree $ID break } } } } err]} then { alited::msg ok err $err } if {!$isdir} {after 200 alited::main::FocusText} } }
| Not documented. |
proc ::alited::file::AddRecent {fname} { namespace upvar ::alited al al if {![IsNoName $fname]} { InsertRecent $fname 0 FillRecent } }
Actions after saving files.
proc ::alited::file::AfterSaving {} { # Actions after saving files. alited::main::ShowHeader yes alited::tree::RecreateTree alited::tree::SeeTreeItem }
Checks whether all files are saved. Saves them if not.
proc ::alited::file::AllSaved {} { # Checks whether all files are saved. Saves them if not. variable ansSave variable firstSave set ansSave 0 set firstSave 1 set res 1 foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] switch [IsSaved $TID] { 0 { ;# "Cancel" chosen for a modified set res 0 break } 1 - 11 { ;# "Save" chosen for a modified if {![set res [SaveFile $TID yes]]} break } } } set ansSave 0 set firstSave -1 return $res }
Checks if there is a file in bar of tabs and creates "No name" tab, if no tab exists.
| if yes, does checking, if no - run itself with docheck=yes; optional, default no |
proc ::alited::file::CheckForNew {{docheck no}} { # Checks if there is a file in bar of tabs and creates "No name" tab, if no tab exists. # docheck - if yes, does checking, if no - run itself with docheck=yes # See also: project::Ok namespace upvar ::alited al al if {$docheck} { if {![llength [alited::bar::BAR listTab]] && ![info exists al(project::Ok)]} { NewFile } } else { after idle {::alited::file::CheckForNew yes} } }
Choose miltiple files to open.
| if yes, handles the result's sorting; optional, default yes |
proc ::alited::file::ChooseMultipleFiles {{dosort yes}} { # Choose miltiple files to open. # dosort - if yes, handles the result's sorting namespace upvar ::alited al al obPav obPav set al(TMPfname) {} set fnames [$obPav chooser tk_getOpenFile ::alited::al(TMPfname) -multiple 1 -initialdir [file dirname [alited::bar::CurrentTab 2]] -parent $al(WIN)] if {$dosort && $al(lifo)} {set fnames [lsort -decreasing $fnames]} unset al(TMPfname) return $fnames }
| Not documented. |
proc ::alited::file::ChooseRecent {fname} { namespace upvar ::alited al al AddRecent $fname if {[OpenFile $fname] eq {} && ![file exists $fname]} { FillRecent 0 alited::Balloon1 $fname } }
Clears al array of tag,tab data.
| the tag |
| the tab's pattern |
proc ::alited::file::ClearupAlTag {tag tab} { # Clears *al* array of *tag,tab* data. # tag - the tag # tab - the tab's pattern namespace upvar ::alited al al foreach n [array names al $tag,$tab] {unset al($n)} }
Clearance after closing a file.
| tab's ID |
| text's path |
| file name |
proc ::alited::file::ClearupOnClose {TID wtxt fname} { # Clearance after closing a file. # TID - tab's ID # wtxt - text's path # fname - file name namespace upvar ::alited al al obPav obPav $obPav fillGutter $wtxt catch {if {[IsClang $fname]} {::hl_c::clearup $wtxt} {::hl_tcl::clearup $wtxt}} unset -nocomplain al(_unittree,$TID) ClearupAlTag HL *_$TID ClearupAlTag _INDENT_ *_$TID ClearupAlTag CPOS *$TID,* }
Clones a current file in a file tree.
| if yes, run by mouse click; optional, default yes |
| if yes, gets the file name from the file tree; optional, default yes |
proc ::alited::file::CloneFile {{undermouse yes} {fromtree yes}} { # Clones a current file in a file tree. # undermouse - if yes, run by mouse click # fromtree - if yes, gets the file name from the file tree namespace upvar ::alited al al if {$fromtree} { lassign [TreeFilename] - - fname set ar {} } else { set fname [alited::bar::FileName] set ar - } if {$fname eq {} || [alited::file::IsNoName $fname]} return if {![file isfile $fname]} { alited::Balloon1 $fname return } set fname2 [CloneFileName $fname] set name [file tail $fname2] lassign [InputFileName $al(MC,clonefile) $name $undermouse {*}$ar] res name2 if {$res && $name2 ne {}} { set fname2 [file join [file dirname $fname2] $name2] if {![CommandForFile2 copy $fname $fname2]} return OpenFile $fname2 if {!$al(TREE,isunits)} {RecreateFileTree; AfterSaving} } }
Gets a clone's name.
| file name |
Returns the clone's file name.
proc ::alited::file::CloneFileName {fname} { # Gets a clone's name. # fname - file name # Returns the clone's file name. namespace upvar ::alited al al set tailname [file tail $fname] set ext [file extension $tailname] set root [file rootname $tailname] # possibly existing suffix in the filename set suffix {_\d+$} set suff [regexp -inline $suffix $root] set root [string range $root 0 end-[string length $suff]] set i1 2 set i2 99 if {$suff eq {}} {set suff _$i1} # find the free suffix for the clone for {set i $i1} {$i<=$i2} {incr i} { set suff [string map [list {\d+} $i \$ {}] $suffix] set fname2 [file join [file dirname $fname] $root$suff$ext] if {![file exists $fname2]} break } return $fname2 }
Closes files.
| "1/2/3" means closing "all/to left/to right" |
| may contain -skipsel to not close selected tabs |
proc ::alited::file::CloseAll {func args} { # Closes files. # func - "1/2/3" means closing "all/to left/to right" # args - may contain -skipsel to not close selected tabs namespace upvar ::alited al al variable ansSave set ansSave 0 set TID [alited::bar::CurrentTabID] set al(closefunc) $func ;# disables "recent files" at closing all alited::bar::BAR closeAll $::alited::al(BID) $TID $func {*}$args set al(closefunc) 0 expr {[llength [alited::bar::BAR listFlag "m"]]==0} }
Closes and deletes a file.
| tab's ID; optional, default "" |
Returns 1 for deleted, 0 for error/cancel.
proc ::alited::file::CloseAndDelete {{TID {}}} { # Closes and deletes a file. # TID - tab's ID # Returns 1 for deleted, 0 for error/cancel. namespace upvar ::alited al al set fname [alited::bar::FileName $TID] if {[IsNoName $fname]} { # for a new file: to save first if modified (to think twice) if {[IsModified $TID]} {SaveFile $TID} else {SaveAndClose $TID} return 0 } set msg [string map [list %f [file tail $fname]] $al(MC,delfile)] if {[alited::msg yesno warn $msg NO]} { # to save first (for normal closing only) if {[SaveAndClose $TID]} { DeleteFile $fname FillRecent $fname if {!$al(TREE,isunits)} {alited::tree::RecreateTree {} {} yes} alited::edit::MacroUpdate $fname alited::tree::SeeTreeItem return 1 } } return 0 }
Closes a file.
| tab's ID |
| if yes, checks if new file's tab should be created |
| arguments added by bartabs |
Returns 0, if a user selects "Cancel".
proc ::alited::file::CloseFile {TID checknew args} { # Closes a file. # TID - tab's ID # checknew - if yes, checks if new file's tab should be created # args - arguments added by bartabs # Returns 0, if a user selects "Cancel". namespace upvar ::alited al al obPav obPav variable ansSave variable firstSave lassign [::apave::extractOptions args -withicon 0 -first -1] withicon first if {$withicon || $first} { set ansSave 0 set nmark [llength [alited::bar::BAR listFlag "m"]] if {$nmark<2 || $withicon} { set firstSave -1 if {$withicon} {lappend args -geometry pointer+-100+20} } else { set firstSave $first ;# controls "No ask anymore" checkbox at questions } } set res 1 set fname [alited::bar::FileName $TID] lassign [alited::bar::GetTabState $TID --wtxt --wsbv] wtxt wsbv if {$TID ni {{-1} {}} && $wtxt ne {}} { switch [IsSaved $TID {*}$args] { 0 { ;# "Cancel" chosen for a modified return 0 } 1 - 11 { ;# "Save" chosen for a modified set res [SaveFile $TID] } } alited::main::SaveMarks $wtxt if {$wtxt ne [$obPav Text]} { ;# let [$obPav Text] be alive, as needed by 'pack' destroy $wtxt $wsbv } if {$checknew} CheckForNew alited::ini::SaveCurrentIni $al(INI,save_onclose) after 9999 [list alited::file::ClearupOnClose $TID $wtxt $fname] } if {$al(closefunc) != 1} { ;# close func = 1 means "close all" AddRecent $fname } after idle [list alited::bar::RenameTitles $TID] after idle after 50 after idle after 50 after idle after 50 after idle after 50 alited::tree::UpdateFileTree return $res }
Closes the current file from the menu.
proc ::alited::file::CloseFileMenu {} { # Closes the current file from the menu. if {[set TID [alited::bar::CurrentTabID]] ne ""} { alited::bar::BAR $TID close } }
Execute a command for two files.
| the command |
| 1st file name |
| 2nd file name |
Returns yes, if success.
proc ::alited::file::CommandForFile2 {comm fname fname2} { # Execute a command for two files. # comm - the command # fname - 1st file name # fname2 - 2nd file name # Returns yes, if success. if {$comm in {copy rename} && [file exists $fname2]} { alited::msg ok err "$fname2\nalready exists." return no } if {[catch {file $comm -- $fname $fname2} err]} { alited::msg ok err $err -text 1 -w 60 -h {5 9} return no } return yes }
Deletes file(s) at the file tree.
| tree item's ID |
| file tree widget |
| relative Y-coordinate for a query |
proc ::alited::file::Delete {ID wtree sy} { # Deletes file(s) at the file tree. # ID - tree item's ID # wtree - file tree widget # sy - relative Y-coordinate for a query namespace upvar ::alited al al set wasdel 0 set selection [$wtree selection] if {[llength $selection]>1} { set dlg yesnocancel set dlgopts [list -ch $al(MC,noask)] } else { set dlg yesno set dlgopts [alited::tree::syOption $sy] set selection $ID } set ltree [alited::tree::GetTree] set id1 [lindex $selection 0] set in1 [lsearch -exact -index 2 $ltree $id1] set ans 1 foreach id $selection { set ans [DeleteOne $id $wtree $dlg $dlgopts $ans] switch $ans { 1 - 11 {set wasdel 1; $wtree delete $id} 0 - 12 break } } if {$wasdel} { set ltree [alited::tree::GetTree] if {$in1>=[llength $ltree]} {set in1 end} set id1 [lindex $ltree $in1 2] $wtree selection set {} AfterSaving } }
Deletes a file.
| file name |
proc ::alited::file::DeleteFile {fname} { # Deletes a file. # fname - file name if {[catch {file delete $fname} err]} { alited::msg ok err "Error of deleting\n$fname\n\n$err" return no } return yes }
Deletes a file at the file tree.
| tree item's ID |
| file tree widget |
| dialogue's type (yesno / yesnocancel) |
| dialogue's options |
| previous answer |
Returns 1 for deleted, -1 for not deleted, 0 for error/cancel
proc ::alited::file::DeleteOne {ID wtree dlg dlgopts res} { # Deletes a file at the file tree. # ID - tree item's ID # wtree - file tree widget # dlg - dialogue's type (yesno / yesnocancel) # dlgopts - dialogue's options # res - previous answer # Returns 1 for deleted, -1 for not deleted, 0 for error/cancel namespace upvar ::alited al al BAKDIR BAKDIR set name [$wtree item $ID -text] set fname [lindex [$wtree item $ID -values] 1] set TID [alited::bar::FileTID $fname] if {$TID ne ""} { return [alited::file::CloseAndDelete $TID] } set msg [string map [list %f $name] $al(MC,delfile)] if {$res<11} { set res [alited::msg $dlg ques $msg NO {*}$dlgopts] } switch $res { 1 - 11 { if {[RemoveFile $fname $BAKDIR backup] eq {}} { set res 0 } } } return $res }
Open file in detached editors
| file names' list; optional, default "" |
| Not documented; optional, default "" |
proc ::alited::file::Detach {{fnames {}} {TID {}}} { # Open file in detached editors # fnames - file names' list namespace upvar ::alited al al SourceDetach if {$fnames eq {} || $TID ne {}} { set fnames [alited::bar::FileName $TID] if {[alited::file::IsNoName $fnames] && ![SaveFileAs $TID]} return set fnames [list [alited::bar::FileName $TID]] } alited::detached::_run $fnames }
Gets detached editor's object and window.
| editor's index |
proc ::alited::file::DetachedInfo {id} { # Gets detached editor's object and window. # id - editor's index namespace upvar ::alited al al set pobj ::alited::al(detachedObj,$id,) set win $al(WIN).detachedWin$id list $pobj $win }
proc ::alited::file::DetachFromTree {} { SourceDetach alited::detached::_run [TreeSelFiles] }
Displays a file's contents.
| ID of tab |
| file name |
| text widget's path |
| if yes, forces reloading (at external changes of file) |
proc ::alited::file::DisplayFile {TID fname wtxt doreload} { # Displays a file's contents. # TID - ID of tab # fname - file name # wtxt - text widget's path # doreload - if yes, forces reloading (at external changes of file) namespace upvar ::alited al al obPav obPav # this is most critical: displayed text should correspond to the tab #control::assert {$wtxt eq [alited::main::GetWTXT $TID]} if {$wtxt ne [alited::main::GetWTXT $TID]} { puts [set msg "\n ERROR file::DisplayFile: \n ($TID) $wtxt != [alited::main::GetWTXT $TID] \n Please, notify alited's authors!\n"] return -code error $msg } # another critical point: read the file only at need if {$doreload || [set filecont [ReadFileByTID $TID yes]] eq {}} { # last check point: 0 bytes of the file => read it anyway with showing errors set filecont [ReadFile $TID $fname 1] } $obPav displayText $wtxt $filecont $obPav makePopup $wtxt no yes }
Asks and moves a file to a directory.
| file name |
| directory name |
| yes, if run by pressing F11/F12 keys |
| additional message (for external moves); optional, default "" |
proc ::alited::file::DoMoveFile {fname dname f1112 {addmsg {}}} { # Asks and moves a file to a directory. # fname - file name # dname - directory name # f1112 - yes, if run by pressing F11/F12 keys # addmsg - additional message (for external moves) namespace upvar ::alited al al if {[file isdirectory $fname]} { set msg [msgcat::mc {%f is a directory}] alited::Message [string map [list %f $fname] $msg] 4 return } set tailname [file tail $fname] if {$f1112 || $addmsg ne {}} { set defb NO set geo "" } else { set defb YES set geo "-geometry pointer+10+10" } if {![info exists al(_ANS_MOVE_)] || $al(_ANS_MOVE_)!=11} { append addmsg [string map [list %f $tailname %d $dname] $al(MC,movefile)] set al(_ANS_MOVE_) [alited::msg yesno ques $addmsg $defb -title $al(MC,moving) {*}$geo -ch $al(MC,noask)] if {!$al(_ANS_MOVE_)} return } return [RemoveFile $fname $dname move] }
Performs renaming a current file in a file tree.
| file tree's path |
| ID of the file in the file tree |
| old file name (full) |
| new file name (full) |
proc ::alited::file::DoRenameFileInTree {wtree ID fname fname2} { # Performs renaming a current file in a file tree. # wtree - file tree's path # ID - ID of the file in the file tree # fname - old file name (full) # fname2 - new file name (full) set fsplit [file split $fname] set lfnam0 [llength $fsplit] set lfnam1 [expr {$lfnam0-1}] if {![CommandForFile2 rename $fname $fname2]} return foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] set fname1 [alited::bar::FileName $TID] if {$fname1 eq $fname} { RenameFile $TID $fname2 no break } set fsplit1 [file split $fname1] if {[lrange $fsplit1 0 $lfnam1] == $fsplit} { # directory is renamed set fname1 [file join $fname2 {*}[lrange $fsplit1 $lfnam0 end]] RenameFile $TID $fname1 no } } alited::bar::BAR draw RecreateFileTree AfterSaving alited::main::UpdateHighlighting }
Moves a group of selected files to other tree position.
| file tree widget fromIDs- tree IDs to move the file from |
| Not documented. |
| tree ID to move the file to |
The destination position is freely chosen by "Drop here" menu item.
proc ::alited::file::DropFiles {wtree fromIDs toID} { # Moves a group of selected files to other tree position. # wtree - file tree widget # fromIDs- tree IDs to move the file from # toID - tree ID to move the file to # The destination position is freely chosen by "Drop here" menu item. if {![$wtree exists $toID]} return set dirname [lindex [$wtree item $toID -values] 1] if {![file isdirectory $dirname]} { set dirname [file dirname $dirname] } set movedfiles [list] foreach fromID $fromIDs { if {![$wtree exists $fromID]} continue set curfile [lindex [$wtree item $fromID -values] 1] lappend movedfiles $curfile } if {![llength $movedfiles]} return foreach curfile $movedfiles { if {[file isdirectory $curfile]} { if {$curfile ne $dirname} { alited::Message [msgcat::mc {Only files are moved by alited.}] 4 } continue } if {[file dirname $curfile] ne $dirname} { if {[set name [DoMoveFile $curfile $dirname yes]] ne {}} { lappend newnames $name } } } if {[info exists newnames]} { alited::tree::RecreateTree {} $newnames alited::main::ShowHeader yes } }
Gets/sets a file's encoding.
| file's name; optional, default "" |
| if "", gets the encoding, otherwise sets the encoding of the file; optional, default "" |
proc ::alited::file::Encoding {{fname {}} {enc {}}} { # Gets/sets a file's encoding. # fname - file's name # enc - if "", gets the encoding, otherwise sets the encoding of the file. namespace upvar ::alited al al if {$fname eq {}} {set fname [alited::bar::FileName]} if {$enc ne {}} { set al(ENCODING,$fname) $enc } else { if {[info exists al(ENCODING,$fname)]} { set enc [list -encoding $al(ENCODING,$fname)] } else { set enc {} } } return $enc }
Gets/sets a file's translation.
| file's name; optional, default "" |
| if "", gets the translation, otherwise sets the translation of the file; optional, default "" |
proc ::alited::file::EOL {{fname {}} {eol {}}} { # Gets/sets a file's translation. # fname - file's name # eol - if "", gets the translation, otherwise sets the translation of the file. namespace upvar ::alited al al if {$fname eq {}} {set fname [alited::bar::FileName]} if {$eol ne {}} { set al(EOL,$fname) $eol } else { if {[info exists al(EOL,$fname)]} { set eol [list -translation $al(EOL,$fname)] } else { set eol {} } } return $eol }
Returns a file attributes: name & time.
| tab's ID |
Returns a file attributes: name & time.
proc ::alited::file::FileAttrs {TID} { # Returns a file attributes: name & time. # TID - tab's ID namespace upvar ::alited al al set fname [alited::bar::FileName $TID] lassign [alited::bar::BAR $TID cget --mtime --mtimefile] mtime mtimefile set isfile [file exists $fname] if {$isfile} { set curtime [file mtime $fname] } elseif {$fname ne $al(MC,nofile)} { set curtime ? } else { set curtime {} } list $fname $isfile $mtime $mtimefile $curtime }
Formats a file's size.
| file size in bytes |
proc ::alited::file::FileSize {bsize} { # Formats a file's size. # bsize - file size in bytes set res "$bsize bytes" set bsz $bsize foreach m {Kb Mb Gb Tb} { if {$bsz<1024} break set rsz [expr {$bsz/1024.0}] set res "[format %.1f $rsz] $m ($bsize bytes)" set bsz [expr {int($bsz/1024)}] } return $res }
Gets a file's attributes: times & size.
| file name |
Returns a string with file name and attributes divided by \n.
proc ::alited::file::FileStat {fname} { # Gets a file's attributes: times & size. # fname - file name # Returns a string with file name and attributes divided by \n. # See also: bar::ColorBar set res {} array set ares {} if {$::alited::al(TREE,showinfo)} { if {![catch {file stat $fname ares} err]} { set dtf "%D %T" set res "\n \nCreated: [clock format $ares(ctime) -format $dtf] \nModified: [clock format $ares(mtime) -format $dtf] \nAccessed: [clock format $ares(atime) -format $dtf] \nSize: [FileSize $ares(size)]" } else { set res \n\n[string map [list {: } :\n \" ''] $err] } } return [append fname $res] }
Creates "Recent Files" menu items.
| index or a file name of Recent Files item to be deleted; optional, default "" |
proc ::alited::file::FillRecent {{delit {}}} { # Creates "Recent Files" menu items. # delit - index or a file name of Recent Files item to be deleted namespace upvar ::alited al al if {[string is integer -strict $delit] && $delit>-1 && $delit<[llength $al(RECENTFILES)]} { set al(RECENTFILES) [lreplace $al(RECENTFILES) $delit $delit] } elseif {$delit ne {}} { set delit [lsearch -exact $al(RECENTFILES) $delit] if {$delit>=0} { set al(RECENTFILES) [lreplace $al(RECENTFILES) $delit $delit] } } set m $al(MENUFILE).recentfiles $m configure -tearoff 0 $m delete 0 end if {[llength $al(RECENTFILES)]} { $al(MENUFILE) entryconfigure 2 -state normal foreach rf $al(RECENTFILES) { $m add command -label $rf -command "alited::file::ChooseRecent {$rf}" } } else { $al(MENUFILE) entryconfigure 2 -state disabled } $m configure -tearoff 1 }
Dialogue to input a file name.
| title of the dialogue |
| current file name |
| yes if open under the mouse pointer |
| options for query |
proc ::alited::file::InputFileName {title name undermouse args} { # Dialogue to input a file name. # title - title of the dialogue # name - current file name # undermouse - yes if open under the mouse pointer # args - options for query namespace upvar ::alited obDl2 obDl2 switch -exact -- $args { {} { set args [alited::favor::GeoForQuery $undermouse] } - { set args {} } } lassign [$obDl2 input {} $title [list ent "{} {} {-w 32}" "{$name}"] -head [msgcat::mc {File name:}] {*}$args] res name list $res $name }
| Not documented. |
| Not documented. |
proc ::alited::file::InsertRecent {fname pos} { namespace upvar ::alited al al if {![IsNoName $fname]} { ::apave::PushInList al(RECENTFILES) $fname $pos $al(INI,RECENTFILES) } }
Checks if a file is of C/C++.
| file name |
proc ::alited::file::IsClang {fname} { # Checks if a file is of C/C++. # fname - file name if {[string tolower [file extension $fname]] in $::alited::al(ClangExts)} { return yes } return no }
Checks if a text of tab is modified.
| ID of tab; optional, default "" |
proc ::alited::file::IsModified {{TID {}}} { # Checks if a text of tab is modified. # TID - ID of tab if {$TID eq ""} {set TID [alited::bar::CurrentTabID]} expr {[lsearch -index 0 [alited::bar::BAR listFlag m] $TID]>-1} }
Checks if a file name is "No name".
| file name |
proc ::alited::file::IsNoName {fname} { # Checks if a file name is "No name". # fname - file name namespace upvar ::alited al al if {[file tail $fname] in [list $al(MC,nofile) {No name} {}]} { return yes } return no }
Checks if a file is modified and if yes, offers to save it.
| ID of tab |
| options of dialogue |
The appearance of dialogue is controled by $ansSave
and $firstSave
: if $ansSave
>10, no dialogue at all, meaning the answer = $ansSave
if $firstSave
==-1, no "No ask anymore" (if run by "Close" menu item or "x" icon of tabbar)
Returns 1 for "yes, needs saving", 2 - "no saving", 0 - "cancel".
proc ::alited::file::IsSaved {TID args} { # Checks if a file is modified and if yes, offers to save it. # TID - ID of tab # args - options of dialogue # The appearance of dialogue is controled by $ansSave and $firstSave: # if $ansSave>10, no dialogue at all, meaning the answer = $ansSave # if $firstSave==-1, no "No ask anymore" (if run by "Close" menu item or "x" icon of tabbar) # Returns 1 for "yes, needs saving", 2 - "no saving", 0 - "cancel". variable ansSave variable firstSave namespace upvar ::alited al al if {[IsModified $TID]} { set tname [alited::bar::TabName $TID] if {$ansSave<10} { if {$firstSave==-1} { set ch {} } else { # the option for "save/not save other changed files, without further questions" set ch [list -ch $al(MC,noask)] } set ansSave [alited::msg yesnocancel warn [string map [list %f $tname] $al(MC,notsaved)] YES -title $al(MC,saving) {*}$ch {*}$args] } return $ansSave } return 2 ;# as if "No" chosen }
Checks if a file is of Tcl.
| file name |
proc ::alited::file::IsTcl {fname} { # Checks if a file is of Tcl. # fname - file name if {[string tolower [file extension $fname]] in $::alited::al(TclExts)} { return yes } return no }
Checks if a file has a unit tree.
| file name |
proc ::alited::file::IsUnitFile {fname} { # Checks if a file has a unit tree. # fname - file name return [expr {[IsTcl $fname]}] }
Sets flag "highlight file(s) anyway".
| list of tabs to set the flag for; optional, default "" |
| text path (if set, it is flagged only); optional, default "" |
Useful when you need update the files' highlightings.
proc ::alited::file::MakeThemHighlighted {{tabs {}} {wtxt {}}} { # Sets flag "highlight file(s) anyway". # tabs - list of tabs to set the flag for # wtxt - text path (if set, it is flagged only) # Useful when you need update the files' highlightings. namespace upvar ::alited al al if {$wtxt eq {}} { if {$tabs eq {}} { set tabs [alited::bar::BAR listTab] } foreach tab $tabs { if {[set w [alited::main::GetWTXT [lindex $tab 0]]] ne {}} { lappend wtxt $w } } } foreach w $wtxt {set al(HL,$w) ..} }
Moves an external file to a project's directory.
| yes, if run by F11/F12 keys |
proc ::alited::file::MoveExternal {f1112} { # Moves an external file to a project's directory. # f1112 - yes, if run by F11/F12 keys namespace upvar ::alited al al set fname [alited::bar::FileName] if {$al(prjroot) eq {} || [string first $al(prjroot) $fname]==0} { return no ;# no project directory or the file is inside it } set addmsg [msgcat::mc {THE EXTERNAL FILE IS MOVED TO THE PROJECT!}] set fname [DoMoveFile $fname $al(prjroot) $f1112 "$addmsg\n\n"] alited::tree::RecreateTree {} $fname alited::main::ShowHeader yes return yes }
Moves file(s).
| file tree widget |
| "move", "up" or "down" (direction of moving) |
| file's tree IDs to be moved |
| yes for pressing F11/F12 or file's tree ID |
For to=move, f1112 is a file's ID to be moved to.
proc ::alited::file::MoveFiles {wtree to itemIDs f1112} { # Moves file(s). # wtree - file tree widget # to - "move", "up" or "down" (direction of moving) # itemIDs - file's tree IDs to be moved # f1112 - yes for pressing F11/F12 or file's tree ID # For to=move, f1112 is a file's ID to be moved to. set tree [alited::tree::GetTree] set itemID [lindex $itemIDs 0] set idx [alited::unit::SearchInBranch $itemID $tree] if {$to eq {move}} { if {$idx>=0} { DropFiles $wtree $itemIDs $f1112 } return } set curfile [alited::bar::FileName] set curdir [file dirname $curfile] set isexternal [expr {[string first [file normalize $::alited::al(prjroot)] [file normalize $curdir]]<0}] if {!$isexternal} { if {$idx<0} {bell; return} # the edited file is not external => try to move selected files of the tree lassign [$wtree item $itemID -values] -> curfile set curdir [file dirname $curfile] } if {$to eq {up}} {set ito 0} {set ito end} set selparent [$wtree parent [lindex $itemIDs $ito]] set dirname {} set increment [expr {$to eq {up} ? -1 : 1}] for {set i $idx} {1} {incr i $increment} { lassign [lindex $tree $i 4] files fname isfile id if {$fname eq {}} break if {$isfile} { set parent [$wtree parent $id] if {$parent ne $selparent && $parent ne {} && [file dirname $fname] ne $curdir} { lassign [$wtree item $parent -values] files fname isfile id set dirname $fname break } } elseif {$id ne $selparent && $fname ne $curdir} { set dirname $fname break } } if {$dirname eq {}} { if {$selparent ne {}} { set dirname $::alited::al(prjroot) } else { bell return } } if {$isexternal} { # this file is external to the project - ask to move it into the project if {[set name [DoMoveFile $curfile $dirname $f1112]] ne {}} { lappend movedfiles $name } } else { set f1112 [expr {$f1112 || [llength $itemIDs]>1}] foreach ID $itemIDs { set curfile [lindex [$wtree item $ID -values] 1] if {[set name [DoMoveFile $curfile $dirname $f1112]] ne {}} { lappend movedfiles $name } } } if {[info exists movedfiles]} { $wtree selection set {} alited::tree::RecreateTree {} $movedfiles alited::main::ShowHeader yes } }
Handles "New file" menu item.
| a file name; optional, default "" |
proc ::alited::file::NewFile {{fname {}}} { # Handles "New file" menu item. # fname - a file name namespace upvar ::alited al al if {[set TID [alited::bar::FileTID $al(MC,nofile)]] eq {}} { if {$fname eq {}} { set tab [set fname $al(MC,nofile)] } else { set tab [alited::bar::UniqueListTab $fname] set fname [FileStat $fname] } set TID [alited::bar::InsertTab $tab $fname] } alited::bar::BAR $TID show alited::tree::SeeTreeItem }
Choose files and open them in detached editors.
proc ::alited::file::OpenDetach {} { # Choose files and open them in detached editors. if {[set fnames [ChooseMultipleFiles no]] eq {}} return SourceDetach alited::detached::_run $fnames }
Handles "Open file" menu item.
| file name (if not set, asks for it); optional, default "" |
| if yes, loads the file even if it has a "strange" extension; optional, default no |
| if yes, fnames is a file list; optional, default no |
| name of procedure for "open file" message; optional, default "" |
Returns the file's tab ID if it's loaded, or {} if not loaded.
proc ::alited::file::OpenFile {{fnames {}} {reload no} {islist no} {Message {}}} { # Handles "Open file" menu item. # fnames - file name (if not set, asks for it) # reload - if yes, loads the file even if it has a "strange" extension # islist - if yes, *fnames* is a file list # Message - name of procedure for "open file" message # Returns the file's tab ID if it's loaded, or {} if not loaded. namespace upvar ::alited al al variable ansOpen if {$fnames eq {}} { set fnames [ChooseMultipleFiles] } elseif {!$islist} { set fnames [list $fnames] } if {[set llen [llength $fnames]]==0} {return {}} set TID {} set many [expr {$llen>1}] foreach fname $fnames { if {[file exists $fname]} { set exts $al(TclExts) append exts { } $al(ClangExts) append exts { } $al(TextExts) append exts { typetpl} set sexts [string map {. {}} " $al(TclExts)\n $al(ClangExts)\n $al(TextExts)"] set exts [string trim [string map {{ } {, } . {}} $exts]] set ext [alited::EditExt $fname] set ext [string tolower [string trim $ext .]] set esp [split [string map [list { } {} \n ,] $exts] ,] if {!$reload && $ext ni $esp && $ansOpen<11} { set msg [string map [list %f [file tail $fname] %s $sexts] $al(MC,nottoopen)] set ansOpen [alited::msg yesnocancel warn $msg YES -ch $al(MC,noask)] if {!$ansOpen || $ansOpen==12} break if {$ansOpen==2} continue } if {[set TID [alited::bar::FileTID $fname]] eq {}} { # close "no name" tab if it's the only one and not changed set tabs [alited::bar::BAR listTab] set tabm [alited::bar::BAR listFlag m] if {[llength $tabs]==1 && [llength $tabm]==0} { set tid [lindex $tabs 0 0] if {[alited::bar::FileName $tid] eq $al(MC,nofile)} { alited::bar::BAR $tid close } } # open new tab set tab [alited::bar::UniqueListTab $fname] set TID [alited::bar::InsertTab $tab [FileStat $fname]] AddRecent $fname if {$Message ne {}} { $Message "[msgcat::mc {Open file:}] $fname" } } elseif {$al(lifo)} { # in -lifo mode: move all open files to 1st position # (but if it's one file to be move, then only if it's not visible) if {(![alited::bar::BAR $TID visible] && !$many) || $many} { if {$many} { alited::bar::BAR moveTab $TID 0 ;# one tab is shown by "show" method below } set many yes } } } } if {$TID ne {} && ($al(lifo) || $TID ne [alited::bar::CurrentTabID])} { alited::bar::BAR $TID show $many $many } RecreateFileTree after 20 alited::FocusText return $TID }
Opens files selected in the file tree.
proc ::alited::file::OpenFiles {} { # Opens files selected in the file tree. OpenFile [SortTreeSelFiles] no yes }
Opens all Tcl files of a directory.
| directory's name |
proc ::alited::file::OpenOfDir {dname} { # Opens all Tcl files of a directory. # dname - directory's name namespace upvar ::alited al al variable ansOpenOfDir set msg [msgcat::mc "All Tcl files of this directory:\n \"%f\" \nwill be open. This may be expensive!"] set msg [string map [list %f [file tail $dname]] $msg] if {$ansOpenOfDir<11} { set ansOpenOfDir [alited::msg okcancel warn $msg OK -ch $al(MC,noask)] } if {$ansOpenOfDir && ![catch {set flist [glob -directory $dname *]}] && $flist ne {}} { set fnames [list] foreach fname [lsort -decreasing -dictionary $flist] { if {[file isfile $fname] && [IsTcl $fname]} { lappend fnames $fname } } OpenFile $fnames no yes after idle {focus -force [alited::main::CurrentWTXT]} } }
Opens files selected in the file tree, with their apps.
proc ::alited::file::OpenWith {} { # Opens files selected in the file tree, with their apps. foreach fn [SortTreeSelFiles] { incr i after [expr {($i-1)*500}] openDoc $fn ;# let the app get 0.5 sec pause } }
Checks for change of file by an external application.
| ID of tab |
| yes for "do check", no for "just save the file's mtime" optional, default yes |
proc ::alited::file::OutwardChange {TID {docheck yes}} { # Checks for change of file by an external application. # TID - ID of tab # docheck - yes for "do check", no for "just save the file's mtime" namespace upvar ::alited al al if {[winfo exists .em] || [info exists al(_NO_OUTWARD_)]} { return ;# no actions if "internal" e_menu is open } if {$docheck && $TID ne [alited::bar::CurrentTabID]} { return ;# not a current tab: no questions } lassign [FileAttrs $TID] fname isfile mtime mtimefile curtime if {$docheck && $mtime ne {} && $curtime ne $mtime && $fname eq $mtimefile} { if {$isfile} { set msg [string map [list %f [file tail $fname]] $al(MC,modiffile)] } else { set msg [string map [list %f [file tail $fname]] $al(MC,wasdelfile)] } # at any answer, the tab should be marked as "modified" alited::bar::BAR markTab $TID alited::edit::CheckSaveIcons yes if {[alited::msg yesno warn $msg YES -title $al(MC,saving)]} { if {$isfile} { set wtxt [alited::main::GetWTXT $TID] set pos [$wtxt index insert] set filecont [ReadFile $TID $fname 1] ;# let Undo be possible $wtxt replace 1.0 end $filecont catch { ::tk::TextSetCursor $wtxt $pos ::alited::main::CursorPos $wtxt } alited::main::UpdateAll alited::main::FocusText } else { alited::bar::BAR $TID configure --mtime {} SaveFileAs $TID if {[catch {set curtime [file mtime $fname]}]} {set curtime {}} } } set do_update_tree yes lassign [FileAttrs $TID] fname isfile mtime mtimefile curtime } alited::bar::BAR $TID configure --mtime $curtime --mtimefile $fname -tip [FileStat $fname] if {[info exists do_update_tree]} { if {$al(TREE,isunits)} {set fname {}} ::alited::tree::RecreateTree {} $fname } }
Reads a file, creates its unit tree.
| ID of tab |
| file name |
| if 'true', exit at errors with error message; optional, default 0 |
Returns the file's contents.
proc ::alited::file::ReadFile {TID fname {doErr 0}} { # Reads a file, creates its unit tree. # TID - ID of tab # fname - file name # doErr - if 'true', exit at errors with error message # Returns the file's contents. namespace upvar ::alited al al set enc [Encoding $fname] append enc { } [EOL $fname] set filecont [readTextFile $fname {} $doErr {*}$enc] set al(_unittree,$TID) [alited::unit::GetUnits $TID $filecont] return $filecont }
Reads a file of tab, if needed.
| ID of the tab |
| if yes, returns a content of the file; optional, default no |
proc ::alited::file::ReadFileByTID {TID {getcont no}} { # Reads a file of tab, if needed. # TID - ID of the tab # getcont - if yes, returns a content of the file namespace upvar ::alited al al if {![info exist al(_unittree,$TID)]} { return [ReadFile $TID [alited::bar::FileName $TID]] } if {$getcont} { set wtxt [alited::main::GetWTXT $TID] return [$wtxt get 1.0 "end - 1 chars"] } }
Creates the file tree.
proc ::alited::file::RecreateFileTree {} { # Creates the file tree. namespace upvar ::alited al al obPav obPav if {!$al(TREE,isunits) && ![winfo exists $::alited::project::win]} { [$obPav Tree] selection set {} catch {after cancel $al(_AFT_RECR_)} set al(_AFT_RECR_) [after 100 {alited::tree::RecreateTree; alited::tree::SeeSelection}] } }
Reloads a current file with EOL.
| the end of line |
proc ::alited::file::Reload1 {eol} { # Reloads a current file with EOL. # eol - the end of line namespace upvar ::alited al al set eol [string trim $eol] set wtxt [alited::main::CurrentWTXT] set TID [alited::bar::CurrentTabID] set fname [alited::bar::FileName] set dosave no if {[IsNoName $fname]} { set dosave yes } elseif {[IsModified]} { if {![info exists al(EOLASKED)] || $al(EOLASKED)<10} { set msg [msgcat::mc "Save the file:\n%F ?"] set msg [string map [list %F $fname] $msg] set al(EOLASKED) [alited::msg yesnocancel warn $msg CANCEL -ch $al(MC,noask)] if {!$al(EOLASKED)} return if {$al(EOLASKED) in {1 11}} {set dosave yes} } $wtxt edit modified no alited::edit::Modified $TID $wtxt } if {$dosave} { set al(THIS-EOL) $eol set dosave [SaveFile] unset al(THIS-EOL) if {!$dosave} return } set fname [alited::bar::FileName] set pos [$wtxt index insert] EOL $fname $eol DisplayFile $TID $fname $wtxt yes catch {::tk::TextSetCursor $wtxt $pos} alited::main::UpdateProjectInfo alited::main::UpdateAll }
Reloads a current file with an encoding.
| the encoding |
proc ::alited::file::Reload2 {enc} { # Reloads a current file with an encoding. # enc - the encoding namespace upvar ::alited al al lassign [split $enc] enc set wtxt [alited::main::CurrentWTXT] set TID [alited::bar::CurrentTabID] set fname [alited::bar::FileName] set dosave no if {[IsNoName $fname]} { set dosave yes } elseif {[IsModified]} { if {![info exists al(ENCODINGASKED)] || $al(ENCODINGASKED)<10} { set msg [msgcat::mc "Saving and reloading \"%f\"\nwith the encoding \"%e\" may turn out to be wrong.\n\nSave the file:\n%F ?"] set msg [string map [list %e $enc %f [file tail $fname] %F $fname] $msg] set al(ENCODINGASKED) [alited::msg yesnocancel warn $msg CANCEL -ch $al(MC,noask)] if {!$al(ENCODINGASKED)} return if {$al(ENCODINGASKED) in {1 11}} {set dosave yes} } $wtxt edit modified no alited::edit::Modified $TID $wtxt } else { if {![info exists al(ENCODINGASKED2)] || $al(ENCODINGASKED2)<10} { set msg [msgcat::mc "Reloading \"%f\"\nwith the encoding \"%e\" may turn out to be wrong.\n\nReload the file:\n%F ?"] set msg [string map [list %e $enc %f [file tail $fname] %F $fname] $msg] set al(ENCODINGASKED2) [alited::msg yesno warn $msg YES -ch $al(MC,noask)] if {!$al(ENCODINGASKED2)} return } } if {$dosave} { set al(THIS-ENCODING) $enc set dosave [SaveFile] unset al(THIS-ENCODING) if {!$dosave} return } set fname [alited::bar::FileName] set pos [$wtxt index insert] Encoding $fname $enc DisplayFile $TID $fname $wtxt yes catch {::tk::TextSetCursor $wtxt $pos} alited::main::UpdateProjectInfo alited::main::UpdateAll }
Removes or backups a file, trying to save it in a directory.
| file name |
| name of directory |
| if "move", then moves a file to a directory, otherwise backups it |
Returns a destination file's name or {} if error.
proc ::alited::file::RemoveFile {fname dname mode} { # Removes or backups a file, trying to save it in a directory. # fname - file name # dname - name of directory # mode - if "move", then moves a file to a directory, otherwise backups it # Returns a destination file's name or {} if error. namespace upvar ::alited al al set ftail [file tail $fname] set dtail [file tail $dname] set fname2 [file join $dname $ftail] if {[file exists $fname2]} { if {$mode eq "move"} { set msg [string map [list %f $ftail %d $dname] $al(MC,fileexist)] alited::msg ok warn $msg return {} } catch {file delete $fname2} } if {[catch {file copy $fname $dname} err]} { # more zeal than sense: to show $err here } catch {file mtime $fname2 [file mtime $fname]} if {![DeleteFile $fname]} { return {} } else { alited::Message [string map [list %f $ftail %d $dtail] $al(MC,removed)] if {$mode eq "move" && [set TID [alited::bar::FileTID $fname]] ne {}} { alited::bar::SetTabState $TID --fname $fname2 alited::bar::BAR $TID configure -tip [FileStat $fname2] } } return $fname2 }
Renames a file.
| ID of tab |
| file name |
| flag "show the file's text" optional, default yes |
proc ::alited::file::RenameFile {TID fname {doshow yes}} { # Renames a file. # TID - ID of tab # fname - file name # doshow - flag "show the file's text" if {[file exists $fname]} { alited::bar::SetTabState $TID --fname $fname alited::bar::BAR $TID configure -text {} -tip {} set tab [alited::bar::UniqueListTab $fname] set sname [file tail $fname] alited::bar::BAR $TID configure -text $sname -tip [FileStat $fname] if {$doshow} { alited::bar::BAR $TID show yes } } }
Renames a current file in a file tree.
| if yes, run by mouse click; optional, default yes |
| options for query |
proc ::alited::file::RenameFileInTree {{undermouse yes} args} { # Renames a current file in a file tree. # undermouse - if yes, run by mouse click # args - options for query namespace upvar ::alited al al obPav obPav obDl2 obDl2 lassign [TreeFilename] wtree name fname ID TID if {$fname eq {}} return lassign [InputFileName $al(MC,renamefile) $name $undermouse {*}$args] res name2 set name2 [string trim $name2] if {$res && $name2 ne {} && $name2 ne $name} { set fname2 [file join [file dirname $fname] $name2] DoRenameFileInTree $wtree $ID $fname $fname2 SelectFileInTree $wtree $fname2 $ID } }
Saves all files.
proc ::alited::file::SaveAll {} { # Saves all files. foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] if {[IsModified $TID]} { if {![SaveFile $TID]} {return no} } } return yes }
Saves and closes a file.
| tab's ID; optional, default "" |
This handles pressing Ctrl+W.
Returns yes if the file was closed.
proc ::alited::file::SaveAndClose {{TID {}}} { # Saves and closes a file. # TID - tab's ID # This handles pressing Ctrl+W. # Returns yes if the file was closed. set fname [lindex $::alited::bar::ctrltablist 1] if {[IsModified $TID] && ![SaveFile $TID]} {return no} if {$TID eq {}} {set TID [alited::bar::CurrentTabID]} alited::bar::BAR $TID close # go to a previously viewed file if {[set TID [alited::bar::FileTID $fname]] ne {}} { alited::bar::BAR $TID show } return yes }
Saves the current file.
| ID of tab; optional, default "" |
| flag "do save now, without any GUI" optional, default no |
proc ::alited::file::SaveFile {{TID {}} {doit no}} { # Saves the current file. # TID - ID of tab # doit - flag "do save now, without any GUI" # See also: ini::SaveCurrentIni namespace upvar ::alited al al if {$TID eq {}} {set TID [alited::bar::CurrentTabID]} set fname [alited::bar::FileName $TID] if {[IsNoName $fname]} { return [SaveFileAs $TID] } set res [SaveFileByName $TID $fname $doit] alited::ini::SaveCurrentIni "$res && $al(INI,save_onsave)" $doit if {!$doit} AfterSaving return $res }
Saves the current file "as".
| ID of tab; optional, default "" |
proc ::alited::file::SaveFileAs {{TID {}}} { # Saves the current file "as". # TID - ID of tab namespace upvar ::alited al al obPav obPav if {$TID eq {}} {set TID [alited::bar::CurrentTabID]} set fname [set fnameorig [alited::bar::FileName $TID]] set ::alited::al(TMPfname) [file tail $fname] if {[IsNoName $fname]} { set ::alited::al(TMPfname) {} set defext .tcl set inidir $al(prjroot) } else { set defext [file extension $fname] set inidir [file dirname $fname] } set fname [$obPav chooser tk_getSaveFile ::alited::al(TMPfname) -initialdir $inidir -defaultextension $defext -title [msgcat::mc {Save as}] -parent $al(WIN)] unset al(TMPfname) if {[IsNoName $fname]} { set res 0 } elseif {[set res [SaveFileByName $TID $fname]]} { AddRecent $fnameorig RenameFile $TID $fname AfterSaving } return $res }
Saves a file.
| ID of tab |
| file name |
| flag "do save now, without any GUI" optional, default no |
proc ::alited::file::SaveFileByName {TID fname {doit no}} { # Saves a file. # TID - ID of tab # fname - file name # doit - flag "do save now, without any GUI" namespace upvar ::alited al al if {[info exists al(THIS-ENCODING)]} { set enc "-encoding $al(THIS-ENCODING)" ;# at saving "no name" } else { set enc [Encoding $fname] } if {[info exists al(THIS-EOL)]} { set eol "-translation $al(THIS-EOL)" ;# at saving "no name" } else { set eol [EOL $fname] } append enc " $eol" set al(_NO_OUTWARD_) {} set wtxt [alited::main::GetWTXT $TID] if {$al(prjtrailwhite)} {alited::edit::RemoveTrailWhites $TID yes $doit} if {![SaveText $wtxt $fname $enc]} { return 0 } unset al(_NO_OUTWARD_) alited::edit::MacroUpdate $fname OutwardChange $TID no alited::edit::BackupFile $TID if {!$doit} { $wtxt edit modified no alited::edit::Modified $TID $wtxt alited::main::HighlightText $TID $fname $wtxt RecreateFileTree } return 1 }
Saves text buffer to file.
| text's path |
| file name |
| encoding options; optional, default "" |
proc ::alited::file::SaveText {wtxt fname {enc {}}} { # Saves text buffer to file. # wtxt - text's path # fname - file name # enc - encoding options namespace upvar ::alited al al set fcont [$wtxt get 1.0 "end - 1 chars"] ;# last \n excluded if {![writeTextFile $fname fcont 0 1 {*}$enc]} { alited::msg ok err [::apave::error $fname] -w 50 -text 1 unset -nocomplain al(_NO_OUTWARD_) return 0 } return 1 }
Shows/hides the horizontal scrollbar of the text.
proc ::alited::file::SbhText {} { # Shows/hides the horizontal scrollbar of the text. namespace upvar ::alited al al obPav obPav if {[info exist al(isSbhText)]} { set wtxt [alited::main::CurrentWTXT] set wfra [$obPav FraSbh] set wsbh [$obPav SbhText] set wrap [$wtxt cget -wrap] if {$wrap eq {word}} { if {$al(isSbhText)} {pack forget $wfra} set al(isSbhText) no } else { if {!$al(isSbhText)} { if {![info exist al(isfindunit)] || !$al(isfindunit)} { pack $wfra -side bottom -fill x -after [$obPav GutText] } else { pack forget [$obPav FraHead] pack $wfra -side bottom -fill x -after [$obPav GutText] pack [$obPav FraHead] -side bottom -fill x -pady 3 -after [$obPav GutText] } } $wtxt configure -xscrollcommand "$wsbh set" $wsbh configure -command "$wtxt xview" set al(isSbhText) yes } } }
Searches a file name in file tree.
| file name |
| returned ID if file name isn't found; optional, default "" |
proc ::alited::file::SearchInFileTree {fname {ID {}}} { # Searches a file name in file tree. # fname - file name # ID - returned ID if file name isn't found set ltree [alited::tree::GetTree] set i [lsearch -exact -index {4 1} $ltree $fname] if {$i>-1} {set res [lindex $ltree $i 2]} {set res $ID} return $res }
Finds a file in file tree and selects it.
| file tree's path |
| file name |
| ID of default item to select (if the file not found) |
proc ::alited::file::SelectFileInTree {wtree fname ID} { # Finds a file in file tree and selects it. # wtree - file tree's path # fname - file name # ID - ID of default item to select (if the file not found) alited::tree::RecreateTree $wtree - SelectInTree $wtree [SearchInFileTree $fname $ID] }
Selects an item in the file tree.
| file tree widget |
| item's id |
proc ::alited::file::SelectInTree {wtree id} { # Selects an item in the file tree. # wtree - file tree widget # id - item's id catch { $wtree selection add $id $wtree see $id } after idle [list after 200 "catch {focus $wtree ; $wtree selection set $id ; $wtree see $id ; $wtree focus $id}"] }
Sorts a list of file tree's selected files.
proc ::alited::file::SortTreeSelFiles {} { # Sorts a list of file tree's selected files. lsort -decreasing -dictionary [TreeSelFiles] }
Sources detached.tcl.
proc ::alited::file::SourceDetach {} { # Sources detached.tcl. if {![namespace exists ::alited::detached]} { namespace eval ::alited { source [file join $SRCDIR detached.tcl] } } }
Checks flag "highlight text anyway".
| text's path |
proc ::alited::file::ToBeHighlighted {wtxt} { # Checks flag "highlight text anyway". # wtxt - text's path namespace upvar ::alited al al return [expr {![info exists al(HL,$wtxt)] || $al(HL,$wtxt) eq {..}}] }
Fetches a file name selected in the file tree.
Returns a list of tree path, name in tree, the file name, its ID in tree, its TID in tabbar.
proc ::alited::file::TreeFilename {} { # Fetches a file name selected in the file tree. # Returns a list of tree path, name in tree, the file name, its ID in tree, its TID in tabbar. namespace upvar ::alited obPav obPav set wtree [$obPav Tree] set ID [$wtree selection] if {[llength $ID]!=1} { alited::msg ok err [msgcat::mc {Select one file in the tree.}] return {} } set name [$wtree item $ID -text] set fname [lindex [$wtree item $ID -values] 1] set TID [alited::bar::FileTID $fname] list $wtree $name $fname $ID $TID }
Gets a list of file tree's selected files.
proc ::alited::file::TreeSelFiles {} { # Gets a list of file tree's selected files. namespace upvar ::alited al al obPav obPav set wtree [$obPav Tree] set fnames [list] foreach selID [$wtree selection] { lassign [$wtree item $selID -values] - fname isfile if {$isfile} {lappend fnames $fname} } return $fnames }
Updates tips in tab bar (file info).
proc ::alited::file::UpdateFileStat {} { # Updates tips in tab bar (file info). foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] set fname [alited::bar::FileName $TID] alited::bar::BAR $TID configure -tip [FileStat $fname] } alited::ini::SaveIni }
Switches wrap word mode for a current text.
| yes, if 'none' wrapping is needed; optional, default no |
proc ::alited::file::WrapLines {{wrapnone no}} { # Switches wrap word mode for a current text. # wrapnone - yes, if 'none' wrapping is needed namespace upvar ::alited al al set wtxt [alited::main::CurrentWTXT] set al(wrapwords) [expr {!$wrapnone && [$wtxt cget -wrap] ne {word}}] if {$al(wrapwords)} { $wtxt configure -wrap word } else { $wtxt configure -wrap none } if {![info exist al(isSbhText)]} {set al(isSbhText) no} SbhText alited::ini::SaveIni }
Creates Find/Replace dialogue.
proc ::alited::find::_create {} { # Creates Find/Replace dialogue. namespace upvar ::alited al al obFND obFND variable win variable geo variable data set data(geoDefault) 0 set data(btTRetry) 0 set w $win.fra lassign [::alited::FgFgBold] - - fgred ::apave::initStyle TButtonRedFS TButtonBoldFS -foreground $fgred $obFND makeWindow $w $al(MC,findreplace) -type dialog $obFND paveWindow $w { {labB1 - - 1 1 {-st es -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Find: " -style TLabelFS}} {Cbx1 + L 1 5 {-st wes -ipadx 0 -padx 0 -ipady 0 -pady 0} {-tvar ::alited::find::data(en1) -values {$::alited::find::data(vals1)}}} {labB2 labB1 T 1 1 {-st es -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Replace: " -style TLabelFS}} {Cbx2 + L 1 4 {-st wes -cw 1 -ipadx 0 -padx 0 -ipady 0 -pady 0} {-tvar ::alited::find::data(en2) -values {$::alited::find::data(vals2)}}} {btTpaste + L 1 1 {-st ws -ipady 0 -pady 0} {-com alited::find::btTPaste -tip "Paste 'Find'\nCtrl+R"}} {labBm labB2 T 1 1 {-st ens -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Match: " -style TLabelFS}} {radA + L 1 1 {-st ens -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Exact" -var ::alited::find::data(v1) -value 1 -style TRadiobuttonFS}} {radB + L 1 1 {-st ns -padx 5 -ipady 0 -pady 0} {-t "Glob" -var ::alited::find::data(v1) -value 2 -tip "Allows to use *, ?, \[ and \]\nin \"find\" string." -style TRadiobuttonFS}} {radC + L 1 1 {-st wns -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "RE" -var ::alited::find::data(v1) -value 3 -tip "Allows to use the regular expressions\nin \"find\" string." -style TRadiobuttonFS}} {ButRE2 + L 1 1 {-st wns} {-t " RE2" -w 4 -com ::alited::find::RE2 -tip "Including / excluding\nregular expressions." -style TButtonWestFS}} {BtTretry + L 1 1 {-st wns -ipady 0 -pady 0} {-com alited::find::btTRetry -tip "Resize"}} {h_2 labBm T 1 6 {-st es -rw 1 -ipadx 0 -padx 0 -ipady 0 -pady 0}} {seh + T 1 6 {-st ews -ipadx 0 -padx 0 -ipady 0 -pady 0}} {chb1 + T 1 2 {-st w -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Match whole word" -var ::alited::find::data(c1) -style TCheckbuttonFS}} {chb2 + T 1 2 {-st w -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Match case" -var ::alited::find::data(c2) -style TCheckbuttonFS}} {chb3 + T 1 2 {-st w -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Replace by blank" -var ::alited::find::data(c3) -tip "Allows replacements by the empty string,\nin fact, to erase the found ones." -style TCheckbuttonFS}} {sev1 chb1 L 4 1 } {rad1 + L 1 2 {-st w -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Up" -image alimg_up -compound left -var ::alited::find::data(v2) -value 1 -style TRadiobuttonFS}} {rad2 + T 1 2 {-st w -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Down" -image alimg_down -compound left -var ::alited::find::data(v2) -value 2 -style TRadiobuttonFS}} {chb4 + T 1 2 {-st w -ipadx 0 -padx 0 -ipady 0 -pady 0} {-t "Wrap" -var ::alited::find::data(c4) -style TCheckbuttonFS}} {sev2 cbx1 L 9 1} {But1 + L 1 1 {-st wes -pady 2} {-t "Find" -com "::alited::find::Find 1" -style TButtonWestBoldFS}} {But2 + T 1 1 {-st we -pady 0} {-t "All in text" -com "::alited::find::FindInText 2" -style TButtonWestFS}} {But3 + T 1 1 {-st wen -pady 2} {-com "::alited::find::FindInSession add 3" -style TButtonWestFS}} {chb + T 2 1 {-st e} {-t {-geometry} -var ::alited::find::data(geoDefault) -tip "Use this geometry of the dialogue\nby default" -takefocus 0 -style TCheckbuttonFS}} {but4 + T 1 1 {-st wes -pady 2} {-t Replace -com "::alited::find::Replace" -style TButtonWestBoldFS}} {but5 + T 1 1 {-st we -pady 0} {-t "All in text" -com "::alited::find::ReplaceInText" -style TButtonWestFS}} {But6 + T 1 1 {-st wen -pady 2} {-com "::alited::find::ReplaceInSession" -style TButtonWestFS}} } SessionButtons styleButtonRE2 set wtxt [alited::main::CurrentWTXT] alited::keys::BindAllKeys $wtxt yes bind $win <Enter> alited::find::SessionButtons bind $win <F1> {alited::main::Help find} bind $win <F3> "$w.but1 invoke" bind $w.cbx1 <Return> "$w.but1 invoke" ;# hotkeys in comboboxes bind $w.cbx2 <Return> "$w.but4 invoke" foreach k {f F} {bind $win <Control-$k> {::alited::find::LastInvoke; break}} foreach k {r R} {bind $win <Control-$k> {::alited::find::btTPaste; break}} foreach k {t T} {bind $win <Control-$k> "focusByForce $wtxt"} FocusCbx set but [$obFND But1] lassign [split [winfo geometry $but] x+] w h set minw [expr {([winfo reqwidth $but]+2)*3}] set minh [expr {([winfo reqheight $but]+2)*3}] $obFND showModal $win -modal no -waitvar no -onclose alited::find::CloseFind -geometry $geo -resizable 1 -minsize "$minw $minh" -ontop $al(topFindRepl) ClearTags }
Runs Find/Replace dialogue.
proc ::alited::find::_run {} { # Runs Find/Replace dialogue. variable win update ;# if run from menu: there may be unupdated space under it (in some DE) GetFindEntry if {[::apave::repaintWindow $win]} { SessionButtons FocusCbx } else { _create } }
Copies text from "Find" to "Replace" field.
proc ::alited::find::btTPaste {} { # Copies text from "Find" to "Replace" field. namespace upvar ::alited obFND obFND variable data if {$data(en1) eq {}} { focus [$obFND Cbx1] bell } else { [$obFND Cbx1] selection clear set data(en2) $data(en1) ::apave::CursorAtEnd [$obFND Cbx2] } }
Resizes Find/Replace dialogue.
proc ::alited::find::btTRetry {} { # Resizes Find/Replace dialogue. namespace upvar ::alited al al obFND obFND variable win variable geo variable data if {[string match root* $geo]} { set geo [wm geometry $win] } if {[incr data(btTRetry)]%2} { lassign [split $geo x+] w1 h1 x1 y1 lassign [split [winfo geometry [$obFND But1]] x+] w2 h2 set w [expr {($w2+2)*5}] ;# "standard" width set h [expr {($h2+2)*7}] ;# "standard" height set sw [expr {$w1-$w}] ;# shift by X set sh [expr {$h1-$h}] ;# shift by Y set x [expr {max(1,$x1+$sw)}] ;# new X coordinate set y [expr {max(1,$y1+$sh)}] ;# new Y coordinate # set "standard" geometry, starting from the default's right-bottom corner wm geometry $win ${w}x${h}+$x+$y } else { # set the default geometry wm geometry $win $geo lassign [split $geo x+] w1 h1 x y } # set the mouse pointer on the button ::apave::MouseOnWidget [$obFND BtTretry] }
Checks if the find/replace data are valid.
| if "repl", checks for "Replace" operation |
Return "yes", if the input data are valid.
proc ::alited::find::CheckData {op} { # Checks if the find/replace data are valid. # op - if "repl", checks for "Replace" operation # Return "yes", if the input data are valid. namespace upvar ::alited al al variable win variable data # this means "no checks when used outside of the dialogue": if {!$data(docheck)} {return yes} # search input data in arrays of combobox values: # if not found, save the data to the arrays set w $win.fra set foc {} foreach i {2 1} { if {[set data(en$i)] ne {}} { if {[set f [lsearch -exact [set data(vals$i)] [set data(en$i)]]]>-1} { set data(vals$i) [lreplace [set data(vals$i)] $f $f] } set data(vals$i) [linsert [set data(vals$i)] 0 [set data(en$i)]] catch {set data(vals$i) [lreplace [set data(vals$i)] $al(INI,maxfind) end]} $w.cbx$i configure -values [set data(vals$i)] } elseif {$i==1 || ($op eq "repl" && !$data(c3))} { set foc $w.cbx$i } } if {$foc ne {}} { # if find/replace field is empty, let the bell tolls for him bell focus $foc return no } return yes }
Check if the found string is a word, at searching by words,
| text widget's path |
| first index of the found string |
| last index of the found string |
| flag "search word only" |
Returns "yes" if the found string is a word.
proc ::alited::find::CheckWord {wtxt index1 index2 wordonly} { # Check if the found string is a word, at searching by words, # wtxt - text widget's path # index1 - first index of the found string # index2 - last index of the found string # wordonly - flag "search word only" # Returns "yes" if the found string is a word. variable adelim if {$wordonly} { set index10 [$wtxt index "$index1 - 1c"] set index20 [$wtxt index "$index2 + 1c"] if {[$wtxt get $index10 $index1] ni $adelim} {return no} if {[$wtxt get $index2 $index20] ni $adelim} {return no} } return yes }
Clears find tags in all texts, if Find dialogues are closed.
proc ::alited::find::ClearTags {} { # Clears find tags in all texts, if Find dialogues are closed. variable win variable win2 if {![winfo exists $win] && ![winfo exists $win2]} { foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] catch {UnsetTags [alited::main::GetWTXT $TID]} } } }
Closes Find/Replace dialogue.
| Optional arguments. |
proc ::alited::find::CloseFind {args} { # Closes Find/Replace dialogue. variable win variable geo variable data catch { if {[string match root=* $geo] || $data(geoDefault)} { set geo [wm geometry $win] ;# save the new geometry of the dialogue } set ::alited::al(topFindRepl) [wm attributes $win -topmost] } catch {destroy $win} ClearTags }
Closes Find by List dialogue.
| Optional arguments. |
proc ::alited::find::CloseFind2 {args} { # Closes Find by List dialogue. namespace upvar ::alited al al obFN2 obFN2 variable geo2 if {[catch {set win2 $al(FN2WINDOW)}]} { set win2 [$obFN2 dlgPath] } set geo2 [wm geometry $win2] destroy $win2 unset -nocomplain al(findSearchByList) ClearTags }
Runs searching units in current text / all texts.
proc ::alited::find::DoFindUnit {} { # Runs searching units in current text / all texts. namespace upvar ::alited al al obPav obPav set ent [$obPav CbxFindSTD] set what [string trim [$ent get]] if {$what eq {} || [regexp {\s} $what]} { alited::Message [msgcat::mc {Incorrect name for a unit.}] 4 return } if {[set i [lsearch -exact $al(findunitvals) $what]]>=0} { set al(findunitvals) [lreplace $al(findunitvals) $i $i] } set al(findunitvals) [linsert $al(findunitvals) 0 $what] catch {set al(findunitvals) [lreplace $al(findunitvals) $al(FAV,MAXLAST) end]} $ent configure -values $al(findunitvals) InitShowResults set n 0 if {$::alited::main::findunits==1} { set tabs [TabsToSearch] } else { set tabs [alited::bar::CurrentTabID] } foreach tab $tabs { set TID [lindex $tab 0] alited::main::GetText $TID no no lassign [alited::FgAdditional] fgbr foreach it $al(_unittree,$TID) { lassign $it lev leaf fl1 title l1 l2 set ttl [string range $title [string last : $title]+1 end] ;# pure name, no NS if {[string match -nocase "*$what*" $ttl]} { set tname [alited::bar::TabName $TID] if {$leaf} {set fg {}} {set fg $fgbr} PutInfo $tname $l1 $title $TID $fg incr n } } } ShowResults [string map [list %n $n %s $what] $al(MC,frres1)] {} -fg }
Fills a text field of RE2 dialog.
| the text's index |
proc ::alited::find::FillRE2Tex {idx} { # Fills a text field of RE2 dialog. # idx - the text's index variable obRE2 set relist [set ::alited::find::${idx}RE2] set tex [$obRE2 Tex$idx] foreach re $relist { $tex insert end $re\n } }
Searches one string in a current text.
| index of a button that was hit (1 means "Find" button); optional, default -1 |
Returns yes, if a string is found.
proc ::alited::find::Find {{inv -1}} { # Searches one string in a current text. # inv - index of a button that was hit (1 means "Find" button) # Returns yes, if a string is found. namespace upvar ::alited obFND obFND variable data set wtxt [alited::main::CurrentWTXT] $wtxt tag remove sel 1.0 end set fndlist [Search $wtxt] if {![llength $fndlist]} { focus [$obFND Cbx1] NotFoundMessage $data(en1) return no } set res no set indexprev [set indexnext 0] set index [$wtxt index insert] foreach idx12 $fndlist { lassign $idx12 index1 index2 $wtxt tag add fndTag $index1 $index2 if {[$wtxt compare $index1 < $index]} { set indexprev $index1 set indp2 $index2 } if {[$wtxt compare $index < $index1] && $indexnext==0} { set indexnext $index1 set indn2 $index2 } } if {$data(c4) && $data(v2)==1} { ;# search backward & wrap around if {!$indexprev} {lassign [lindex $fndlist end] indexprev indp2} ::tk::TextSetCursor $wtxt $indexprev $wtxt tag add sel $indexprev $indp2 set res yes } elseif {$data(c4) && $data(v2)==2} { ;# search forward & wrap around if {!$indexnext || ([lindex $fndlist end 0]==$indexnext && [$wtxt compare $indexnext == $index])} { lassign [lindex $fndlist 0] indexnext indn2 } ::tk::TextSetCursor $wtxt $indexnext $wtxt tag add sel $indexnext $indn2 set res yes } elseif {!$data(c4) &&$data(v2)==1} { ;# search backward & not wrap around if {$indexprev} { ::tk::TextSetCursor $wtxt $indexprev $wtxt tag add sel $indexprev $indp2 set res yes } } elseif {!$data(c4) && $data(v2)==2} { ;# search forward & not wrap around if {$indexnext} { ::tk::TextSetCursor $wtxt $indexnext $wtxt tag add sel $indexnext $indn2 set res yes } } ::alited::main::CursorPos $wtxt if {$inv>-1} alited::main::HighlightLine return $res }
Searches all strings in a text.
| text widget's path |
| tab's ID |
| if "add", means "add find tag to the found strings of the text" optional, default add |
proc ::alited::find::FindAll {wtxt TID {tagme add}} { # Searches all strings in a text. # wtxt - text widget's path # TID - tab's ID # tagme - if "add", means "add find tag to the found strings of the text" set tname [alited::bar::TabName $TID] set l1 -1 set allfnd [Search $wtxt] foreach idx12 $allfnd { lassign $idx12 index1 index2 if {$tagme eq {add}} {$wtxt tag add fndTag $index1 $index2} set l2 [expr {int($index1)}] if {$l1 != $l2} { set line [$wtxt get "$index1 linestart" "$index1 lineend"] PutInfo $tname $l2 [string trim $line] $TID set l1 $l2 } } return $allfnd }
Searches all strings in a session.
| if "add", means "add find tag to the found strings of the text" optional, default add |
| index of a button that was hit (3 means "All in session" button); optional, default -1 |
proc ::alited::find::FindInSession {{tagme add} {inv -1}} { # Searches all strings in a session. # tagme - if "add", means "add find tag to the found strings of the text" # inv - index of a button that was hit (3 means "All in session" button) variable data if {![CheckData find]} return if {$inv>-1} {set data(lastinvoke) $inv} InitShowResults set allfnd [list] set data(_ERR_) no foreach tab [TabsToSearch - $::alited::al(lifo)] { set TID [lindex $tab 0] lassign [alited::main::GetText $TID no no] curfile wtxt lappend allfnd {*}[FindAll $wtxt $TID $tagme] if {$data(_ERR_)} break } ShowResults1 $allfnd }
Searches all strings in a current text.
| index of a button that was hit (2 means "All in text" button); optional, default -1 |
proc ::alited::find::FindInText {{inv -1}} { # Searches all strings in a current text. # inv - index of a button that was hit (2 means "All in text" button) variable data if {$inv>-1} {set data(lastinvoke) $inv} alited::info::Clear set wtxt [alited::main::CurrentWTXT] set TID [alited::bar::CurrentTabID] ShowResults1 [FindAll $wtxt $TID] }
Performs "find next" (F3 key) for the current text.
proc ::alited::find::FindNext {} { # Performs "find next" (F3 key) for the current text. namespace upvar ::alited al al obPav obPav variable data variable win set wtxt [alited::main::CurrentWTXT] alited::Message {} lassign [$obPav findInText 1 $wtxt {} no] res what if {!$res && [winfo exists $win]} { set res [Find] ;# go to the next by "Find" set what $data(en1) } if {!$res} {NotFoundMessage $what} }
Gets options of search, according to the dialogue's fields.
| text widget's path |
proc ::alited::find::FindOptions {wtxt} { # Gets options of search, according to the dialogue's fields. # wtxt - text widget's path variable data UnsetTags $wtxt set options [set stopidx {}] set findstr $data(en1) if {!$data(c2)} {append options {-nocase }} # glob search - through its regexp switch $data(v1) { 2 { append options {-regexp } set findstr [string map {* .* ? . . \\. \{ \\\{ \} \\\} ( \\( ) \\) ^ \\^ \$ \\\$ - \\- + \\+} $findstr] } 3 { append options {-regexp }} default { append options {-exact }} } list $findstr [string trim $options] $stopidx }
Prepares a string to find/replace for messages.
| string to prepare |
proc ::alited::find::FindReplStr {str} { # Prepares a string to find/replace for messages. # str - string to prepare set res [string range $str 0 50] if {$res ne $str} {append res { ...}} return $res }
Displays "Find unit" frame.
proc ::alited::find::FindUnit {} { # Displays "Find unit" frame. namespace upvar ::alited al al obPav obPav set ent [$obPav CbxFindSTD] if {[set word [GetWordOfText]] ne {}} { set al(findunit) $word } if {![info exist al(isfindunit)] || !$al(isfindunit)} { set al(isfindunit) true pack [$obPav FraHead] -side bottom -fill x -pady 3 -after [$obPav GutText] foreach k {f F} {bind $ent <Shift-Control-$k> {alited::find::DoFindUnit; break}} bind $ent <Return> alited::find::DoFindUnit bind $ent <Escape> {::alited::find::HideFindUnit; break} } focus $ent after idle "$ent selection range 0 end" }
Forces focusing on "Find" field.
proc ::alited::find::FocusCbx {} { # Forces focusing on "Find" field. variable win if {[winfo ismapped $win]} {set t 1} {set t 100} after idle [list after $t [list alited::find::FocusCbx1 $t "wm deiconify $win"]] }
Set focus on "Find" field.
| idle/msec for "after" optional, default idle |
| deiconify command; optional, default "" |
proc ::alited::find::FocusCbx1 {{aft idle} {deico {}}} { # Set focus on "Find" field. # aft - idle/msec for "after" # deico - deiconify command namespace upvar ::alited obFND obFND {*}$deico set cbx [$obFND Cbx1] after $aft "focus -force $cbx; $cbx selection range 0 end ; $cbx icursor end" }
Gets a command from a line.
| the line |
| a column of the line |
| list of word delimiters; optional, default "" |
| if it ends with "2", the result includes a range of found string; optional, default "" |
proc ::alited::find::GetCommandOfLine {line idx {delim {}} {mode {}}} { # Gets a command from a line. # line - the line # idx - a column of the line # delim - list of word delimiters # mode - if it ends with "2", the result includes a range of found string. variable ldelim variable rdelim if {$delim ne {}} { set delim1 $delim set delim2 $delim } else { set delim1 $ldelim set delim2 $rdelim } set i1 [set i2 [string range $idx [string first . $idx]+1 end]] for {set i $i1} {1} {} { incr i -1 if {[string index $line $i] in $delim1} { set i1 [expr {$i+1}] break } } for {set i $i1} {1} {} { incr i if {[string index $line $i] in $delim2} { set i2 [expr {$i-1}] break } } set res [string trim [string range $line $i1 $i2]] if {[string index $mode end] eq "2"} { set res [list $res $i1 $i2] } return $res }
Gets a command under the cursor.
| text widget's path |
| if it ends with "2", the result includes a range of found string; optional, default "" |
proc ::alited::find::GetCommandOfText {wtxt {mode {}}} { # Gets a command under the cursor. # wtxt - text widget's path # mode - if it ends with "2", the result includes a range of found string set idx [$wtxt index insert] set line [$wtxt get "$idx linestart" "$idx lineend"] list [GetCommandOfLine $line $idx "" $mode] $idx }
Puts a current selection of text to the "Find:" field
proc ::alited::find::GetFindEntry {} { # Puts a current selection of text to the "Find:" field variable data set wtxt [alited::main::CurrentWTXT] if {[catch {set sel [$wtxt get sel.first sel.last]}]} { set idx [$wtxt index insert] set line [$wtxt get "$idx linestart" "$idx lineend"] set sel [GetWordOfLine $line $idx] } if {$sel ne {}} {set data(en1) $sel} }
Gets a word from a line.
| the line |
| a column of the line |
| if it ends with "2", the result includes a range of found string; optional, default "" |
proc ::alited::find::GetWordOfLine {line idx {mode {}}} { # Gets a word from a line. # line - the line # idx - a column of the line # mode - if it ends with "2", the result includes a range of found string. variable adelim return [GetCommandOfLine $line $idx $adelim $mode] }
Gets a word of text under the cursor.
| if "select", try to get the word from a line with a selection; optional, default "" |
| if no word found and the cursor is set on $, get "$" as the word; optional, default no |
If 'mode' ends with "2", the result includes a range of found string.
proc ::alited::find::GetWordOfText {{mode {}} {getdollar no}} { # Gets a word of text under the cursor. # mode - if "select", try to get the word from a line with a selection # getdollar - if no word found and the cursor is set on $, get "$" as the word # If 'mode' ends with "2", the result includes a range of found string. set wtxt [alited::main::CurrentWTXT] if {$mode in {noselect noselect2} || [catch {set sel [$wtxt get sel.first sel.last]}]} { set idx [$wtxt index insert] set line [$wtxt get "$idx linestart" "$idx lineend"] set sel [GetWordOfLine $line $idx $mode] if {$getdollar && [lindex $sel 0] eq {}} { set idx [$wtxt index "insert -1 c"] if {[$wtxt get $idx] eq "\$"} { set sel "\$ [lrange $sel 1 end]" } } } elseif {[string index $mode end] eq "2"} { set sel [list $sel] } return $sel }
Helps on search by list.
| help's suffix |
proc ::alited::find::HelpFind {suff} { # Helps on search by list. # suff - help's suffix alited::Help [apave::dlgPath] $suff }
Hides "Find unit" frame.
proc ::alited::find::HideFindUnit {} { # Hides "Find unit" frame. namespace upvar ::alited al al obPav obPav set al(isfindunit) no pack forget [$obPav FraHead] focus [alited::main::CurrentWTXT] }
Clears the info list before any search.
proc ::alited::find::InitShowResults {} { # Clears the info list before any search. namespace upvar ::alited al al alited::info::Clear alited::info::Put $al(MC,wait) {} yes yes update }
Invokes last Find button that was pressed. If Ctrl-F is pressed inside Find/Replace dialogue, the last pressed Find button will be invoked.
proc ::alited::find::LastInvoke {} { # Invokes last Find button that was pressed. # If Ctrl-F is pressed inside Find/Replace dialogue, the last # pressed Find button will be invoked. namespace upvar ::alited obFND obFND variable data [$obFND But$data(lastinvoke)] invoke }
Prepares and runs searching a declaration in a text.
| the text's path; optional, default "" |
proc ::alited::find::LookDecl {{wtxt {}}} { # Prepares and runs searching a declaration in a text. # wtxt - the text's path namespace upvar ::alited al al obPav obPav # switch to the unit tree: 1st to enable the search, 2nd to show units found & selected if {!$al(TREE,isunits)} alited::tree::SwitchTree lassign [LookDecl1 $wtxt yes] found TID what if {$found eq {}} { # if the qualified not found, try to find the non-qualified (first encountered) lassign [LookDecl1 $wtxt no] found TID } if {$found ne {}} { alited::main::SaveVisitInfo alited::favor::SkipVisited yes alited::bar::BAR $TID show after idle " alited::main::FocusText $TID $found.0 ; alited::tree::NewSelection ; alited::main::SaveVisitInfo" } else { set msg [string map [list %u $what] $al(MC,notfndunit)] alited::Message $msg 4 } }
Searches a declaration in a text.
| the text's path |
| flag "search a qualified unit name" |
proc ::alited::find::LookDecl1 {wtxt isNS} { # Searches a declaration in a text. # wtxt - the text's path # isNS - flag "search a qualified unit name" namespace upvar ::alited al al if {$wtxt eq ""} {set wtxt [alited::main::CurrentWTXT]} lassign [GetCommandOfText $wtxt] com1 idx if {$com1 eq {}} {bell; return {}} set com2 $com1 set withNS [expr {[set i [string last ":" $com1]]>-1}] if {!$isNS} { # try to find the pure (not qualified) name set com2 [string range $com1 $i+1 end] } elseif {!$withNS} { # try to get the current unit's namespace set curr [lindex [alited::tree::CurrentItemByLine $idx yes] 4] set com2 [string cat [string range $curr 0 [string last ":" $curr]] $com1] } set tab [alited::bar::CurrentTabID] if {$isNS} { # search a qualified name: beginning from the current tab set tabs [TabsToSearch $tab] if {$withNS} {set what "*$com2"} {set what " $com2"} } else { # search a non-qualified name: in the current tab only set what "*::$com2" set tabs $tab } foreach tab $tabs { set TID [lindex $tab 0] alited::main::GetText $TID no no foreach it $al(_unittree,$TID) { lassign $it lev leaf fl1 ttl l1 l2 if {$leaf} { if {[string match $what $ttl] || [string match "*::$ttl" $com2] || $com2 eq $ttl} { return [list $l1 $TID $what] } } } } return [list {} {} [string range $what 1 end]] }
Generate F3 key pressing event.
proc ::alited::find::Next {} { # Generate F3 key pressing event. catch {event generate [alited::main::CurrentWTXT] <[alited::pref::BindKey 12 - F3]>} }
Finds next occurence of found strings.
| if yes, focuses on "First by List" dialogue, otherwise the text is focused; optional, default yes |
proc ::alited::find::NextFoundByList {{focusDLG yes}} { # Finds next occurence of found strings. # focusDLG - if yes, focuses on "First by List" dialogue, otherwise the text is focused namespace upvar ::alited obFN2 obFN2 set wtxt [alited::main::CurrentWTXT] set pos0 [$wtxt tag nextrange fndTag 1.0] if {$pos0 eq {}} { SearchByList_Do no set pos0 [$wtxt tag nextrange fndTag 1.0] } set pos [$wtxt index insert] set nextpos [$wtxt tag nextrange fndTag "$pos + 1c"] if {$nextpos eq {}} {set nextpos $pos0} if {$nextpos eq {}} { bell } else { alited::main::FocusText [alited::bar::CurrentTabID] [lindex $nextpos 0] $wtxt tag remove sel 1.0 end $wtxt tag add sel {*}$nextpos } if {$focusDLG} { if {$nextpos eq {}} { focus [$obFN2 Text] } else { focus [$obFN2 ButDown] } } }
Shows "not found" message.
| what's not found |
proc ::alited::find::NotFoundMessage {what} { # Shows "not found" message. # what - what's not found set msg [msgcat::mc {Not found: %s}] alited::Message [string map [list %s $what] $msg] 4 }
Saves data, closes RE2 dialogue.
proc ::alited::find::OKRE2 {} { # Saves data, closes RE2 dialogue. variable winRE2 variable obRE2 variable InRE2 variable ExRE2 variable geoRE2 set InRE2 [set ExRE2 [list]] foreach idx {In Ex} { foreach line [split [[$obRE2 Tex$idx] get 1.0 end] \n] { if {[string trim $line] ne {}} { lappend ${idx}RE2 $line if {![skipRE2 $line] && ![stopRE2 $line] && [catch {regexp $line foo} err]} { alited::Message "$err : $line" 4 return } } } } styleButtonRE2 set geoRE2 [wm geometry $winRE2] $obRE2 res $winRE2 1 }
Prepares searched word by list and search options.
| searched word |
proc ::alited::find::PrepareSearchByList {findstr} { # Prepares searched word by list and search options. # findstr - searched word namespace upvar ::alited al al if {!$al(caseSBL)} {append options {-nocase }} # glob search - through its regexp switch $al(matchSBL) { Glob { append options {-regexp } set findstr [string map {* .* ? . . \\. \{ \\\{ \} \\\} ( \\( ) \\) ^ \\^ \$ \\\$ - \\- + \\+} $findstr] } RE { append options {-regexp } } default { append options {-exact }} } list $findstr $options }
Puts a message to the info listbox widget, about a line found in a file.
| the file's name |
| the line's number |
| found info |
| tab's ID of the file |
| color of the message; optional, default "" |
proc ::alited::find::PutInfo {fname line info TID {fg {}}} { # Puts a message to the info listbox widget, about a line found in a file. # fname - the file's name # line - the line's number # info - found info # TID - tab's ID of the file # fg - color of the message # See also: info::Put set msg "$fname $line: $info" set dat [list $TID $line] alited::info::Put $msg $dat no no no $fg }
RE2 dialogue.
proc ::alited::find::RE2 {} { # RE2 dialogue. namespace upvar ::alited al al variable win variable winRE2 variable obRE2 variable chInRE2 variable chExRE2 variable geoRE2 if {[winfo exists $winRE2]} { focus $winRE2 focus [$obRE2 TexIn] return } catch {$obRE2 destroy} set savInRE2 $chInRE2 set savExRE2 $chExRE2 ::apave::APave create $obRE2 $winRE2 $obRE2 makeWindow $winRE2.fra RE2 $obRE2 paveWindow $winRE2.fra { {h_ - - 1 5} {chbIn T + 1 1 {-st w} {-t {Including RE2:} -var ::alited::find::chInRE2}} {fra1 + T 1 5 {-st nsew -cw 1 -rw 1}} {.TexIn - - - - {pack -side left -fill both -expand 1} {-w 40 -h 6 -afteridle {alited::find::FillRE2Tex In} -tabnext *texEx}} {.sbv + L - - {pack -side left}} {seh3 fra1 T 1 5 {-pady 5}} {chbEx + T 1 5 {-st w} {-t {Excluding RE2:} -var ::alited::find::chExRE2}} {fra2 + T 1 5 {-st nsew -cw 1 -rw 1}} {.TexEx - - - - {pack -side left -fill both -expand 1} {-w 40 -h 6 -afteridle {alited::find::FillRE2Tex Ex} -tabnext *OK}} {.sbv + L - - {pack -side left}} {seh2 fra2 T 1 5 {-pady 5}} {ButHelp + T 1 1 {-st w -padx 2} {-t Help -com {alited::find::HelpFind 3}}} {h_2 + L 1 2 {-st ew}} {fra3 + L 1 2 {-st e}} {.butOK - - 1 1 {-padx 2} {-t OK -com alited::find::OKRE2}} {.butCancel + L 1 1 {-padx 2} {-t Cancel -com {$::alited::find::obRE2 res $::alited::find::winRE2 0}}} } bind $winRE2 <F1> "[$obRE2 ButHelp] invoke" if {$geoRE2 eq {}} {set geo "-parent $al(WIN)"} {set geo "-geometry $geoRE2"} set res [$obRE2 showModal $winRE2 -onclose destroy -focus [$obRE2 TexIn] -resizable 1 -minsize {400 200} {*}$geo] if {!$res} { set chInRE2 $savInRE2 set chExRE2 $savExRE2 } catch {destroy $winRE2} catch {$obRE2 destroy} }
Replaces one string and finds next.
proc ::alited::find::Replace {} { # Replaces one string and finds next. variable data if {![CheckData repl]} return set wtxt [alited::main::CurrentWTXT] set pos [$wtxt index insert] set isset no lassign [$wtxt tag ranges sel] idx1 idx2 if {$pos eq $idx1} { lassign [Search1 $wtxt $pos] err fnd if {$err} return foreach index1 $fnd { if {$index1 eq $pos} { set isset yes break } } } if {!$isset} Find lassign [$wtxt tag ranges sel] idx1 idx2 if {$idx1 ne {} && $idx2 ne {}} { Replace1 $wtxt $idx1 $idx2 SetCursor $wtxt $idx1 set msg [string map [list %n 1 %s $data(en1) %r $data(en2)] $::alited::al(MC,frres2)] ShowResults $msg alited::main::UpdateTextGutterTree } Find }
Replaces a string found, possibly using regsub.
| text's path |
| starting index of the string |
| ending index of the string |
proc ::alited::find::Replace1 {wtxt idx1 idx2} { # Replaces a string found, possibly using regsub. # wtxt - text's path # idx1 - starting index of the string # idx2 - ending index of the string variable data if {$data(v1)==3} { set replstr [regsub $data(en1) [$wtxt get $idx1 $idx2] $data(en2)] } else { set replstr $data(en2) } $wtxt replace $idx1 $idx2 $replstr }
Replaces all found strings in a text.
| tab's ID |
| text's path |
| list of found strings data (index1, index2) |
proc ::alited::find::ReplaceAll {TID wtxt allfnd} { # Replaces all found strings in a text. # TID - tab's ID # wtxt - text's path # allfnd - list of found strings data (index1, index2) undoIn $wtxt set rn 0 for {set i [llength $allfnd]} {$i} {} { if {!$rn} { if {$TID ni [alited::bar::BAR listFlag m]} { alited::edit::BackupFile $TID orig } } incr i -1 lassign [lindex $allfnd $i] idx1 idx2 Replace1 $wtxt $idx1 $idx2 incr rn } if {$rn} {SetCursor $wtxt [lindex $allfnd end 0]} undoOut $wtxt return $rn }
Handles hitting "Replace in Session" button.
proc ::alited::find::ReplaceInSession {} { # Handles hitting "Replace in Session" button. namespace upvar ::alited al al variable data if {![CheckData repl]} return if {[set llen [llength [alited::bar::BAR listFlag s]]]>1} { set S " ($llen) " } else { set S " " } set msg [string map [list %s [FindReplStr $data(en1)] %r [FindReplStr $data(en2)] %S $S] $al(MC,frdoit2)] if {![alited::msg yesno warn $msg YES]} { return {} } set rn 0 set waseditcurr no set data(_ERR_) no foreach tab [TabsToSearch - $al(lifo)] { set TID [lindex $tab 0] lassign [alited::main::GetText $TID no no] curfile wtxt if {[set rdone [ReplaceAll $TID $wtxt [Search $wtxt]]]} { ShowResults2 $rdone $al(MC,frres2) $TID incr rn $rdone alited::bar::BAR markTab $TID if {$wtxt eq [alited::main::CurrentWTXT]} { set waseditcurr yes ;# update the current text's view only } } if {$data(_ERR_)} break } ShowResults2 $rn $al(MC,frres3) if {$waseditcurr} { alited::main::UpdateTextGutterTreeIcons } elseif {$rn} { alited::main::UpdateIcons } }
Handles hitting "Replace in Text" button.
proc ::alited::find::ReplaceInText {} { # Handles hitting "Replace in Text" button. namespace upvar ::alited al al variable data if {![CheckData repl]} return set fname [file tail [alited::bar::FileName]] set msg [string map [list %f $fname %s [FindReplStr $data(en1)] %r [FindReplStr $data(en2)]] $al(MC,frdoit1)] if {![alited::msg yesno warn $msg YES]} { return {} } set wtxt [alited::main::CurrentWTXT] set TID [alited::bar::CurrentTabID] set rn [ReplaceAll $TID $wtxt [Search $wtxt]] ShowResults2 $rn $al(MC,frres2) alited::main::UpdateTextGutterTree }
Searches a text for a string to find.
| text widget's path |
proc ::alited::find::Search {wtxt} { # Searches a text for a string to find. # wtxt - text widget's path namespace upvar ::alited obPav obPav variable counts variable data variable InRE2 variable ExRE2 variable chInRE2 variable chExRE2 set idx [$wtxt index insert] lassign [FindOptions $wtxt] findstr options if {![CheckData find]} {return {}} $obPav set_HighlightedString $findstr SetTags $wtxt lassign [Search1 $wtxt 1.0] err fnd if {$err} {return {}} set i 0 set res [list] foreach index1 $fnd { set index2 [$wtxt index "$index1 + [lindex $counts $i]c"] if {[CheckWord $wtxt $index1 $index2 $data(c1)]} { set strfound [$wtxt get $index1 $index2] set OK yes if {$chExRE2} { foreach re $ExRE2 { if {[stopRE2 $re]} break if {[skipRE2 $re]} continue set err [catch {set ok [regexp $re $strfound]}] if {$err || $ok} {set OK no; break} ;# anyone excludes } } if {$OK && $chInRE2} { foreach re $InRE2 { if {[stopRE2 $re]} break if {[skipRE2 $re]} continue set OK no set err [catch {set ok [regexp $re $strfound]}] if {!$err && $ok} {set OK yes; break} ;# anyone includes } } if {$OK} {lappend res [list $index1 $index2]} } incr i } return $res }
Searches a text from a position for a string to find.
| text widget's path |
| position to start searching from |
proc ::alited::find::Search1 {wtxt pos} { # Searches a text from a position for a string to find. # wtxt - text widget's path # pos - position to start searching from variable win variable data lassign [FindOptions $wtxt] findstr options if {[catch {set fnd [$wtxt search {*}$options -count ::alited::find::counts -all -- $findstr $pos]} err]} { alited::msg ok err $err -ontop yes -parent $win set data(_ERR_) yes return [list 1 {}] } return [list 0 $fnd] }
Searches words by list.
proc ::alited::find::SearchByList {} { # Searches words by list. namespace upvar ::alited al al obFN2 obFN2 set al(findSearchByList) {} variable win2 variable geo2 set head [msgcat::mc { Enter a list of words divided by spaces:}] set text [::alited::ProcEOL $al(listSBL) in] if {$al(matchSBL) eq {}} {set al(matchSBL) $al(MC,frExact)} after idle [list catch {set ::alited::al(FN2WINDOW) $::apave::MODALWINDOW}] set headfont [$obFN2 boldDefFont] $obFN2 makeWindow $win2.fra [msgcat::mc {Find by List}] $obFN2 paveWindow $win2.fra { {labhead - - 1 5 {} {-t "$head" -font "$headfont"}} {lab1 + T 1 1 {-st en -padx 5} {-t List:}} {fra1 + L 1 4 {-st nsew -rw 1}} {.Text + L - - {pack -side left -expand 1 -fill both} {-w 30 -h 5 -tabnext {*rad1 *CANCEL}}} {.sbvText + L - - pack} {seh1 lab1 T 1 5} {lab2 + T 1 1 {-st e -padx 5} {-t "$al(MC,frMatch)"}} {fra2 + L 1 4 {-st w}} {.rad1 - - 1 1 {} {-var ::alited::al(matchSBL) -value "$al(MC,frExact)" -t "$al(MC,frExact)"}} {.rad2 + L 1 1 {-padx 10} {-var ::alited::al(matchSBL) -value Glob -t Glob}} {.rad3 + L 1 1 {} {-var ::alited::al(matchSBL) -value RE -t RE}} {seh2 lab2 T 1 5} {lab3 + T 1 1 {-st e -padx 5} {-t "$al(MC,frWord):"}} {fra3 + L 1 3 {-st we}} {.chb1 - - 1 1 {-st w} {-var ::alited::al(wordonlySBL)}} {.lab4 + L 1 1 {-st e -padx 5} {-t "$al(MC,frCase):"}} {.chb2 + L 1 1 {-st w} {-var ::alited::al(caseSBL)}} {seh3 lab3 T 1 5} {butHelp + T 1 1 {-st w} {-t Help -com {alited::find::HelpFind 2}}} {h_ + L 1 1 {-st ew -cw 1}} {butFind + L 1 1 {} {-t Find -com ::alited::find::SearchByList_Do}} {ButDown + L 1 1 {} {-t {Find Next} -com ::alited::find::NextFoundByList}} {butCancel + L 1 1 {} {-t Cancel -com alited::find::CloseFind2}} } set wtxt [$obFN2 Text] after idle [list $obFN2 displayText $wtxt $text] after 300 focus $wtxt bind $win2 <F3> "[$obFN2 ButDown] invoke" $obFN2 showModal $win2 -modal no -waitvar no -onclose alited::find::CloseFind2 -geometry $geo2 -resizable 1 -minsize {200 200} }
Does searching words by list.
| if yes, shows results; optional, default yes |
proc ::alited::find::SearchByList_Do {{show yes}} { # Does searching words by list. # show - if yes, shows results namespace upvar ::alited al al obFN2 obFN2 variable counts set list [[$obFN2 Text] get 1.0 end] if {[set al(listSBL) [string trim $list]] eq {}} { bell focus [$obFN2 Text] return } set found [set notfound [list]] set wtxt [alited::main::CurrentWTXT] set list [string map {\n { }} $al(listSBL)] set al(findSearchByList) $wtxt SetTags $wtxt UnsetTags $wtxt foreach findword [split $list] { lassign [PrepareSearchByList $findword] findstr options if {[catch {set fnd [$wtxt search {*}$options -count ::alited::find::counts -all -- $findstr 1.0]} err]} { alited::Message $err 4 break } if {[llength $fnd]} { set i [set wasfound 0] foreach index1 $fnd { set index2 [$wtxt index "$index1 + [lindex $counts $i]c"] if {[CheckWord $wtxt $index1 $index2 $al(wordonlySBL)]} { set wasfound 1 set word [$wtxt get $index1 $index2] if {[lsearch -exact $found $word]==-1} { lappend found $word } $wtxt tag add fndTag $index1 $index2 } incr i } if {!$wasfound} {lappend notfound $findword} } else { lappend notfound $findword } } if {$show} { alited::msg ok info "[msgcat::mc FOUND:]\n$found\n[string repeat _ 50] \n\n[msgcat::mc {NOT FOUND:}]\n$notfound\n" -text 1 -w {40 70} -h {10 20} -resizable 1 } }
proc ::alited::find::SearchWordInSession {} { variable data set saven1 $data(en1) ;# field "Find" set savv1 $data(v1) ;# rad "Exact" set savc1 $data(c1) ;# chb "Word only" set savc2 $data(c2) ;# chb "Case Sensitive" if {[set data(en1) [GetWordOfText select]] eq ""} { bell } else { set wtxt [alited::main::CurrentWTXT] if {[catch {set sel [$wtxt get sel.first sel.last]}] || $sel eq ""} { set data(c1) 1 } else { set data(c1) 0 ;# if selected, let it be looked for (at "not word only") } set data(v1) 1 set data(c2) 1 set data(docheck) no ;# no checks - no usage of the dialogue's widgets FindInSession notag set data(docheck) yes } set data(en1) $saven1 set data(v1) $savv1 set data(c1) $savc1 set data(c2) $savc2 }
Prepares buttons' label ("in all/selected tabs").
proc ::alited::find::SessionButtons {} { # Prepares buttons' label ("in all/selected tabs"). namespace upvar ::alited al al obFND obFND if {[set llen [llength [alited::bar::BAR listFlag s]]]>1} { set btext [string map [list %n $llen] [msgcat::mc {All in %n Files}]] } else { set btext [msgcat::mc {All in session}] } [$obFND But3] configure -text $btext [$obFND But6] configure -text $btext }
Sets the cursor in a text after a replacement made.
| text's path |
| starting index of the replacement |
proc ::alited::find::SetCursor {wtxt idx1} { # Sets the cursor in a text after a replacement made. # wtxt - text's path # idx1 - starting index of the replacement variable data set len [string length $data(en2)] ::tk::TextSetCursor $wtxt [$wtxt index "$idx1 + ${len}c"] ::alited::main::CursorPos $wtxt }
Adds a tag of found strings to a text widget.
| path to the text |
proc ::alited::find::SetTags {wtxt} { # Adds a tag of found strings to a text widget. # wtxt - path to the text namespace upvar ::alited obPav obPav if {[$obPav csDark]} { set fg white set bg #1c1cff } else { set fg black set bg #8fc7ff } $wtxt tag configure fndTag -borderwidth 1 -relief raised -foreground $fg -background $bg $wtxt tag lower fndTag sel }
Shows a message containing results of a search.
| the message |
| tab's ID where the searches were performed in; optional, default "" |
| color for infobar; optional, default "" |
proc ::alited::find::ShowResults {msg {TID {}} {fg {}}} { # Shows a message containing results of a search. # msg - the message # TID - tab's ID where the searches were performed in # fg - color for infobar set tname [alited::bar::TabName $TID] set msg [string map [list %f $tname] $msg] # results in info list: alited::info::Put $msg {} yes no no $fg # results in status bar: alited::Message "$msg [string repeat { } 40]" 3 # update line numbers of current file, as they are gone after the search after idle " alited::main::CursorPos [alited::main::CurrentWTXT] ; alited::main::UpdateGutter" }
Shows a message of all found strings.
| list of search results |
proc ::alited::find::ShowResults1 {allfnd} { # Shows a message of all found strings. # allfnd - list of search results variable data ShowResults [string map [list %n [llength $allfnd] %s $data(en1)] $::alited::al(MC,frres1)] }
Shows a message of number of found strings (e.g. in a tab).
| number of found strings |
| message's template |
| tab's ID where the searches were performed in; optional, default "" |
proc ::alited::find::ShowResults2 {rn msg {TID {}}} { # Shows a message of number of found strings (e.g. in a tab). # rn - number of found strings # msg - message's template # TID - tab's ID where the searches were performed in namespace upvar ::alited al al variable data set tn [alited::bar::TabName $TID] ShowResults [string map [list %n $rn %s $data(en1) %r $data(en2) %f $tn] $msg] 3 }
Checks if a RE2 line has to be skipped.
| the line |
proc ::alited::find::skipRE2 {line} { # Checks if a RE2 line has to be skipped. # line - the line return [regexp {^\s*[*]+[^*]+} $line] }
Checks if a text line stops RE2 list.
| the line |
proc ::alited::find::stopRE2 {line} { # Checks if a text line stops RE2 list. # line - the line return [regexp {^\s*[*]+\s*$} $line] }
Gets RE2 button styled.
proc ::alited::find::styleButtonRE2 {} { # Gets RE2 button styled. namespace upvar ::alited obFND obFND variable InRE2 variable ExRE2 variable chInRE2 variable chExRE2 set style TButtonWestFS foreach idx {In Ex} { if {[set ch${idx}RE2]} { foreach line [set ${idx}RE2] { if {[string trim $line] ne {}} { if {[stopRE2 $line]} break if {[skipRE2 $line]} continue set style TButtonRedFS } } } } [$obFND ButRE2] configure -style $style }
Gets a list of tabs to search something, beginning from a current tab.
| the current tab; optional, default - |
| if yes, search first in a current tab; optional, default yes |
proc ::alited::find::TabsToSearch {{tab -} {cur1st yes}} { # Gets a list of tabs to search something, beginning from a current tab. # tab - the current tab # cur1st - if yes, search first in a current tab if {$tab eq {-}} {set tab [alited::bar::CurrentTabID]} set tabs [alited::SessionList] if {$cur1st && [set i [lsearch -exact -index 0 $tabs $tab]]>0} { set tabs [linsert [lreplace $tabs $i $i] 0 $tab] } return $tabs }
Clears the text of the find tag.
| text's path; optional, default "" |
proc ::alited::find::UnsetTags {{wtxt {}}} { # Clears the text of the find tag. # wtxt - text's path if {$wtxt eq {}} {set wtxt [alited::main::CurrentWTXT]} $wtxt tag remove fndTag 1.0 end }
Actions after formatting: replace & update all & select the formatted stuff.
| text's path |
| 1st position formatted |
| last position formatted |
| content formatted |
proc ::alited::format::AfterFormatting {wtxt pos1 pos2 value} { # Actions after formatting: # replace & update all & select the formatted stuff. # wtxt - text's path # pos1 - 1st position formatted # pos2 - last position formatted # value - content formatted # See also: BeforeFormatting variable valueOrig if {$valueOrig ne $value} { $wtxt replace $pos1 $pos2 $value } alited::main::UpdateAll focusByForce $wtxt $wtxt tag remove sel 1.0 set nch [string length $value] $wtxt tag add sel $pos1 "$pos1 +$nch chars" }
Gets option for formatting - text's path, selected text and positions to process.
| yes, if positions are lines' start and end; optional, default no |
Also, sets valueOrig to the original contents of selected text.
proc ::alited::format::BeforeFormatting {{islines no}} { # Gets option for formatting - text's path, selected text and positions to process. # islines - yes, if positions are lines' start and end # Also, sets valueOrig to the original contents of selected text. # See also: AfterFormatting variable valueOrig set wtxt [alited::main::CurrentWTXT] set selection [$wtxt tag ranges sel] if {[set llen [llength $selection]]>2} { alited::Message {Applied to one selection only!} 4 return {} } if {$llen} { lassign $selection pos1 pos2 if {[$wtxt compare $pos2 == [$wtxt index end]]} { set pos2 [$wtxt index "$pos2 -1c"] } } else { set pos [expr {int([$wtxt index insert])}] set pos1 $pos.0 set pos2 $pos.end } if {$islines} { set pos1 [::apave::pint $pos1].0 set pos2 [::apave::pint $pos2].end } set valueOrig [set value [$wtxt get $pos1 $pos2]] list $wtxt $value $pos1 $pos2 }
Handles pressing Cancel button of Move Descriptions dialogue.
proc ::alited::format::Cancel {} { # Handles pressing Cancel button of Move Descriptions dialogue. namespace upvar ::alited obDl2 obDl2 variable win $obDl2 res $win 0 }
At changing the direction, fills 2 texts with "from/to" examples.
proc ::alited::format::ChangeTo {} { # At changing the direction, fills 2 texts with "from/to" examples. namespace upvar ::alited al al obDl2 obDl2 variable da if {$da(dir)==1} { set da(separSav2) $da(separ) set da(separ) $da(separSav1) set img alimg_up-big } else { set da(separSav1) $da(separ) set da(separ) $da(separSav2) set img alimg_down-big } ::apave::blinkWidgetImage [$obDl2 LabFromTo] $img ShowUnitDesc Re_FgColor }
Check options of Move Descriptions dialogue.
proc ::alited::format::CheckOk {} { # Check options of Move Descriptions dialogue. namespace upvar ::alited al al obDl2 obDl2 variable da set res yes set REleaf [LeafRE] if {$da(dir)==1} { # move from inside to out lassign [Separ1 $da(separ)] separ if {![regexp $REleaf $separ]} { set err [msgcat::mc "The separator doesn't match to the regexp:\n\n "] append err "\"$REleaf\"" set res no } if {![regexp {[Nn]} $da(separ)]} { set err {Separator must contain "n" or "N" for unit name!} set res no } } else { if {[string trimright $da(separ)] ne {} && ![string match #* $da(separ)]} { set err "The separator should be Tcl comment!" set res no set da(separ) #$da(separ) } } set da(separSav$da(dir)) $da(separ) if {!$res} { bell [$obDl2 Tex1] replace 1.0 end "\n#! [msgcat::mc ERROR]:\n#!\n#! [msgcat::mc $err]" } if {$res && $da(what)==2 && ![alited::msg yesno ques {Were all files properly backed up?}]} { return 0 } if {$res} { alited::info::Put {} alited::ProcessFiles alited::InitUnitTree $da(what) set lfRE [alited::unit::IsLeafRegexp] if {$da(dir)==1 && $lfRE || $da(dir)==2 && !$lfRE} { set al(prjuseleafRE) [expr {!$lfRE}] set al(prjleafRE) $REleaf set msg [msgcat::mc "PROJECT OPTION \"Use leaf's regexp\" SWITCHED TEMPORARILY TO "] append msg "\"$al(prjuseleafRE)\"" alited::info::Put $msg {} yes set da(RE_SWITCHED) 1 } else { set da(RE_SWITCHED) 0 } } return $res }
Create icon of formatter in toolbar.
| icon name |
| true if separated |
| command |
| formatter file name |
proc ::alited::format::CreateFormatIcon {icon sep com fform} { # Create icon of formatter in toolbar. # icon - icon name # sep - true if separated # com - command # fform - formatter file name variable icon6 if {[info exists icon6($icon)]} return set icon6($icon) 1 set but [alited::tool::ToolButName $icon]_2 if {$sep} { set separ [ttk::separator ${but}_sep -orient vertical] pack $separ -side left -fill y -padx 6 } lassign [obj csGet] fga fg bga bg set fontB [obj boldTextFont 16] if {[catch {set img [alited::ini::CreateIcon $icon]-big; image inuse $img}]} { set txt $icon set istext 1 } else { set txt {} set istext 0 } set attrs [obj toolbarItem_Attrs $istext $img $fontB $fg $bg $fga $bga] button $but -text $txt -command $com {*}$attrs ::baltip tip $but [msgcat::mc Pluginable]\n[alited::menu::FormatsItemName $fform] bind $but <Button-3> {alited::tool::PopupBar %X %Y} pack $but -side left }
Checks if an event is correct (not overlap alited key mapping).
| full path to formatter |
| formatter's name |
| the event |
| if true, -accelerator of $fform menu item was made |
proc ::alited::format::EventOK {fullformname fform ev wasacc} { # Checks if an event is correct (not overlap alited key mapping). # fullformname - full path to formatter # fform - formatter's name # ev - the event # wasacc - if true, -accelerator of $fform menu item was made namespace upvar ::alited al al variable cont6 set ev2 [string trim $ev <>] set keys [alited::keys::EngagedList] lappend keys {*}[alited::keys::ReservedList] foreach key $keys { lassign $key ev1 if {$ev1 eq $ev2} { set fn [alited::menu::FormatsItemName $fform] set msg [msgcat::mc {%e is overlapped by formatter "%f"}] set msg [string map [list %e $ev %f $fn] $msg] alited::MessageError $msg return no } } if {!$wasacc} { # add -accelerator to Formats menu item of $fform set mnu $al(MENUFORMATS) set itemttl [alited::menu::FormatsItemName $fform] alited::edit::PluginAccelerator $mnu $itemttl $ev2 } set al(FORMATS,$fform,$ev2) [list $fullformname $ev2] return yes }
Handles "Help" button.
proc ::alited::format::Help {} { # Handles "Help" button. alited::Help $::alited::format::win 1 }
Gets the chosen leaf's RE (current or standard, seen by the user).
proc ::alited::format::LeafRE {} { # Gets the chosen leaf's RE (current or standard, seen by the user). return [[$::alited::obDl2 LabRE2] cget -text] }
Maps selection by pairs taken from config.file.
| list of config.file's lines (pairs from-to) |
| Optional arguments. |
proc ::alited::format::Mode1 {cont args} { # Maps selection by pairs taken from config.file. # cont - list of config.file's lines (pairs from-to) lassign [BeforeFormatting] wtxt value pos1 pos2 if {$wtxt eq {}} return # check the list of mapping set prevlist [list] foreach line $cont { set line [split [string trim $line]] set llen [llength $line] if {$llen==1 || $llen>2} { set msg [msgcat::mc "Incorrect mapped 'from-to' in: %l"] set msg [string map [list %l $line] $msg] alited::Message $msg 4 } elseif {$llen} { lassign $line from to set i [lsearch -exact -index 1 $prevlist $from] if {$i>=0} { set msg [msgcat::mc "'from' refers to previous 'to' in: %l (see: %n)"] set msg [string map [list %l $line %n [lindex $prevlist $i]] $msg] alited::Message $msg 4 } lappend prevlist $line } } foreach line $cont { if {[catch { set line [split [string trim $line]] if {[llength $line]==2} { set value [string map $line $value] } } e]} then { alited::Message "$e ($line)" 3 } } AfterFormatting $wtxt $pos1 $pos2 $value }
Applies a command to selection/current line.
| list of config.file's lines |
| Optional arguments. |
proc ::alited::format::Mode2 {cont args} { # Applies a command to selection/current line. # cont - list of config.file's lines lassign [BeforeFormatting] wtxt value pos1 pos2 if {$wtxt eq {}} return set err 0 foreach line $cont { if {[set com [alited::edit::IniParameter command $line]] ne {}} { set value [alited::edit::EscapeValue $value] set com [alited::Map -nocase $com %v $value] if {[catch {set value [eval $com]} e]} { alited::Message $e 4 set err 1 break } set value [alited::edit::UnEscapeValue $value] } } if {!$err} {AfterFormatting $wtxt $pos1 $pos2 $value} }
Applies command(s) to lines of selection.
| list of config.file's lines |
| Optional arguments. |
proc ::alited::format::Mode3 {cont args} { # Applies command(s) to lines of selection. # cont - list of config.file's lines lassign [BeforeFormatting yes] wtxt value pos1 pos2 if {$wtxt eq {}} return set value [split $value \n] set err 0 foreach line $cont { if {[set com [alited::edit::IniParameter command $line]] ne {}} { set com [alited::Map {} $com %v $value] if {[catch {set value [eval $com]} e]} { alited::Message $e 4 set err 1 break } } } if {!$err} { set resvalue {} set was no foreach line $value { if {$was} {append resvalue \n} append resvalue $line set was yes } AfterFormatting $wtxt $pos1 $pos2 $resvalue } }
Applies external command(s) to selection or lines of selection.
| list of config.file's lines |
| Optional arguments. |
The selection (or lines of selection) is saved to a temporary file that is processed by commands.
proc ::alited::format::Mode4 {cont args} { # Applies external command(s) to selection or lines of selection. # cont - list of config.file's lines # The selection (or lines of selection) is saved to a temporary file # that is processed by commands. namespace upvar ::alited al al variable valueSel variable valueLines lassign [BeforeFormatting] wtxt valueSel if {$wtxt eq {}} return lassign [BeforeFormatting yes] wtxt valueLines set comcount 0 set tmpname [alited::TmpFile FORMAT~] foreach line $cont { set com {} if {[set comu [alited::edit::IniParameter Unix,Linux $line]] ne {}} { if {[::isunix]} { set com $comu incr comcount } } elseif {[set comw [alited::edit::IniParameter Windows $line]] ne {}} { if {[::iswindows]} { set com $comu incr comcount } } elseif {[set com [alited::edit::IniParameter Command $line]] ne {}} { if {$comcount} break } if {$com ne {}} { set com [alited::MapWildCards $com] # %S - file name for saved selection # %L - file name for saved lines of selection if {[string first %S $com]>=0 && $valueSel ne {}} { writeTextFile $tmpname ::alited::format::valueSel } elseif {[string first %L $com]>=0 && $valueLines ne {}} { writeTextFile $tmpname ::alited::format::valueLines } set com [alited::Map -nocase $com %S $tmpname %L $tmpname] alited::tool::Run_in_e_menu $com } } alited::FocusText }
Inserts a string at the current cursor position. Or does something without changing the text (if commands return "").
| list of config.file's lines or variable name containing it |
| contains the edited file name etc. |
proc ::alited::format::Mode5 {cont args} { # Inserts a string at the current cursor position. # Or does something without changing the text (if commands return ""). # cont - list of config.file's lines or variable name containing it # args - contains the edited file name etc. namespace upvar ::alited al al DIR DIR lassign [BeforeFormatting] wtxt value set value [alited::edit::EscapeValue $value] lassign $args fn1 fn2 modal if {[info exists $cont]} { set cont [set $cont] } foreach line $cont { incr il set pos [$wtxt index insert] set com [alited::edit::IniParameter command $line -nocase -] if {$com ne {}} { set ending [expr {$com eq "-"}] if {$ending} { set com [join [lrange $cont $il end] \n] } set selection [$wtxt tag ranges sel] set lsel [llength $selection] if {!$lsel} { set value {} } # map format's own and template's woildcards set com [alited::Map {} $com %W $wtxt %v $value %f [alited::bar::FileName] %d $al(TPL,%d) %t $al(TPL,%t) %u $al(TPL,%u) %U $al(TPL,%U) %w $al(TPL,%w) %A $DIR %M $al(EM,mnudir)] set value [eval $com] if {$value ne {}} { if {$lsel} { lassign $selection pos1 pos2 $wtxt replace $pos1 $pos2 $value } else { $wtxt insert $pos $value } } if {$ending} break } } if {[string is true $modal]} alited::FocusText }
Runs a pluginable formatter.
| list of config.file's lines |
| formatter's file name etc. |
Returns 1st event to run the formatter or {}.
proc ::alited::format::Mode6 {cont args} { # Runs a pluginable formatter. # cont - list of config.file's lines # args - formatter's file name etc. # Returns 1st event to run the formatter or {}. namespace upvar ::alited al al variable cont6 variable bind6 lassign $args fullformname set fform [alited::edit::FormatterName $fullformname] set com [list alited::format::Mode5 ::alited::format::cont6($fform) {*}$args] set wtxt [alited::main::CurrentWTXT] set bind6($fform) [list] set res [set icon {}] set sep 0 set modal 1 foreach line $cont { incr il foreach o {sep modal} { set v [alited::edit::IniParameter $o $line -nocase] if {[string is boolean -strict $v]} {set $o $v} } set ic [alited::edit::IniParameter icon $line -nocase] if {$ic ne {}} {set icon $ic} set events [alited::edit::IniParameter events $line -nocase] if {$events ne {}} { foreach ev [split $events { ,}] { if {$ev ne {}} { set wasacc [info exist cont6($fform)] if {[EventOK $fullformname $fform $ev $wasacc]} { lappend com $modal catch {bind $wtxt $ev $com} if {![llength $bind6($fform)]} {set res $ev} lappend bind6($fform) [list $ev $com] } else { set res {} break } } set cont6($fform) [lrange $cont $il end] } break } } if {$icon ne {}} { CreateFormatIcon $icon $sep $com $fform } elseif {$res eq {}} { # no event encountered - run the formatter once Mode5 $cont {*}$args $modal } return $res }
Move a unit description outside the unit.
| file's content |
| 1st unit line number |
| last unit line number |
| padding (indentation) of text |
proc ::alited::format::MoveInside {cont l1 l2 pad} { # Move a unit description outside the unit. # cont - file's content # l1 - 1st unit line number # l2 - last unit line number # pad - padding (indentation) of text namespace upvar ::alited al al variable da set l0 [expr {$l1-1}] set line [lindex $cont $l0] if {![regexp [LeafRE] $line]} { return [list $cont 0] ;# not unit's declaraion - already processed? } set pad0 [obj leadingSpaces $line] set pad0 [string repeat { } $pad0] # get the outside description set replln 0 set replcont [list] for {set i $l1} {$i<$l2} {incr i} { set line [string trimleft [lindex $cont $i]] if {![string match #* $line]} { if {$line ne {}} { if {[regexp $al(RE,proc2) $line]} { # unit's declaration found in this line set replln [incr i -1] } break } } else { # only comments included into the description lappend replcont $pad$line } } if {$replln <= 0} { # unit's declaration not found return [list $cont 0] } # insert it inside the unit's body if {[llength $replcont]} { # find the unit's body set body [set insln 0] for {set i $l1} {$i<$l2} {incr i} { set line [string trim [lindex $cont $i]] if {[regexp $al(RE,proc2) $line]} { incr body } if {$body && [string index $line end] ne "\\"} { set insln [incr i] break } } if {$insln} { # unit's body found - insert the description inside it if {[lindex $cont $insln] ne {}} {lappend replcont {}} set cont [linsert $cont $insln {} {*}$replcont] } } # replace the the outside description with 2nd separator set separ2 [string trim $da(separSav2)] if {$separ2 ne {}} { set separ2 $pad0$separ2\n # if there is a comment above, no separator for {set i $l0} {$i>1} {} { incr i -1 set line [string trimleft [lindex $cont $i]] if {$line ne {}} { if {[string match #* $line]} { set separ2 {} } break } } } if {$separ2 eq {}} { set cont [lreplace $cont $l0 $replln] } else { set cont [lreplace $cont $l0 $replln $separ2] } list $cont 1 }
Move a unit description outside the unit.
| file's content |
| initial comment with unit's name |
| 1st unit line number |
| last unit line number |
Returns file's contents and 1 (for processed) or 0 (for not processed).
proc ::alited::format::MoveOut {cont title l1 l2} { # Move a unit description outside the unit. # cont - file's content # title - initial comment with unit's name # l1 - 1st unit line number # l2 - last unit line number # Returns file's contents and 1 (for processed) or 0 (for not processed). namespace upvar ::alited al al set line [lindex $cont [expr {$l1-1}]] if {[regexp [LeafRE] $line]} { return [list $cont 0] ;# already processed? } # padding (indentation) of unit's declaration set pad [obj leadingSpaces $line] set pad [string repeat { } $pad] set replcont [set replln [list]] # find the inside description for {set i $l1} {$i<$l2} {incr i} { set line [string trimleft [lindex $cont $i]] if {![string match #* $line]} { if {[llength $replcont] || $line ne {}} break } else { lappend replcont $pad$line } lappend replln $i } if {[llength $replln]} { set replcont [linsert $replcont 0 {}] # remove old description set i1 [lindex $replln 0] set i2 [lindex $replln end] set cont [lreplace $cont $i1 $i2] } # above the unit's declaration - find the first "meaningful" line for {set i [incr l1 -2]} {$i>=0} {incr i -1} { set line [string trimleft [lindex $cont $i]] if {$line ne {} && (![string match #* $line] || [regexp {[[:alnum:]]} $line])} { break } } # remove old description, insert new one set title $pad[string trim $title] set cont [lreplace $cont [incr i] $l1] set cont [linsert $cont $i {} $title {*}$replcont {}] list $cont 1 }
Does move the unit descriptions.
| tab's ID |
Returns 1 if the moves done, 0 if no moves.
proc ::alited::format::MoveUnitDesc {TID} { # Does move the unit descriptions. # TID - tab's ID # Returns 1 if the moves done, 0 if no moves. namespace upvar ::alited al al variable da if {![alited::isTclScript $TID]} {return 0} set infdat [list $TID 1] set fname [file tail [alited::bar::FileName $TID]] set cont [alited::file::ReadFileByTID $TID] ;# let it be read anyhow set wtxt [alited::main::GetWTXT $TID] if {$wtxt eq {}} { lassign [alited::main::GetText $TID no no] -> wtxt } set lfRE $al(prjuseleafRE) if {$da(RE_SWITCHED) || $da(dir)==1} { # if "Use leaf's RE" was switched or moving to outside and # the unit tree contains already appropriate leaf units, then no actions more if {$da(dir)==1} { # in-to-out mode: recreate the "use leafRE" tree to check it for leaf units set al(prjuseleafRE) 1 alited::unit::RecreateUnits $TID $wtxt } lassign [alited::unit::UnitHeaderMode $TID] isLeafRE isProc leafRE foreach item [lreverse $al(_unittree,$TID)] { if {[llength $item]<3} continue lassign $item lev leaf fl1 title l1 l2 set line [$wtxt get $l1.0 $l1.end] if {$isProc && [regexp $al(RE,proc) $line] || $isLeafRE && [regexp $leafRE $line]} { set msg [msgcat::mc $al(MC,unitprocsd)] set msg [string map [list %f $fname %n 0] $msg] alited::info::Put $line [list $TID $l1] ;# line of issue alited::info::Put $msg $infdat ;# file of issue set al(prjuseleafRE) $lfRE return 0 } } } set al(prjuseleafRE) $lfRE alited::unit::RecreateUnits $TID $wtxt set cont1 [$wtxt get 1.0 end] set cont2 [string trimright $cont1] set cont [split $cont2 \n] set moved 0 foreach item [lreverse $al(_unittree,$TID)] { if {[llength $item]<3} continue lassign $item lev leaf fl1 title l1 l2 if {$leaf && $title ne {}} { if {[string first { } $title]>0 && $l1==1} { continue ;# intro lines } lassign [Separ1 $da(separSav1)] separ limit set title [string map [list n $title N $title] $separ] set title [string range $title 0 $limit] if {$da(dir)==1} { # to out lassign [MoveOut $cont $title $l1 $l2] cont i } else { # to inside set pad [alited::main::CalcPad $wtxt] lassign [MoveInside $cont $l1 $l2 $pad] cont i } incr moved $i } } if {$moved} { alited::bar::BAR markTab $TID set newcont {} foreach c $cont { append newcont $c \n } if {[string length $cont1]==[string length $cont2]} { set newcont [string trimright $newcont] } $wtxt replace 1.0 end $newcont if {$wtxt eq [alited::main::CurrentWTXT]} { alited::main::UpdateAll } else { alited::unit::RecreateUnits $TID $wtxt } set msg [msgcat::mc {%f processed, units touched: %n}] } else { set msg [msgcat::mc $al(MC,unitprocsd)] } set msg [string map [list %f $fname %n $moved] $msg] alited::info::Put $msg $infdat alited::file::MakeThemHighlighted $TID return [expr {$moved>0}] }
Handles pressing OK button of Move Descriptions dialogue.
proc ::alited::format::Ok {} { # Handles pressing OK button of Move Descriptions dialogue. namespace upvar ::alited al al obDl2 obDl2 variable win variable da if {[CheckOk]} { set al(format_separ1) $da(separSav1) set al(format_separ2) $da(separSav2) lassign [alited::ProcessFiles alited::format::MoveUnitDesc $da(what)] all processed if {$processed} alited::main::UpdateIcons set msg [msgcat::mc {Files processed successfully: %n}] set msg [string map [list %n $processed] $msg] alited::info::Put $msg {} yes [expr {!$processed}] yes $obDl2 res $win 1 } }
Gets colors for leaf's regexp (comment's fg & bg).
proc ::alited::format::Re_Colors {} { # Gets colors for leaf's regexp (comment's fg & bg). namespace upvar ::alited obDl2 obDl2 lassign [::hl_tcl::hl_colors .] - - - - fg lassign [$obDl2 csGet] - - bg list $fg $bg }
Sets foreground color for leaf's regexp.
proc ::alited::format::Re_FgColor {} { # Sets foreground color for leaf's regexp. namespace upvar ::alited al al obDl2 obDl2 variable da lassign [Re_Colors] fg lassign [Separ1 $da(separSav1)] separ if {![regexp [LeafRE] $separ]} { set fg [lindex [alited::FgFgBold] 2] } [$obDl2 LabRE2] configure -foreground $fg }
Gets "real" separator and limit of its length (extracted from it).
| title |
proc ::alited::format::Separ1 {title} { # Gets "real" separator and limit of its length (extracted from it). # title - title if {[set limit [regexp -inline {\(\d+\)} $title]] ne {}} { set title [string map [list $limit {}] $title] set limit [string trim $limit ()] } else { set limit 9999 } list $title [incr limit -1] }
Displays unit descriptions to move.
proc ::alited::format::ShowUnitDesc {} { # Displays unit descriptions to move. namespace upvar ::alited obDl2 obDl2 variable da set pad [alited::main::CalcPad] set descIn " SEPAR\n\n proc ::K {x y} {\n\n $pad# K combinator. \n $pad# x - returned value\n $pad# y - discarded value\n\n ${pad}set x\n }" set descOut " SEPAR\n\n # K combinator. \n # x - returned value\n # y - discarded value\n\n proc ::K {x y} {\n\n ${pad}set x\n }" lassign [Separ1 $da(separSav1)] separ1 limit set separ1 [string range [string map [list n ::K N ::K] $separ1] 0 $limit] set cont1 [string map [list SEPAR $separ1] $descOut] set cont2 [string map [list SEPAR $da(separSav2)] $descIn] set tex1 [$obDl2 Tex1] set tex2 [$obDl2 Tex2] $tex1 replace 1.0 end $cont1 $tex2 replace 1.0 end $cont2 set colors [alited::SyntaxColors] set colors [lreplace $colors end-1 end-1 [lindex [$obDl2 csGet] 2]] alited::SyntaxHighlight tcl $tex1 $colors alited::SyntaxHighlight tcl $tex2 $colors Re_FgColor }
Sets standard options of Move Descr.
proc ::alited::format::StandardOptions {} { # Sets standard options of Move Descr. namespace upvar ::alited al al obDl2 obDl2 variable da set curRE [alited::unit::LeafRegexp] if {$curRE ne $al(RE,leafDEF)} { set msg [msgcat::mc " Current leaf's RE\n\n <r>%r1</r>\n\n is not equal to standard\n\n <r>%r2</r>\n\n as set in Projects/Options and Preferences/Units."] set msg [string map [list %r1 $curRE %r2 $al(RE,leafDEF)] $msg] set tags [alited::MessageTags] set ok [alited::msg okcancel warn $msg CANCEL -text 1 {*}$tags] if {!$ok} return } set da(separSav1) $al(format_separ1DEF) set da(separSav2) $al(format_separ2DEF) set da(separ) $da(separSav$da(dir)) [$obDl2 LabRE2] configure -text $al(RE,leafDEF) ShowUnitDesc Re_FgColor }
Moves unit description from inner to above units.
proc ::alited::format::UnitDesc {} { # Moves unit description from inner to above units. namespace upvar ::alited al al obDl2 obDl2 variable win variable da set da(prjlfRESav) $al(prjleafRE) set da(prjuselfRESav) $al(prjuseleafRE) set separSav1 $da(separSav1) set separSav2 $da(separSav2) lassign [Re_Colors] fgRE da(bgRE) set stcl [llength [alited::SessionTclList 1]] set atcl [llength [alited::SessionTclList 2]] set selected [msgcat::mc Selected]\ ($stcl) set allopen [msgcat::mc {All in session}]\ ($atcl) set REleaf [alited::unit::LeafRegexp] $obDl2 makeWindow $win.fra $al(MC,formatdesc) $obDl2 paveWindow $win.fra { {.lab1 - - 1 3 {-pady 8} {-t "Move proc/method descriptions:" -font {$::apave::FONTMAINBOLD}}} {.seh0 + T 1 6} {.rad1 + T 1 1 {-st w} {-t "From inside to out" -var ::alited::format::da(dir) -value 1 -com alited::format::ChangeTo -image alimg_up -compound right}} {.rad2 + T 1 1 {-st w} {-t "From out to inside" -var ::alited::format::da(dir) -value 2 -com alited::format::ChangeTo -image alimg_down -compound right}} {.sev .rad1 L 2 1 {-padx 10}} {.labRE1 + L 1 1 {-st sne} {-t "Leaf's regexp:"}} {.LabRE2 + L 1 1 {} {-t {$REleaf} -foreground $fgRE -background $da(bgRE)}} {.h_1 + L 1 1} {.butStd + L 1 1 {-st e} {-t Standard -com alited::format::StandardOptions}} {.labSep .labRE1 T 1 1 {-st sne} {-t "Separator:"}} {.EntSepar + L 1 3 {-st ew -cw 1} {-tvar ::alited::format::da(separ) -validate all -validatecommand alited::format::ValidateUnitDesc}} {.seh1 .rad2 T 1 6} {.Tex1 + T 1 6 {-st nsew -pady 4 -rw 1} {-h 11 -w 80 -wrap none -font {$al(FONT,txt)}}} {.fra + T 1 6} {.fra.LabFromTo + L 1 4 {-st nsew} {-image alimg_up-big}} {.fra.labdummy + L 1 1 {-st nsew} {-image alimg_none-big}} {.Tex2 .fra T 1 6 {-st nsew -pady 4 -rw 1} {-h 11 -w 80 -wrap none -font {$al(FONT,txt)}}} {.frawhat + T 1 6} {.frawhat.labwhat - - - - {-st e} {-t "Process .tcl file(s):"}} {.frawhat.rad1 + L 1 1 {-padx 20} {-t {$selected} -var ::alited::format::da(what) -value 1}} {.frawhat.rad2 + L 1 1 {} {-t {$allopen} -var ::alited::format::da(what) -value 2}} {.seh2 .frawhat T 1 6} {.butHelp + T 1 1 {-st w} {-t Help -com alited::format::Help}} {.h_ + L 1 4} {.frabut + L 1 1 {-st e}} {.frabut.butOK + L 1 1 {-st e} {-t OK -com alited::format::Ok}} {.frabut.butCancel + L 1 1 {-st e} {-t Cancel -com alited::format::Cancel}} } if {$da(dir)==1} {set da(separ) $da(separSav2)} {set da(separ) $da(separSav1)} ChangeTo bind $win <F1> alited::format::Help set res [$obDl2 showModal $win -resizable 1 -minsize {650 400} {*}$da(geo)] set al(prjuseleafRE) $da(prjuselfRESav) set al(prjleafRE) $da(prjlfRESav) if {$res} { alited::main::UpdateAll } else { set da(separSav1) $separSav1 set da(separSav2) $separSav2 } set da(geo) "-geometry [wm geometry $win]" catch {destroy $win} }
Validates the separator's entry
| if yes runs the validation; optional, default no |
proc ::alited::format::ValidateUnitDesc {{dovalid no}} { # Validates the separator's entry # dovalid - if yes runs the validation variable da if {$dovalid} { set da(separSav$da(dir)) $da(separ) ShowUnitDesc } else { after idle {alited::format::ValidateUnitDesc yes} } return yes }
Initializes highlighting .alm text (alited's macro).
| the text |
| the text's font |
| the font's size |
| highlighting colors |
proc ::alited::hl_alm::init {w font szfont args} { # Initializes highlighting .alm text (alited's macro). # w - the text # font - the text's font # szfont - the font's size # args - highlighting colors lassign $args clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT dict set font -size $szfont dict set font -weight bold; $w tag config almKEY -font $font -foreground $clrCOM dict set font -weight normal $w tag config almPATH -font $font -foreground $clrVAR $w tag config almARG -font $font -foreground $clrOPT dict set font -slant italic $w tag config almCMNT -font $font -foreground $clrCMN foreach t {KEY CMNT} {after idle $w tag raise alm$t} return [namespace current]::line }
Highlights a line of .alm text (alited's macro).
| the text |
| position in the line; optional, default "" |
| mode of processing a current line (0, 1, -1); optional, default 0 |
proc ::alited::hl_alm::line {w {pos {}} {prevQtd 0}} { # Highlights a line of .alm text (alited's macro). # w - the text # pos - position in the line # prevQtd - mode of processing a current line (0, 1, -1) if {$pos eq {}} {set pos [$w index insert]} set il [expr {int($pos)}] set line [$w get $il.0 $il.end] if {[string trim $line] eq {}} {return yes} foreach t {KEY PATH ARG CMNT} {$w tag remove alm$t $il.0 $il.end} if {[regexp "^\s*#" $line]} { $w tag add almCMNT $il.0 $il.end return yes } lassign [regexp -inline {^\s*[^\s]+} $line] lre if {$lre ne {}} { set p1 [string length $lre] $w tag add almKEY $il.0 $il.$p1 } set path [regexp -inline -all -indices {\s{1}[.]{1}[^\s]+} $line] foreach l2 $path { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add almPATH $il.$p1 $il.[incr p2] } } set key [regexp -inline -all -indices {\s%.=} $line] foreach l2 $key { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add almARG $il.$p1 $il.[incr p2] } } return yes }
Gets R:, R/ etc type from a line.
| Not documented. |
| Not documented; optional, default "" |
proc ::alited::hl_em::getRSIM {line {markers {}}} { # Gets R:, R/ etc type from a line. if {[regexp {^\s*[RSIM]{1}[WE]?:\s*} $line]} { set div : } elseif {[regexp {^\s*[RSIM]{1}[WE]?/\s*} $line]} { set div / } else { if {$markers ne {}} { set marker [lindex [regexp -inline "^($markers)" $line] 0] return [list $marker - [string trim $line]] } return {} } set line [string trim $line] set i [string first $div $line] set typ [string range $line 0 $i] set prog [string trimleft [string range $line $i+1 end]] return [list $typ $prog $line] }
Initializes highlighting .em text (e_menu's menu).
| the text |
| font |
| font's size |
| highlighting colors |
proc ::alited::hl_em::init {w font szfont args} { # Initializes highlighting .em text (e_menu's menu). # w - the text # font - font # szfont - font's size # args - highlighting colors lassign $args clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC if {[::apave::obj csDark]} { set fg2 black } else { set fg2 white } dict set font -weight bold $w tag config emRSIM -font $font -foreground $clrCOMTK $w tag config emMARK -font $font -foreground $clrPROC $w tag config emSECT -font $font -foreground $fg2 -background $clrPROC dict set font -weight normal $w tag config emVAR -font $font -foreground $clrVAR $w tag config emVAL -font $font -foreground $clrSTR dict set font -slant italic $w tag config emCMNT -font $font -foreground $clrCMN foreach t {RSIM MARK SECT CMNT} {after idle $w tag raise em$t} return [namespace current]::line }
Highlights a line of .em text (e_menu's menu).
| the text |
| position in the line; optional, default "" |
| mode of processing a current line (0, 1, -1); optional, default 0 |
proc ::alited::hl_em::line {w {pos {}} {prevQtd 0}} { # Highlights a line of .em text (e_menu's menu). # w - the text # pos - position in the line # prevQtd - mode of processing a current line (0, 1, -1) if {$pos eq {}} {set pos [$w index insert]} set il [expr {int($pos)}] set line [$w get $il.0 $il.end] foreach t {RSIM MARK SECT CMNT VAR VAL} {$w tag remove em$t $il.0 $il.end} set res no lassign [getRSIM $line {ITEM\s*=|SEP\s*=|%M[^ ] |%C |\[MENU\]\s*$|\[OPTIONS\]\s*$|\[HIDDEN\]\s*$|\[DATA\]\s*$|^\s*#|^::\w+=}] marker pg ln if {$marker ne {}} { set p1 [string first $marker $line] set p2 [expr {$p1+[string length $marker]}] if {$pg ne {-}} { set tag emRSIM } else { switch -- [string index $ln 0] { \[ {set tag emSECT} \# {set tag emCMNT; set p2 end} : { $w tag add emVAR $il.$p1 $il.[incr p2 -1] set tag emVAL set p1 [incr p2] set p2 end } default { set tag emMARK if {[string first = $marker]>0} {set p2 end} } } } $w tag add $tag $il.$p1 $il.$p2 set res yes } return $res }
Initializes highlighting .html text.
| the text |
| the text's font |
| the font's size |
| highlighting colors |
proc ::alited::hl_html::init {w font szfont args} { # Initializes highlighting .html text. # w - the text # font - the text's font # szfont - the font's size # args - highlighting colors lassign $args clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT dict set font -size $szfont $w tag config htmVAL -font $font -foreground $clrSTR $w tag config htmARG -font $font -foreground $clrOPT dict set font -weight bold $w tag config htmTAG -font $font -foreground $clrCOM dict set font -weight normal dict set font -slant italic $w tag config htmCMN -font $font -foreground $clrCMN foreach t {TAG CMN} {after idle $w tag raise htm$t} return [namespace current]::line }
Highlights a line of .html text.
| the text |
| position in the line; optional, default "" |
| mode of processing a current line (0, 1, -1); optional, default 0 |
proc ::alited::hl_html::line {w {pos {}} {prevQtd 0}} { # Highlights a line of .html text. # w - the text # pos - position in the line # prevQtd - mode of processing a current line (0, 1, -1) if {$pos eq {}} {set pos [$w index insert]} set il [expr {int($pos)}] set line [$w get $il.0 $il.end] foreach t {TAG VAL ARG CMN} {$w tag remove htm$t $il.0 $il.end} if {$prevQtd==-1} { # comments continued (would work with 1 continued line) set i [string first --> $line] if {$i<0} { $w tag add htmCMN $il.0 $il.end return -1 } set line [string repeat { } [incr i 2]][string range $line [incr i] end] $w tag add htmCMN $il.0 $il.$i } set specs [regexp -inline -all -indices {&[a-zA-Z]+;} $line] foreach l2 $specs { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add htmTAG $il.$p1 $il.[incr p2] } } set htms [regexp -inline -all -indices {(<{1}/?\w+)([^>]*>{1})} $line] foreach {l1 l2 -} $htms { lassign $l1 p1 p2 if {$p1<$p2} { lassign $l2 r1 r2 $w tag add htmTAG $il.$r1 $il.[incr r2] $w tag add htmTAG $il.$p2 $il.[incr p2] set subline [$w get $il.$r2 $il.[incr p2 -1]] # inside a tag: options may be quoted and not while 1 { # first, get an option's name lassign [lindex [regexp -inline -indices {\w+=} $subline] 0] p1 p2 if {$p1 eq {}} break # then, get an option's value incr p2 if {[string index $subline $p2] eq {"}} { lassign [lindex [regexp -inline -indices {"[^"]*\"} $subline] 0] s1 s2 if {$s2 eq {}} { set s1 $p2 set s2 [string length $subline] } else { incr s2 } } else { set s1 $p2 set s2 [string first { } $subline $s1] if {$s2<0} {set s2 [string length $subline]} } # erase the currently processed option if {$p1 > $s2} break set subline [string replace $subline $p1 $s2 [string repeat { } [expr {$s2-$p1+1}]]] # highlight name & value incr p1 $r2 incr p2 $r2 $w tag add htmARG $il.$p1 $il.$p2 incr s1 $r2 incr s2 $r2 $w tag add htmVAL $il.$s1 $il.$s2 } } } set cmns [regexp -inline -all -indices {<{1}![^>]*>{1}} $line] foreach l2 $cmns { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add htmCMN $il.$p1 $il.[incr p2] } } set cmns [regexp -inline -all -indices {<{1}!--[^>]*$} $line] foreach l2 $cmns { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add htmCMN $il.$p1 $il.end return -1 ;# comments to be continued } } return 0 }
Initializes highlighting .ini text.
| the text |
| font |
| font's size |
| highlighting colors |
proc ::alited::hl_ini::init {w font szfont args} { # Initializes highlighting .ini text. # w - the text # font - font # szfont - font's size # args - highlighting colors lassign $args clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC dict set font -weight bold $w tag config iniSECT -font $font -foreground $clrPROC dict set font -weight normal if {[alited::EditExt] eq {typetpl}} { $w tag config iniOPT -font $font $w tag config iniVAL -font $font $w tag config iniCMNT -font $font } else { $w tag config iniOPT -font $font -foreground $clrCOM $w tag config iniVAL -font $font -foreground $clrSTR dict set font -slant italic $w tag config iniCMNT -font $font -foreground $clrCMN } foreach t {SECT CMNT} {after idle $w tag raise ini$t} return [namespace current]::line }
Highlights a line of .ini text.
| the text |
| position in the line; optional, default "" |
| mode of processing a current line (0, 1, -1); optional, default 0 |
proc ::alited::hl_ini::line {w {pos {}} {prevQtd 0}} { # Highlights a line of .ini text. # w - the text # pos - position in the line # prevQtd - mode of processing a current line (0, 1, -1) if {$pos eq {}} {set pos [$w index insert]} set il [expr {int($pos)}] set line [$w get $il.0 $il.end] if {[string trim $line] eq {}} {return yes} foreach t {SECT OPT VAL CMNT} {$w tag remove ini$t $il.0 $il.end} if {[regexp "^\s*#" $line]} { $w tag add iniCMNT $il.0 $il.end return yes } lassign [regexp -inline {^\s*\[.+\]\s*$} $line] lre if {$lre ne {}} { set p1 [string length $lre] $w tag add iniSECT $il.0 $il.$p1 return yes } set opts [regexp -inline -all -indices {^\s*([^=]+)\s*(=)\s*(.*)$} $line] foreach {- l1 - l2} $opts { lassign $l1 p1 p2 if {$p1<$p2} { $w tag add iniOPT $il.$p1 $il.[incr p2] lassign $l2 p1 p2 $w tag add iniVAL $il.$p1 $il.[incr p2] } } return yes }
Initializes highlighting .md text (markdown).
| the text |
| the text's font |
| the font's size |
| highlighting colors |
proc ::alited::hl_md::init {w font szfont args} { # Initializes highlighting .md text (markdown). # w - the text # font - the text's font # szfont - the font's size # args - highlighting colors lassign $args clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT dict set font -size $szfont $w tag config mdCMNT -font $font -foreground $clrCMN $w tag config mdAPOS -font $font -foreground $clrVAR dict set font -weight bold; dict set font -slant italic $w tag config mdBOIT -font $font -foreground $clrVAR dict set font -weight normal $w tag config mdITAL -font $font -foreground $clrVAR dict set font -weight bold; set font [dict remove $font -slant] $w tag config mdBOLD -font $font -foreground $clrVAR $w tag config mdLIST -font $font -foreground $clrCOM dict set font -weight normal $w tag config mdLINK -font $font -foreground $clrOPT $w tag config mdTAG -font $font -foreground $clrSTR foreach t {BOIT ITAL BOLD LIST} {after idle $w tag raise md$t} foreach t {6 5 4 3 2 1} { dict set font -weight bold dict set font -size [expr {$szfont + [incr sz] -1}] $w tag config mdHEAD$t -font $font -foreground $clrPROC after idle $w tag raise mdHEAD$t } return [namespace current]::line }
Highlights a line of .md text (markdown).
| the text |
| position in the line; optional, default "" |
| mode of processing a current line (0, 1, -1); optional, default 0 |
proc ::alited::hl_md::line {w {pos {}} {prevQtd 0}} { # Highlights a line of .md text (markdown). # w - the text # pos - position in the line # prevQtd - mode of processing a current line (0, 1, -1) if {$pos eq {}} {set pos [$w index insert]} set il [expr {int($pos)}] set line [$w get $il.0 $il.end] foreach t {LINK TAG CMNT APOS BOIT ITAL BOLD LIST} {$w tag remove md$t $il.0 $il.end} foreach t {6 5 4 3 2 1} {$w tag remove mdHEAD$t $il.0 $il.end} if {[string match " *" $line] || [string match "\t*" $line]} { return no ;# Tcl code to be processed by hl_tcl.tcl } # header lassign [regexp -inline "^#{1,6}\[^#\]" $line] lre if {$lre ne {}} { set p1 [expr {min(6,max(1,[string length $lre]-1))}] $w tag add mdHEAD$p1 $il.$p1 $il.end $w tag add mdCMNT $il.0 $il.$p1 return yes } # list beginning with *, -, 1. 2. .. lassign [regexp -inline {^(\s*(([*+-])|(\d+\.))\s)} $line] lre if {$lre ne {}} { set p1 [string length $lre] $w tag add mdLIST $il.0 $il.$p1 set line [string replace $line [incr p1 -2] $p1 { }] } # back apostrophes for code snippets set apos [regexp -inline -all -indices {(^|[^`])+(`[^`]+`)+([^`]|$)} $line] foreach {- - l2 -} $apos { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add mdCMNT $il.$p1 $il.[incr p1] $w tag add mdAPOS $il.$p1 $il.$p2 $w tag add mdCMNT $il.$p2 $il.[incr p2] } } # font highlightings: italic, bold, bold italic set italic [regexp -inline -all -indices {(^|[^*])+(\*[^*]+\*)+([^*]|$)} $line] foreach {- - l2 -} $italic { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add mdCMNT $il.$p1 $il.[incr p1] $w tag add mdITAL $il.$p1 $il.$p2 $w tag add mdCMNT $il.$p2 $il.[incr p2] } } set bold [regexp -inline -all -indices {(^|[^*])+(\*\*[^*]+\*\*)+([^*]|$)} $line] foreach {- - l2 -} $bold { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add mdCMNT $il.$p1 $il.[incr p1 2] $w tag add mdBOLD $il.$p1 $il.[incr p2 -1] $w tag add mdCMNT $il.$p2 $il.[incr p2 2] } } set bolditalic [regexp -inline -all -indices {(^|[^*])+(\*\*\*[^*]+\*\*\*)+([^*]|$)} $line] foreach {- - l2 -} $bolditalic { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add mdCMNT $il.$p1 $il.[incr p1 3] $w tag add mdBOIT $il.$p1 $il.[incr p2 -2] $w tag add mdCMNT $il.$p2 $il.[incr p2 3] } } # html link set links [regexp -inline -all -indices {(!{0,1}\[{1}[^\(\)]*\]{1}\({1}[^\(\)]+\){1})||(&[a-zA-Z]+;)} $line] foreach l2 $links { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add mdLINK $il.$p1 $il.[incr p2] } } # html tag set tags [regexp -inline -all -indices {<{1}/?\w+[^>]*>{1}} $line] foreach l2 $tags { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add mdTAG $il.$p1 $il.[incr p2] } } return yes }
Initializes highlighting .wiki text.
| the text |
| the text's font |
| the font's size |
| highlighting colors |
proc ::alited::hl_wiki::init {w font szfont args} { # Initializes highlighting .wiki text. # w - the text # font - the text's font # szfont - the font's size # args - highlighting colors variable data lassign $args clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT dict set font -size $szfont $w tag config wikiCMNT -font $font -foreground $clrCMN $w tag config wikiAPOS -font $font -foreground $clrCOMTK $w tag config wikiCTGR -font $font -foreground $clrPROC dict set font -slant italic $w tag config wikiITAL -font $font dict set font -weight bold; set font [dict remove $font -slant] $w tag config wikiBOLD -font $font $w tag config wikiLIST -font $font -foreground $clrCOM dict set font -weight normal $w tag config wikiLINK -font $font -foreground $clrOPT $w tag config wikiTAG -font $font -foreground $clrSTR foreach t {ITAL BOLD LIST} {after idle $w tag raise wiki$t} foreach t {6 5 4 3 2 1} { dict set font -weight bold dict set font -size [expr {$szfont + [incr sz] -1}] $w tag config wikiHEAD$t -font $font -foreground $clrPROC after idle $w tag raise wikiHEAD$t } set data($w,code) [list] return [namespace current]::line }
Highlights a line of .wiki text.
| the text |
| position in the line; optional, default "" |
| mode of processing a current line (0, 1, -1); optional, default 0 |
proc ::alited::hl_wiki::line {w {pos {}} {prevQtd 0}} { # Highlights a line of .wiki text. # w - the text # pos - position in the line # prevQtd - mode of processing a current line (0, 1, -1) variable data if {$pos eq {}} {set pos [$w index insert]} set il [expr {int($pos)}] set line [$w get $il.0 $il.end] foreach t {LINK TAG CMNT APOS CTGR ITAL BOLD LIST} {$w tag remove wiki$t $il.0 $il.end} foreach t {6 5 4 3 2 1} {$w tag remove wikiHEAD$t $il.0 $il.end} if {[string match " *" $line] || [string match "\t*" $line]} { return no ;# Tcl code to be processed by hl_tcl.tcl } if {[regexp {^\s*<<[^<>]+>>} $line]} { $w tag add wikiCTGR $il.0 $il.end return yes } set idxcode [lsearch -exact $data($w,code) $il] if {[string trim $line] eq {======}} { # add start/end of Tcl code if {$idxcode<0} { lappend data($w,code) $il set data($w,code) [lsort -integer $data($w,code)] } return yes } else { # check for Tcl code set data($w,code) [lreplace $data($w,code) $idxcode $idxcode] if {$idxcode>=0} {return yes} set llen [llength $data($w,code)] for {set i [set k 0]} {$i<$llen} {} { set ilc [lindex $data($w,code) $i] if {$ilc>$il} { if {$k} {return no} ;# inside Tcl code break } set k [expr {[incr k]%2}] if {[incr i]==$llen && $k} { return no ;# inside Tcl code } } } lassign [regexp -inline "^\\*{1,6}\[^\*\]+\\*{1,6}" $line] lre if {$lre ne {}} { set lrs [string trimleft $lre *] set p1 [expr {min(6,max(1,[string length $lre]-[string length $lrs]))}] $w tag add wikiHEAD$p1 $il.$p1 "$il.end -$p1 char" $w tag add wikiCMNT $il.0 $il.$p1 $w tag add wikiCMNT "$il.end -[incr p1] char" $il.end return yes } lassign [regexp -inline {^(\s+[*+-]\s)} $line] lre if {$lre ne {}} { set p1 [string length $lre] $w tag add wikiLIST $il.0 $il.$p1 set line [string replace $line [incr p1 -2] $p1 { }] } set italic [regexp -inline -all -indices {(?!'<)'{2}(?!').*?'{2}(?!'>)} $line] foreach l2 $italic { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add wikiCMNT $il.$p1 $il.[incr p1 2] $w tag add wikiITAL $il.$p1 $il.[incr p2 -1] $w tag add wikiCMNT $il.$p2 $il.[incr p2 2] } } set bold [regexp -inline -all -indices {(?!'<)'{3}(?!').*?'{3}(?!'>)} $line] foreach l2 $bold { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add wikiCMNT $il.$p1 $il.[incr p1 3] $w tag add wikiBOLD $il.$p1 $il.[incr p2 -2] $w tag add wikiCMNT $il.$p2 $il.[incr p2 3] } } set links [regexp -inline -all -indices {(\[{1})[^\]]+(\]{1})} $line] foreach l2 $links { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add wikiLINK $il.$p1 $il.[incr p2] foreach l2 [regexp -inline -all -indices {%\|%} $line] { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add wikiAPOS $il.$p1 $il.[incr p2] } } } } set tags [regexp -inline -all -indices {<{1}/?\w+[^>]*>{1}} $line] foreach l2 $tags { lassign $l2 p1 p2 if {$p1<$p2} { $w tag add wikiTAG $il.$p1 $il.[incr p2] } } return yes }
Indents Tcl code.
| text of Tcl code |
| number of spaces per 1 indent |
| indenting character |
| initial indent |
proc ::alited::indent::indent {tclcode pad padchar indcnt} { # Indents Tcl code. # tclcode - text of Tcl code # pad - number of spaces per 1 indent # padchar - indenting character # indcnt - initial indent set lines [split $tclcode \n] set out {} set nquot 0 ;# count of quotes set ncont 0 ;# count of continued strings if {$padchar ne "\t"} {set padchar { }} set padst [string repeat $padchar $pad] foreach orig $lines { incr lineindex if {$lineindex>1} {append out \n} set newline [string trim $orig] if {$newline eq {}} continue set is_quoted $nquot set is_continued $ncont if {[string index $orig end] eq "\\"} { incr ncont } else { set ncont 0 } set npad [expr {$indcnt * $pad}] set line [string repeat $padst $indcnt]$newline set ns [set nl [set nr [set body 0]]] if {[string index $newline 0] ne {#}} { for {set i 0; set n [string length $newline]} {$i<$n} {incr i} { set ch [string index $newline $i] if {$ch eq "\\"} { set ns [expr {[incr ns] % 2}] } elseif {!$ns} { if {$ch eq {"}} { set nquot [expr {[incr nquot] % 2}] } elseif {!$nquot} { switch $ch { "\{" { if {[string range $newline $i $i+2] eq "\{\"\}"} { # quote in braces - correct (though tricky) incr i 2 } else { incr nl set body -1 } } "\}" { incr nr set body 0 } } } } else { set ns 0 } } } set nbbraces [expr {$nl - $nr}] incr totalbraces $nbbraces if {$totalbraces<0} { set msg [msgcat::mc {The line %n: unbalanced brace!}] set msg [string map [list %n $lineindex] $msg] alited::msg ok err $msg return {} } incr indcnt $nbbraces if {$nbbraces==0} { set nbbraces $body } if {$is_quoted || $is_continued} { set line $orig ;# don't touch quoted and continued strings } else { set np [expr {- $nbbraces * $pad}] if {$np>$npad} { ;# for safety too set np $npad } set line [string range $line $np end] } append out $line } return $out }
Normalizes all indents of the current Tcl text.
proc ::alited::indent::normalize {} { # Normalizes all indents of the current Tcl text. namespace upvar ::alited al al set txtcurr [alited::main::CurrentWTXT] lassign [alited::main::CalcIndentation $txtcurr] pad padchar if {$pad<1} { alited::msg ok err "No indentation set.\nSee 'Setup/Projects/Options'." return } set msg [msgcat::mc "Correct the indentation of \"%f\"\nwith indenting %i spaces?"] set ipad $pad if {$padchar eq "\t"} {append ipad { Tab}} set msg [string map [list %i $ipad] $msg] set msg [string map [list %f [file tail [alited::bar::FileName]]] $msg] set res [alited::msg yesno ques $msg YES -title $al(MC,corrindent) -ch $al(MC,othertcl)] if {$res} { ::apave::setTextIndent $pad $padchar foreach tab [alited::bar::BAR listTab] { set TID [lindex $tab 0] lassign [alited::main::GetText $TID no no] fname txt if {[alited::file::IsTcl $fname] && ($res==11 || $txt eq $txtcurr)} { set contents [$txt get 1.0 {end -1 chars}] set contents [indent $contents $pad $padchar 0] if {$contents ne {}} { undoIn $txt $txt replace 1.0 end $contents undoOut $txt alited::bar::BAR markTab $TID } } } alited::main::UpdateTextGutterTreeIcons } }
Clears the info listbox widget and the related data.
| index of message (if omitted, clears all messages); optional, default -1 |
proc ::alited::info::Clear {{i -1}} { # Clears the info listbox widget and the related data. # i - index of message (if omitted, clears all messages) namespace upvar ::alited obPav obPav variable list variable info variable lastred if {$i == -2} { # no action } elseif {$i == -1} { set list [list] set info [list] } else { lassign [$obPav csGet] fg catch {[$obPav LbxInfo] itemconfigure $i -foreground $fg} set list [lreplace $list $i $i] set info [lreplace $info $i $i] } set lastred -2 }
Clears and out of the info listbox.
proc ::alited::info::ClearOut {} { # Clears and out of the info listbox. namespace upvar ::alited obPav obPav Clear alited::main::FocusText FocusOut [$obPav SbhInfo] }
Clears a red message in info bar (if it was displayed).
proc ::alited::info::ClearRed {} { # Clears a red message in info bar (if it was displayed). variable lastred Clear $lastred }
At focusing in the info listbox, shows its scrollbar.
| scrollbar's path |
| listbox's path |
proc ::alited::info::FocusIn {sbhi lbxi} { # At focusing in the info listbox, shows its scrollbar. # sbhi - scrollbar's path # lbxi - listbox's path if {![winfo ismapped $sbhi]} { pack $sbhi -side bottom -before $lbxi -fill both } }
At focusing out of the info listbox, hides its scrollbar.
| scrollbar's path |
proc ::alited::info::FocusOut {sbhi} { # At focusing out of the info listbox, hides its scrollbar. # sbhi - scrollbar's path variable focustext if {$focustext} { pack forget $sbhi } }
Handles a selection event of the info listbox.
| listbox's path |
| flag to check for the repeated calls of this procedure; optional, default no |
proc ::alited::info::ListboxSelect {w {checkit no}} { # Handles a selection event of the info listbox. # w - listbox's path # checkit - flag to check for the repeated calls of this procedure variable info variable focustext variable selectmsec variable selectafter set msec [clock milliseconds] if {($msec-$selectmsec)<500 && $checkit} { # this disables updating at key pressing, let a user release the key catch {after cancel $selectafter} set selectafter [after idle "alited::info::ListboxSelect $w yes"] } else { set sel [lindex [$w curselection] 0] if {[string is digit -strict $sel]} { update lassign [lindex $info $sel] TID line if {[alited::bar::BAR isTab $TID]} { if {$TID ne [alited::bar::CurrentTabID]} { alited::favor::SkipVisited yes alited::bar::BAR $TID show alited::find::SetTags [alited::main::GetWTXT $TID] } after idle "catch { alited::main::FocusText $TID $line.0 ; alited::tree::NewSelection {} $line.0 yes ; alited::main::HighlightLine}" if {!$focustext} {after 100 "focus $w"} } } } set selectmsec $msec }
Runs a popup menu on the info listbox.
| x-coordinate of mouse pointer |
| y-coordinate of mouse pointer |
proc ::alited::info::PopupMenu {X Y} { # Runs a popup menu on the info listbox. # X - x-coordinate of mouse pointer # Y - y-coordinate of mouse pointer namespace upvar ::alited al al obPav obPav variable focustext set popm $al(WIN).popupInfo catch {destroy $popm} menu $popm -tearoff 0 $popm add command -label $al(MC,favordelall) -command alited::info::ClearOut if {$focustext} { set msg [msgcat::mc {Don't focus a text after selecting in infobar}] } else { set msg [msgcat::mc {Focus a text after selecting in infobar}] } $popm add command -label $msg -command alited::info::SwitchFocustext $obPav themePopup $popm tk_popup $popm $X $Y }
Puts a message to the info listbox widget.
| the message |
| additional data for the message (1st line of unit etc.); optional, default "" |
| if yes, displays the message bolded; optional, default no |
| if yes, makes the message seen in red color; optional, default no |
| if yes, makes the message seen; optional, default no |
| {} or foreground color or -fg; optional, default "" |
proc ::alited::info::Put {msg {inf {}} {bold no} {red no} {see no} {fg {}}} { # Puts a message to the info listbox widget. # msg - the message # inf - additional data for the message (1st line of unit etc.) # bold - if yes, displays the message bolded # red - if yes, makes the message seen in red color # see - if yes, makes the message seen # fg - {} or foreground color or -fg namespace upvar ::alited obPav obPav variable list variable info variable lastred ClearRed set llen [llength $list] if {[lindex $list end] eq {} && $msg eq {}} return lappend list $msg lappend info $inf set lbx [$obPav LbxInfo] lassign [alited::FgFgBold] -> fgbold fgred if {$red || $see} { $lbx see end } if {$red} { set fgbold $fgred set lastred $llen } elseif {!$bold && $fg eq {}} { return } if {$fg ne {}} { if {$fg eq "-fg"} { lassign [alited::FgAdditional] -> fg } set fgbold $fg } $lbx itemconfigure end -foreground $fgbold }
Switches a variable of flag "listbox is focused".
proc ::alited::info::SwitchFocustext {} { # Switches a variable of flag "listbox is focused". namespace upvar ::alited obPav obPav variable focustext if {$focustext} { set focustext 0 set lbx [$obPav LbxInfo] focus $lbx catch { $lbx selection clear 0 end $lbx selection set 0 $lbx activate 0 $lbx see 0 } } else { set focustext 1 FocusOut [$obPav SbhInfo] alited::main::FocusText } }
Initializes alited app.
proc ::alited::ini::_init {} { # Initializes alited app. namespace upvar ::alited al al obPav obPav obDlg obDlg obDl2 obDl2 obFND obFND obFN2 obFN2 obCHK obCHK obRun obRun namespace upvar ::alited::pref em_Num em_Num em_ico em_ico em_inf em_inf em_mnu em_mnu ::apave::initBaltip obj chooserGeomVars ::alited::DirGeometry ::alited::FilGeometry GetUserDirs CheckIni ReadIni InitFonts lassign [::apave::InitTheme $al(THEME) $::alited::LIBDIR] theme lbd ::apave::initWM -cursorwidth $al(CURSORWIDTH) -theme $theme -labelborder $lbd ::apave::iconImage -init $al(INI,ICONS) yes set ::apave::MC_NS ::alited InitGUI GetUserDirs # get hotkeys alited::pref::IniKeys alited::pref::RegisterKeys alited::pref::KeyAccelerators # create main apave objects ::apave::APave create $obPav $al(WIN) foreach ob [::alited::ListPaved] { ::apave::APave create [set $ob] $al(WIN) } # here, the order of icons defines their order in the toolbar set listIcons [::apave::iconImage] # the below icons' order defines their order in the toolbar TipToolHotkeys foreach {icon} {none gulls heart add change delete up down paste plus minus retry misc previous previous2 next next2 folder file OpenFile SaveFile saveall undo redo box replace ok color date help run e_menu other trash actions paste copy} { set img [CreateIcon $icon] if {$icon in {file OpenFile SaveFile saveall box undo redo replace ok color date help run e_menu other}} { if {$icon eq {run}} { set com "-command alited::tool::TooltipRun" } else { set com "" } append al(atools) " $img-big \{{} -tip {$::alited::al(MC,ico$icon)@@ -under 4 $com} -popup {alited::tool::PopupBar %X %Y} " switch $icon { file { append al(atools) "-com alited::file::NewFile\}" } OpenFile { append al(atools) "-com alited::file::OpenFile\} sev 6" } SaveFile { append al(atools) "-com alited::file::SaveFile -state disabled\}" } saveall { append al(atools) "-com alited::file::SaveAll -state disabled\} sev 6" } undo { append al(atools) "-com alited::tool::Undo -state disabled\}" } redo { append al(atools) "-com alited::tool::Redo -state disabled\} sev 6" } box { append al(atools) "-com alited::project::_run\} sev 6" } replace { append al(atools) "-com alited::find::_run\}" } ok { append al(atools) "-com alited::CheckRun\}" } color { append al(atools) "-com alited::tool::ColorPicker\}" } date { append al(atools) "-com alited::tool::DatePicker\}" } help { append al(atools) "-com alited::tool::Help\} sev 6" } run { append al(atools) "-com {alited::tool::_run {} {} -doit yes}\}" } e_menu { image create photo $img-big -data $::alited::img::_AL_IMG(e_menu) append al(atools) "-com {alited::tool::e_menu o=0}\}" } other { append al(atools) "-com alited::tool::tkcon\}" } } } } # e_menu items for the toolbar set limgs [list] set em_N [Em_Number $em_Num] for {set i [set was 0]} {$i<$em_N} {incr i} { if {[info exists em_ico($i)] && ($em_ico($i) ni {none {}} || $em_inf($i) eq {})} { if {[incr was]==1 && $em_inf($i) ne {}} { append al(atools) { sev 6} } if {$em_inf($i) eq {}} { append al(atools) { sev 6} } else { set tico [alited::TextIcon $em_ico($i)] if {[string length $tico]==1 || ![string is ascii $tico]} { set em_ico($i) $tico set img _$i set txt "-t $tico" } else { set img [CreateIcon $tico]-big set txt {} } if {[lsearch -exact $limgs $img]>-1} { set msg [msgcat::mc {ERROR! Duplicate tool icon: }] append msg [string map {-big {}} [lindex [split $img _] end]] after idle [list alited::Message $msg 4] continue } set com [alited::tool::EM_command $i] if {$com ne {}} { lappend limgs $img set tip $em_mnu($i) append al(atools) " $img \{{} -tip {$tip@@ -under 4 -command {alited::ini::ToolbarTip $i}} $txt -popup {alited::tool::PopupBar %X %Y} -com {$com}\}" } } } } for {set i 0} {$i<8} {incr i} { image create photo alimg_pro$i -data [set ::alited::img::_AL_IMG($i)] } image create photo alimg_tclfile -data [set ::alited::img::_AL_IMG(Tcl)] image create photo alimg_kbd -data [set ::alited::img::_AL_IMG(kbd)] # styles & fonts used in "small" dialogues initStyles lassign [obj create_FontsType small -size $al(FONTSIZE,small)] al(FONT,defsmall) al(FONT,monosmall) lassign [alited::FgFgBold] -> al(FG,Bold) }
Adds a config directory to the list of all config dirs.
| config directory |
| list of config dirs |
Returns -1, if confdir was absent in configs.
proc ::alited::ini::AddConfigDir {confdir configs} { # Adds a config directory to the list of all config dirs. # confdir - config directory # configs - list of config dirs # Returns -1, if *confdir* was absent in *configs*. set ::alited::CONFIGDIR $confdir if {[set res [::apave::lsearchFile $configs $confdir]]>-1} { set configs [lreplace $configs $res $res] } set ::alited::CONFIGS [linsert $configs 0 $confdir] return $res }
Gets current version of alited.
proc ::alited::ini::AlitedVersion {} { # Gets current version of alited. return [package require alited] }
Checks if the configuration directory exists and if not asks for it.
proc ::alited::ini::CheckIni {} { # Checks if the configuration directory exists and if not asks for it. namespace upvar ::alited al al if {![file exists $::alited::INIDIR] || ![file exists $::alited::PRJDIR]} { ::apave::initWM -cursorwidth $al(CURSORWIDTH) InitGUI catch {destroy .tex} if {![GetConfiguration]} exit ::alited::main_user_dirs GetUserDirs yes CreateUserDirs set al(ALEversion) [AlitedVersion] } if {[AddConfigDir $::alited::CONFIGDIR $::alited::CONFIGS]<0} { SaveIniGlob } }
Updates significant data of current version of alited.
| yes, if it's called from menu |
proc ::alited::ini::CheckUpdates {doit} { # Updates significant data of current version of alited. # doit - yes, if it's called from menu namespace upvar ::alited al al DATAUSERINIFILE DATAUSERINIFILE MNUDIR MNUDIR set al(_updmnu_) [expr {$doit || [package vcompare $al(ALEversion) $al(MNUversion)]<0}] set al(_updini_) [expr {$doit || [package vcompare $al(ALEversion) $al(INIversion)]<0}] if {!$al(_updmnu_) && !$al(_updini_)} return set head "\n [msgcat::mc {Some things have been changed in alited %v.}] " set head [string map [list %v v[AlitedVersion]] $head] set date _[clock format [clock seconds] -format %Y-%m-%d] set al(_updDirMnu_) [file normalize $al(EM,mnudir)$date] set inidir [file dirname $al(INI)] set inifile [file tail $al(INI)] set iniext [file extension $inifile] set inifile [file rootname $inifile] set al(_updFileIni_) [file normalize [file join $inidir $inifile$date$iniext]] set pobj alitedObjToDel ::apave::APave create $pobj $al(WIN) set mnudo [expr {![file exists $al(_updDirMnu_)]}] set inido [expr {![file exists $al(_updFileIni_)]}] if {$doit} { set lab5 {} set ::alited::al(_updmnu_) $mnudo set ::alited::al(_updini_) $inido } else { set lab5 [list seh2 {{} {-pady 10} {}} {} lab5 {{} {-padx 5} {-t {$::alited::al(MC,restart)}}} {} ] } lassign [$pobj input {} $al(MC,updateALE)\ v$al(ALEversion) [list lab1 {{} {} {-t {$::alited::al(MC,updLab1)}}} {} chb1 {{} {-padx 10} {-t {$::alited::al(MC,updmnu)}}} {$::alited::al(_updmnu_)} chb2 {{} {-padx 10} {-t {$::alited::al(MC,updini)}}} {$::alited::al(_updini_)} seh1 {{} {-pady 10} {}} {} lab2 {{} {} {-t {$::alited::al(MC,updLab2)}}} {} lab3 {{} {-padx 20} {-t {$::alited::al(_updDirMnu_)}}} {} lab4 {{} {-padx 20} {-t {$::alited::al(_updFileIni_)}}} {} {*}$lab5 ] -head $head -weight bold -buttons "butHELP {View Changes} ::alited::ini::ViewUpdates" -resizable no -focus *YES] res updmnu updini catch {$pobj destroy} if {!$res} {if {$doit} return else exit} if {!$updmnu && !$updini} return CreatePossibleNewDirs ;# it's good to do it here set err {} set mnudone 0 set inidone 0 if {$updmnu && $mnudo && ![catch {file rename $al(EM,mnudir) $al(_updDirMnu_)} err]} { set err {} } if {$err eq {} && $updmnu && $mnudo} { if {![catch {file copy $MNUDIR $al(EM,mnudir)} err]} { set err {} set mnudone 1 } } if {$err eq {} && $updini && $inido && ![catch {file copy $al(INI) $al(_updFileIni_)} err]} { set err {} set inidone 1 } if {$err eq {} && $inidone} { UpdateTemplates $DATAUSERINIFILE } alited::ini::SaveIni if {!$doit} { alited::Exit - 1 no } else { if {$err ne {}} { ::apave::APave create $pobj $al(WIN) $pobj ok err Error $err -text 1 -w 50 -h {3 5} catch {$pobj destroy} } elseif {$mnudone || $inidone} { set msg "$al(MC,updateALE):" if {$mnudone} {append msg " $al(MC,updmnu)"} if {$inidone} {append msg " $al(MC,updini)"} alited::Message "\n $msg \n" 3 } } }
Create an icon (of normal and big size).
| name of icon |
proc ::alited::ini::CreateIcon {icon} { # Create an icon (of normal and big size). # icon - name of icon set img alimg_$icon catch {image create photo $img-big -data [::apave::iconData $icon]} catch {image create photo $img -data [::apave::iconData $icon small]} return $img }
Creates macros' directory.
proc ::alited::ini::CreateMacrosDir {} { # Creates macros' directory. namespace upvar ::alited al al DATAUSER DATAUSER set macrodir [file dirname [alited::edit::MacroFileName -]] if {![file exists $macrodir]} { file mkdir $macrodir foreach f [glob -nocomplain [file join $DATAUSER macro *]] { file copy $f $macrodir } } }
Creates a user directories, possibly new after v1.4.0 (e.g. macro).
proc ::alited::ini::CreatePossibleNewDirs {} { # Creates a user directories, possibly new after v1.4.0 (e.g. macro). CreateMacrosDir }
Creates main directories for settings.
proc ::alited::ini::CreateUserDirs {} { # Creates main directories for settings. namespace upvar ::alited al al USERDIR USERDIR INIDIR INIDIR PRJDIR PRJDIR MNUDIR MNUDIR DATAUSER DATAUSER DATAUSERINIFILE DATAUSERINIFILE PRJEXT PRJEXT foreach dir {USERDIR INIDIR PRJDIR} { catch {file mkdir [set $dir]} } if {![file exists $al(INI)]} { file copy $DATAUSERINIFILE $al(INI) file copy [file join $DATAUSER prj default$PRJEXT] [file join $PRJDIR default$PRJEXT] file copy [file join $DATAUSER notes.txt] [file join $USERDIR notes.txt] ReadIni } set emdir [file dirname $al(EM,mnudir)] if {![file exists $emdir]} { file mkdir $emdir file copy $MNUDIR $emdir file copy [file join [file dirname $MNUDIR] em_projects] $emdir } CreatePossibleNewDirs }
Displays the settings file, just to look behind the wall.
proc ::alited::ini::EditSettings {} { # Displays the settings file, just to look behind the wall. namespace upvar ::alited al al obPav obPav after idle alited::ini::HighlightFileText $obPav vieweditFile $al(INI) {} -rotext 1 -h 25 }
Gets a real number of e_menu items counting non-empty ones only.
| current number of e_menu items |
proc ::alited::ini::Em_Number {em_N} { # Gets a real number of e_menu items counting non-empty ones only. # em_N - current number of e_menu items namespace upvar ::alited::pref em_inf em_inf for {set i $em_N} {$i>0} {} { set em_N $i incr i -1 if {[info exists em_inf($i)] && $em_inf($i) ne {}} { break } } return $em_N }
Gets the configuration directory's name.
proc ::alited::ini::GetConfiguration {} { # Gets the configuration directory's name. namespace upvar ::alited al al obDl2 obDl2 variable configs set configs $::alited::CONFIGS if {![llength $configs]} {lappend configs $::alited::CONFIGDIR} if {[lindex $configs 0] eq {-}} { set configs [lreplace $configs 0 0] ;# legacy } set head [string map [list %d $::alited::CONFIGDIRSTD] $al(MC,chini2)] set pobj $obDl2 if {[info commands $pobj] eq {}} { # at first start, there are no apave objects bound to the main window of alited # -> create an independent one to be deleted afterwards set pobj alitedObjToDel ::apave::APave create $pobj } set res [$pobj input {} $al(MC,chini1) [list diR1 [list $al(MC,chini3) {} [list -title $al(MC,chini3) -w 50 -values $configs -clearcom {alited::main::ClearCbx %w ::alited::ini::configs}]] "{$::alited::CONFIGDIR}" ] -head $head -help alited::ini::Help -resizable no] catch {alitedObjToDel destroy} lassign $res ok confdir if {$ok} { set confdir [file normalize [string trim $confdir]] if {$confdir eq {}} { set ok no } else { AddConfigDir $confdir $configs } } return $ok }
Gets names of user directories for settings.
| yes, if called to initialize mnu dir; optional, default no |
proc ::alited::ini::GetUserDirs {{initmnu no}} { # Gets names of user directories for settings. # initmnu - yes, if called to initialize mnu dir namespace upvar ::alited al al ::alited::main_user_dirs if {$al(prjroot) eq {}} { set ::alited::BAKDIR [file join $::alited::USERDIR .bak] } else { set ::alited::BAKDIR [file join $al(prjroot) .bak] } if {![file exists $::alited::BAKDIR]} { catch {file mkdir $::alited::BAKDIR} } set mnudir [file join $::alited::USERDIR e_menu menus] if {$initmnu && ![file exists $mnudir]} { set al(EM,mnudir) $mnudir ;# to have e_menu in each config dir } set al(INI) [file join $::alited::INIDIR alited.ini] }
Shows "Configurations" help.
proc ::alited::ini::Help {} { # Shows "Configurations" help. alited::Help $::alited::al(WIN) }
Highlights a text of a file.
| the text's path; optional, default "" |
| the file name (extension); optional, default "" |
| flag "readonly text" optional, default 1 |
| additional options |
proc ::alited::ini::HighlightFileText {{wtxt {}} {fname {}} {ro 1} args} { # Highlights a text of a file. # wtxt - the text's path # fname - the file name (extension) # ro - flag "readonly text" # args - additional options namespace upvar ::alited al al obPav obPav set colors [alited::Hl_Colors] if {$wtxt eq {}} {set wtxt [$obPav TexM]} if {$fname eq {}} {set fname $al(INI)} set plcom [alited::HighlightAddon $wtxt $fname $colors] ::hl_tcl::hl_init $wtxt -font $al(FONT,txt) -dark [$obPav csDark] -multiline 1 -colors $colors -readonly $ro -plaintext 0 -plaincom $plcom {*}$args ::hl_tcl::hl_text $wtxt alited::main::SetTabs $wtxt [lindex [alited::main::CalcIndentation] 0] }
Loads main fonts for alited to use as default and mono.
proc ::alited::ini::InitFonts {} { # Loads main fonts for alited to use as default and mono. namespace upvar ::alited al al MSGSDIR MSGSDIR if {$al(FONT) ne {}} { catch { obj basicDefFont [dict get $al(FONT) -family] } set smallfont $al(FONT) catch {dict set smallfont -size $al(FONTSIZE,small)} foreach font {TkDefaultFont TkMenuFont TkHeadingFont TkCaptionFont} { font configure $font {*}$al(FONT) } foreach font {TkSmallCaptionFont TkIconFont TkTooltipFont} { font configure $font {*}$smallfont } ::baltip::configure -font $smallfont } set statusfont [obj basicSmallFont] catch {dict set statusfont -size $al(FONTSIZE,small)} obj basicSmallFont $statusfont obj basicFontSize $al(FONTSIZE,std) set gl [file join $MSGSDIR $al(LOCAL)] if {[catch {set flist [glob "$gl.msg"]}] || $flist eq {}} { set al(LOCAL) en } if {$al(LOCAL) ni {en {}}} { # load localized messages msgcat::mcload $MSGSDIR msgcat::mclocale $al(LOCAL) alited::msgcatMessages } else { msgcat::mclocale en } }
Initializes GUI.
proc ::alited::ini::InitGUI {} { # Initializes GUI. namespace upvar ::alited al al obj basicFontSize $al(FONTSIZE,std) if {$al(INI,HUE)} {obj csToned $al(INI,CS) $al(INI,HUE)} if {$al(CURSORCOLOR) eq {}} { set al(CURSORCOLOR) [lindex [obj csGet $al(INI,CS)] 7] } obj csSet $al(INI,CS) . -doit -clrcurs $al(CURSORCOLOR) if {$al(INI,HUE)} {obj csToned $al(INI,CS) $al(INI,HUE) yes} set Dark [obj csDark] if {![info exists al(ED,clrCOM)] || ![info exists al(ED,CclrCOM)] || ![info exists al(ED,Dark)] || $al(ED,Dark) != $Dark} { alited::pref::Tcl_Default $al(syntaxidx) yes alited::pref::C_Default $al(syntaxidx) yes } set clrnams [::hl_tcl::hl_colorNames] set clrvals [list] foreach clr $clrnams { if {[info exists al(ED,$clr)]} { lappend clrvals [set al(ED,$clr)] } } if {[llength $clrvals]==[llength $clrnams]} { ::hl_tcl::hl_colors -AddTags $Dark {*}$clrvals } ::hl_tcl::hl_colors . $Dark {*}$clrvals ;# default Tcl syntax colors if {!$al(ED,BlinkCurs)} { lassign [obj defaultATTRS tex] texopts texattrs obj defaultATTRS tex $texopts [dict set texattrs -insertofftime 0] } obj setShowOption -resizable 0 if {[::asKDE]} { ;# esp. for KDE: # dialogue windows should be topmost, otherwise KDE hides them at losing focus obj setShowOption -ontop yes } lassign [::apave::defaultAttrs spx] opts atrs ::apave::defaultAttrs spx $opts "$atrs -justify center -w 9" }
Initializes widget styles for alited.
proc ::alited::ini::initStyles {} { # Initializes widget styles for alited. namespace upvar ::alited al al ::apave::initStyles ::apave::initStylesFS -size $al(FONTSIZE,small) }
Gets Linux terminal called by x-terminal-emulator, saves the result to al(EM,tt).
proc ::alited::ini::InitXterminal {} { # Gets Linux terminal called by x-terminal-emulator, saves the result to al(EM,tt). # See also: tool::EM_Options namespace upvar ::alited al al set al(EM,tt) $al(EM,tt=) set tty [lindex [split $al(EM,tt)] 0] set xte x-terminal-emulator if {[::isunix] && [file tail $tty] eq $xte} { if {[auto_execok $tty] eq {} || [catch {set man [exec man $xte]}]} { set al(EM,tt) {} ;# no x-terminal-emulator command return } switch -glob $man { GNOME-TERMINAL* {set tt {gnome-terminal --wait}} XFCE4-TERMINAL* {set tt xfce4-terminal} default {return} } set al(EM,tt) $tt[string range $al(EM,tt=) [string length $tty] end] } }
Tool bar for Projects (subset of main toolbar).
proc ::alited::ini::ProjectsToolbar {} { # Tool bar for Projects (subset of main toolbar). # See also: _init, project::Tab5 namespace upvar ::alited al al namespace upvar ::alited::pref em_Num em_Num em_ico em_ico em_inf em_inf em_mnu em_mnu set e_menu_icon {iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAgMAAABinRfyAAAADFBMVEUAAAAASZL///8Atv8UVAVH AAAAAXRSTlMAQObYZgAAACZJREFUCNdjYA0NDQAS9ReARN4FKDdr1QQGtvz/E8AsZLHUUAJiAI6+ FtcEguWyAAAAAElFTkSuQmCC} set al(atools) [list] foreach {icon} {run e_menu other} { set img [CreateIcon $icon] if {$icon eq {run}} { set com "-command alited::tool::TooltipPrjRun" } else { set com "" } append al(atools) " $img \{{} -tip {$::alited::al(MC,ico$icon)@@ -under 4 $com} " switch $icon { run { append al(atools) "-com alited::ini::ToolPrjRun\}" } e_menu { image create photo $img -data $e_menu_icon append al(atools) "-com alited::ini::ToolPrjEM\}" } other { append al(atools) "-com alited::ini::ToolPrjTkcon\}" } } } # e_menu items for the toolbar set limgs [list] set em_N [Em_Number $em_Num] for {set i [set was 0]} {$i<$em_N} {incr i} { if {[info exists em_ico($i)] && ($em_ico($i) ni {none {}} || $em_inf($i) eq {})} { if {[incr was]==1 && $em_inf($i) ne {}} { append al(atools) { sev 6} } if {$em_inf($i) eq {}} { append al(atools) { sev 6} } else { set tico [alited::TextIcon $em_ico($i)] if {[string length $tico]==1 || ![string is ascii $tico]} { set em_ico($i) $tico set img _$i set txt "-t $tico -font {[obj boldTextFont 12]}" } else { set img [CreateIcon $tico] set txt {} } lappend limgs $img set tip $em_mnu($i) append al(atools) " $img \{{} -tip {$tip@@ -under 4 -command {alited::ini::ToolPrjTip $i}} $txt -com {alited::ini::ToolPrjCommand $i}\}" } } } }
Reads alited application's and project's settings.
| project file's name; optional, default "" |
proc ::alited::ini::ReadIni {{projectfile {}}} { # Reads alited application's and project's settings. # projectfile - project file's name namespace upvar ::alited al al namespace upvar ::alited::pref em_Num em_Num em_NumMax em_NumMax em_ico em_ico em_inf em_inf em_mnu em_mnu namespace upvar ::alited::project prjlist prjlist prjinfo prjinfo alited::pref::Tkcon_Default set prjlist [list] set al(TPL,list) [list] set al(KEYS,bind) [list] set em_i 0 set fontsize [expr {$al(FONTSIZE,std)+1}] set al(FONT,txt) "-family {[obj basicTextFont]} -size $fontsize" lassign "" ::alited::Pan_wh ::alited::PanL_wh ::alited::PanR_wh ::alited::PanBM_wh ::alited::PanTop_wh ::alited::al(GEOM) puts "alited pwd : [pwd]" puts "alited reading: $al(INI)" if {$al(ini_file) eq {}} { # al(ini_file) may be already filled (see alited.tcl) set al(ini_file) [split [readTextFile $::alited::al(INI)] \n] } set mode "" foreach stini $al(ini_file) { switch -exact $stini { {[Geometry]} - {[Options]} - {[Projects]} - {[Templates]} - {[Keys]} - {[EM]} - {[Tkcon]} - {[Misc]} - {[Formats]} { set mode $stini continue } } # any line may be potentially bad formed => catch errors catch { if {[set i [string first = $stini]]>0} { set nam [string range $stini 0 $i-1] set val [string range $stini $i+1 end] switch -exact $mode { {[Geometry]} {ReadIniGeometry $nam $val} {[Options]} {ReadIniOptions $nam $val} {[Templates]} {ReadIniTemplates $nam $val} {[Keys]} {ReadIniKeys $nam $val} {[EM]} {ReadIniEM $nam $val em_i} {[Tkcon]} {ReadIniTkcon $nam $val} {[Misc]} {ReadIniMisc $nam $val} {[Formats]} {ReadIniFormats $nam $val} } } } } if {[set al(PTP,text) [lindex $al(PTP,list) 1]] eq {}} { set al(PTP,text) [alited::project::TplDefaultText] set al(PTP,list) [list Default $al(PTP,text)] } set al(PTP,name) [lindex $al(PTP,list) 0] set al(PTP,names) [list] foreach {n c} $al(PTP,list) {lappend al(PTP,names) $n} set em_Num [expr {min($em_NumMax,[Em_Number $em_i]+3)}] while {$em_i < $em_Num} { lassign {} em_ico($em_i) em_inf($em_i) em_mnu($em_i) incr em_i } if {$projectfile eq {} && $al(prjfile) eq {}} { # some options may be active outside of any project; fill them with defaults foreach opt {multiline indent indentAuto EOL trailwhite} { set al(prj$opt) $al(DEFAULT,prj$opt) } } else { if {$projectfile eq {}} { set projectfile $al(prjfile) } else { set al(prjfile) $projectfile } ReadIniOptions project $projectfile } catch { lassign [split $::alited::PanR_wh] - w1 - h1 lassign [split $::alited::PanTop_wh] - w2 - h2 if {($h1-$h2)<60} { set h2 [expr {$h1-60}] set ::alited::PanTop_wh "-w $w2 -h $h2" ;# the status bar is wanted } } if {$al(RE,leaf) eq {}} {set al(RE,leaf) $al(RE,leafDEF)} ReadIniPrj lassign [::apave::defaultAttrs tex] - atrs set pad [expr {$al(CURSORWIDTH) + 2}] append atrs " -spacing1 $al(ED,sp1) -spacing2 $al(ED,sp2) -spacing3 $al(ED,sp3) -padx $pad -pady $pad -insertwidth $al(CURSORWIDTH) -bd 0" ::apave::defaultAttrs tex "" $atrs if {!$al(INI,belltoll)} { ; proc ::bell args {} ;# no bells } if {![string is digit -strict $al(INI,confirmexit)]} { set al(INI,confirmexit) 1 } if {![info exists al(tkcon,clrbg)]} { alited::pref::Tkcon_Default alited::pref::Tkcon_Default1 } InitXterminal set al(ini_file) {} ;# to reread alited.ini contents, at need in next time }
Gets e_menu options of alited.
| name of option |
| value of option |
| name of em_i (index in arrays of e_menu data) |
proc ::alited::ini::ReadIniEM {nam val emiName} { # Gets e_menu options of alited. # nam - name of option # val - value of option # emiName - name of em_i (index in arrays of e_menu data) namespace upvar ::alited al al namespace upvar ::alited::pref em_NumMax em_NumMax em_ico em_ico em_inf em_inf em_mnu em_mnu upvar $emiName em_i switch -exact $nam { emPD {set al(EM,PD=) [::apave::UnixPath $val]} emTcl { set val [::apave::UnixPath $val] if {[string first { } $val]>0} { tk_messageBox -title Warning -icon warning -message "The path to Tcl executable\n\n\"$val\"\n\ncontains spaces.\n \nThis path doesn't fit alited. Only 'non-space' ones do.\n \n==> Change this setting:\nPreferences/Tools/tclsh..." } else { set al(EM,Tcl) $val } } emTclList { set al(EM,TclList) {} foreach t [split [string trim $val] \t] { if {[string trim $t] ne {}} { append al(EM,TclList) \t [::apave::UnixPath $t] } } } em_run { if {$em_i < $em_NumMax} { lassign [split $val \t] v1 v2 v3 if {$v1 eq "1" && $v2 eq {}} { lassign {} em_ico($em_i) em_inf($em_i) ;# it's a separator in alited v1.6.1 } elseif {$v1 eq "0" && $v3 ne {}} { set em_ico($em_i) $v2 set em_inf($em_i) $v3 ;# it's an item in alited v1.6.1 } else { set em_ico($em_i) $v1 ;# it's a separator / item in v1.6.2 set em_inf($em_i) $v2 } set em_mnu($em_i) [::apave::NormalizeName [lindex $em_inf($em_i) end]] incr em_i } } } if {[string trim $val] eq {}} return ;# options below should be non-empty switch -exact $nam { emgeometry {set al(EM,geometry) $val} emsave { ;# messy for compatibility: switch $val [list 3 - {} {set al(EM,save) 3} 2 - Current - {Current file} - $al(MC,currfile) {set al(EM,save) 2} default {set al(EM,save) 1} ] } emtt {set al(EM,tt=) $val} emttList { foreach tt [split $al(EM,tt=List) \t] { if {[string first \t$tt \t$val]<0} { append val \t$tt ;# let default items be in the list } } set al(EM,tt=List) $val } emwt {set al(EM,wt=) $val} emmenu {set al(EM,mnu) [::apave::UnixPath $val]} emmenudir { set val [::apave::UnixPath $val] if {[file exists $val]} {set al(EM,mnudir) $val} } emcs {set al(EM,CS) $val} emowncs {set al(EM,ownCS) $val} emdiff {set al(EM,DiffTool) $val} emh {set al(EM,h=) [::apave::UnixPath $val]} } # emexec #\{set al(EM,exec) $val#\} }
Gets pluginable formatters of alited.
| name of option |
| value of option |
proc ::alited::ini::ReadIniFormats {nam val} { # Gets pluginable formatters of alited. # nam - name of option # val - value of option namespace upvar ::alited al al switch -exact -- $nam { pluginable { lassign $val fullformname ev set fform [alited::edit::FormatterName $fullformname] set al(FORMATS,$fform,$ev) $val } } }
Gets the geometry options of alited.
| name of option |
| value of option |
proc ::alited::ini::ReadIniGeometry {nam val} { # Gets the geometry options of alited. # nam - name of option # val - value of option namespace upvar ::alited al al switch -glob -- $nam { Pan* { lassign [::apave::splitGeometry $val] w h set ::alited::${nam}_wh "-w $w -h $h" } GEOM { lassign [::apave::splitGeometry $val] w h x y set ::alited::al(GEOM) "-geometry $x$y" } geomfind {set ::alited::find::geo $val} geomfind2 {set ::alited::find::geo2 $val} geomproject {set ::alited::project::geo $val} geompref {set ::alited::pref::geo $val} dirgeometry {set ::alited::DirGeometry $val} filgeometry {set ::alited::FilGeometry $val} favgeometry {set ::alited::favgeometry $val} tplgeometry {set ::alited::tplgeometry $val} treecw0 {set al(TREE,cw0) $val} treecw1 {set al(TREE,cw1) $val} runGeometry {set al(runGeometry) $val} fontdetach {set al(fontdetach) $val} detach* { set id [string range $nam 6 end] lassign [alited::file::DetachedInfo $id] pobj set $pobj $val } } }
Gets keys options of alited.
| name of option |
| value of option |
proc ::alited::ini::ReadIniKeys {nam val} { # Gets keys options of alited. # nam - name of option # val - value of option namespace upvar ::alited al al switch -exact -- $nam { key {lappend al(KEYS,bind) $val} } }
Gets miscellaneous options of alited.
| name of option |
| value of option |
proc ::alited::ini::ReadIniMisc {nam val} { # Gets miscellaneous options of alited. # nam - name of option # val - value of option namespace upvar ::alited al al switch -glob -- $nam { isfavor {set al(FAV,IsFavor) $val} showinfo {set al(TREE,showinfo) $val} HelpedMe {set ::alited::helpedMe $val} listSBL - checkgeo - tonemoves - moveall - chosencolor - sortList - activemacro - commentmode - format_separ1 - format_separ2 - TIPS,* - MNUGEO,* - markwidth - klndweeks - topFindRepl { set al($nam) $val } tplilast {set ::alited::unit::ilast $val} incdec {lassign $val al(incdecName) al(incdecDate) al(incdecSize) al(incdecExtn)} blifo {set al(lifo) [string is true $val]} InRE2 {set ::alited::find::InRE2 [::alited::ProcEOL $val in]} ExRE2 {set ::alited::find::ExRE2 [::alited::ProcEOL $val in]} chInRE2 {set ::alited::find::chInRE2 [string is true $val]} chExRE2 {set ::alited::find::chExRE2 [string is true $val]} geoRE2 {set ::alited::find::geoRE2 $val} } }
Gets various options of alited.
| name of option |
| value of option |
proc ::alited::ini::ReadIniOptions {nam val} { # Gets various options of alited. # nam - name of option # val - value of option namespace upvar ::alited al al set clrnames [::hl_tcl::hl_colorNames] foreach lng {{} C} { set nam1 [string range $nam [string length $lng] end] if {[lsearch $clrnames $nam1]>-1} { set al(ED,$nam) $val return } } switch -glob -- $nam { comm_port_list {set al(comm_port_list) $val} project { set al(prjfile) [::apave::UnixPath $val] set al(prjname) [file tail [file rootname $val]] } theme {set al(THEME) $val} cs {set al(INI,CS) $val} hue {set al(INI,HUE) $val} local {set al(LOCAL) $val} deffont {set al(FONT) $val} smallfontsize {set al(FONTSIZE,small) $val} stdfontsize {set al(FONTSIZE,std) $val} txtfont {set al(FONT,txt) $val} maxfind {set al(INI,maxfind) $val} confirmexit {set al(INI,confirmexit) $val} belltoll {set al(INI,belltoll) $val} spacing1 {set al(ED,sp1) $val} spacing2 {set al(ED,sp2) $val} spacing3 {set al(ED,sp3) $val} TclKeyWords {set al(ED,TclKeyWords) $val} CKeyWords {set al(ED,CKeyWords) $val} clrDark {set al(ED,Dark) $val} save_onadd - save_onclose - save_onsave {set al(INI,$nam) $val} TclExts { set al(TclExts) [split $val] foreach e $al(TclExtsDef) { if {$e ni $al(TclExts)} {lappend al(TclExts) $e} } } ClangExts {set al(ClangExts) $val} TextExts {set al(TextExts) $val} REbranch {set al(RE,branch) $val} REproc {set al(RE,proc) $val} REproc2 {set al(RE,proc2) $val} REleaf {set al(RE,leaf) $val} REleaf2 {set al(RE,leaf2) $val} UseLeaf {set al(INI,LEAF) [string is true -strict $val]} Lines1 {set al(INI,LINES1) $val} RecentFiles {set al(INI,RECENTFILES) $val} MaxLast {set al(FAV,MAXLAST) $val} MaxFiles {set al(MAXFILES) $val} barlablen {set al(INI,barlablen) $val} bartiplen {set al(INI,bartiplen) $val} isfindrepl {set al(INI,isfindrepl) $val} prjtpls {set al(PTP,list) [::alited::ProcEOL $val in]} backup { if {$val ne {.bak}} {set val {}} set al(BACKUP) $val } maxbackup {set al(MAXBACKUP) $val} gutterwidth {set al(ED,gutterwidth) $val} guttershift {set al(ED,guttershift) $val} btsbd {set al(ED,btsbd) $val} BlinkCurs {set al(ED,BlinkCurs) $val} ClrCurs {set al(CURSORCOLOR) $val} cursorwidth {set al(CURSORWIDTH) $val} prjdefault {set al(PRJDEFAULT) $val} DEFAULT,* {set al($nam) $val} findunit {set al(findunitvals) $val} afterstart {set al(afterstart) $val} ALEversion {set al(ALEversion) $val} todoahead {set al(todoahead) $val} } }
Reads a project's settings.
proc ::alited::ini::ReadIniPrj {} { # Reads a project's settings. namespace upvar ::alited al al PRJEXT PRJEXT set al(tabs) [list] set al(curtab) 0 set al(_check_menu_state_) 1 set al(comForce) [set al(comForceLs) {}] set al(expandFT) 0 set al(FAV,current) [list] set al(FAV,visited) [list] alited::favor::InitFavorites [list] alited::favor_ls::GetIni {} if {![file exists $al(prjfile)]} { set al(prjfile) [file join $::alited::PRJDIR default$PRJEXT] } set al(prjname) [file tail [file rootname $al(prjfile)]] puts "alited project: $al(prjfile)" if {[catch { set chan [open $::alited::al(prjfile) r] set mode "" while {![eof $chan]} { set stini [string trim [gets $chan]] switch -exact $stini { {[Tabs]} - {[Options]} - {[Favorites]} - {[Misc]} { set mode $stini continue } } set i [string first = $stini] set nam [string range $stini 0 $i-1] set val [string range $stini $i+1 end] # any line may be potentially bad formed => catch errors catch { switch -exact $mode { {[Tabs]} {ReadPrjTabs $nam $val} {[Options]} {ReadPrjOptions $nam $val} {[Favorites]} {ReadPrjFavorites $nam $val} {[Misc]} {ReadPrjMisc $nam $val} } } } } e]} then { puts "Not open: $al(prjfile)\n$e" set al(prjname) {} set al(prjfile) {} set al(prjroot) {} } if {$al(prjroot) eq {} && $al(prjname) eq {default}} {set al(prjroot) $::alited::DIR} alited::favor::InitFavorites $al(FAV,current) catch {close $chan} catch {cd $al(prjroot)} if {![string is digit -strict $al(curtab)] || $al(curtab)<0 || $al(curtab)>=[llength $al(tabs)]} { set al(curtab) 0 } ::apave::textEOL $al(prjEOL) alited::SaveRunOptions }
Sets new or updates old templates.
| name of option |
| value of option |
| if yes, sets wild cards for templates; optional, default yes |
proc ::alited::ini::ReadIniTemplates {nam val {updwc yes}} { # Sets new or updates old templates. # nam - name of option # val - value of option # updwc - if yes, sets wild cards for templates namespace upvar ::alited al al switch -exact -- $nam { tpl { lassign $val tplname tplkey if {[set i [lsearch -exact -index 0 $al(TPL,list) $tplname]]<0} { # at inserting new, check for possible duplicate 'tplkey' set i [lsearch -exact -index 1 $al(TPL,list) $tplkey] lappend al(TPL,list) $val # key bindings if {$tplkey ne {}} { if {$i<0} { # add a new key binding, for this template set kbval "template {$tplname} $tplkey {[lrange $val 2 end]}" lappend al(KEYS,bind) $kbval } else { # duplicate 'tplkey' => clear it in the new template, no key binding set val [lreplace $val 1 1 {}] set al(TPL,list) [lreplace $al(TPL,list) end end $val] } } } else { # at updating old, replace the contents only (remaining 'tplname tplkey') set val2 [lindex $al(TPL,list) $i] set val [list {*}[lrange $val2 0 1] {*}[lrange $val 2 end]] set al(TPL,list) [lreplace $al(TPL,list) $i $i $val] } } } if {$updwc} { foreach n {%d %t %u %U %m %w} { if {$n eq $nam} { if {$val ne ""} {set al(TPL,$n) $val} break } } } }
Gets tkcon options of alited.
| name of option |
| value of option |
proc ::alited::ini::ReadIniTkcon {nam val} { # Gets tkcon options of alited. # nam - name of option # val - value of option namespace upvar ::alited al al set al(tkcon,$nam) $val }
Gets favorites of project.
| name of option |
| value of option |
proc ::alited::ini::ReadPrjFavorites {nam val} { # Gets favorites of project. # nam - name of option # val - value of option namespace upvar ::alited al al switch -exact -- $nam { current - visited {lappend al(FAV,$nam) $val} saved {alited::favor_ls::GetIni $val} } }
Gets favorites of project.
| name of option |
| value of option |
proc ::alited::ini::ReadPrjMisc {nam val} { # Gets favorites of project. # nam - name of option # val - value of option namespace upvar ::alited al al switch -exact -- $nam { datafind { catch { # lists of find/replace strings to be restored only set ::alited::find::data(en1) {} set ::alited::find::data(en2) {} array set data [::alited::ProcEOL $val in] set ::alited::find::data(vals1) $data(vals1) set ::alited::find::data(vals2) $data(vals2) } } comforce {set al(comForce) $val} comforcech {set al(comForceCh) $val} comforcels {set al(comForceLs) $val} expandFT {set al(expandFT) $val} } }
Gets options of project.
| name of option |
| value of option |
proc ::alited::ini::ReadPrjOptions {nam val} { # Gets options of project. # nam - name of option # val - value of option if {$nam in {{} prjfile prjname}} { return ;# to avoid resetting the current project file name } namespace upvar ::alited al al set al($nam) $val }
Gets tabs of project.
| name of option |
| value of option |
proc ::alited::ini::ReadPrjTabs {nam val} { # Gets tabs of project. # nam - name of option # val - value of option namespace upvar ::alited al al if {[string trim $val] ne {}} { switch -exact -- $nam { tab { set fname [lindex $val 0] if {[lsearch -exact -index 0 $al(tabs) $fname]<0} { lappend al(tabs) $val lassign [split $val \t] - - isexp if {[string is boolean -strict $isexp]} { dict set al(expandUT) $fname $isexp } } } recent {alited::file::InsertRecent $val end} encode - eol { lassign [split $val \t] k v set al($k) $v } } } }
Saves a current configuration of alited on various events.
| flag "save on event" optional, default yes |
| serves to run this procedure after idle; optional, default no |
proc ::alited::ini::SaveCurrentIni {{saveon yes} {doit no}} { # Saves a current configuration of alited on various events. # saveon - flag "save on event" # doit - serves to run this procedure after idle # See also: project::Ok namespace upvar ::alited al al # for sessions to come if {![expr $saveon]} return # al(project::Ok) is set at switching projects and closing old project's files if {[info exists al(project::Ok)]} return variable afterID # run this code after updating GUI catch {after cancel $afterID} if {$doit} { SaveIni } else { set afterID [after idle ::alited::ini::SaveCurrentIni yes yes] } }
Saves a current configuration of alited.
| flag "for a new project" optional, default no |
proc ::alited::ini::SaveIni {{newproject no}} { # Saves a current configuration of alited. # newproject - flag "for a new project" namespace upvar ::alited al al obPav obPav namespace upvar ::alited::pref em_Num em_Num em_ico em_ico em_inf em_inf namespace upvar ::alited::project prjlist prjlist prjinfo prjinfo puts "alited storing: $al(INI)" set chan [open $::alited::al(INI) w] chan configure $chan -buffering full -buffersize 131072 puts $chan {[Options]} puts $chan "comm_port=$al(comm_port)" puts $chan "comm_port_list=$al(comm_port_list)" puts $chan "project=$al(prjfile)" puts $chan "theme=$al(THEME)" puts $chan "cs=$al(INI,CS)" puts $chan "hue=$al(INI,HUE)" puts $chan "local=$al(LOCAL)" puts $chan "deffont=$al(FONT)" puts $chan "smallfontsize=$al(FONTSIZE,small)" puts $chan "stdfontsize=$al(FONTSIZE,std)" puts $chan "txtfont=$al(FONT,txt)" puts $chan "maxfind=$al(INI,maxfind)" puts $chan "confirmexit=$al(INI,confirmexit)" puts $chan "belltoll=$al(INI,belltoll)" puts $chan "spacing1=$al(ED,sp1)" puts $chan "spacing2=$al(ED,sp2)" puts $chan "spacing3=$al(ED,sp3)" puts $chan "CKeyWords=$al(ED,CKeyWords)" puts $chan "TclKeyWords=$al(ED,TclKeyWords)" puts $chan "cursorwidth=$al(CURSORWIDTH)" set clrnams [::hl_tcl::hl_colorNames] foreach lng {{} C} { foreach nam $clrnams {puts $chan "$lng$nam=$al(ED,$lng$nam)"} } puts $chan "clrDark=$al(ED,Dark)" puts $chan "save_onadd=$al(INI,save_onadd)" puts $chan "save_onclose=$al(INI,save_onclose)" puts $chan "save_onsave=$al(INI,save_onsave)" puts $chan "TclExts=$al(TclExts)" puts $chan "ClangExts=$al(ClangExts)" puts $chan "TextExts=$al(TextExts)" puts $chan "REbranch=$al(RE,branch)" puts $chan "REproc=$al(RE,proc)" puts $chan "REproc2=$al(RE,proc2)" puts $chan "REleaf=$al(RE,leaf)" puts $chan "REleaf2=$al(RE,leaf2)" puts $chan "UseLeaf=$al(INI,LEAF)" puts $chan "Lines1=$al(INI,LINES1)" puts $chan "RecentFiles=$al(INI,RECENTFILES)" puts $chan "MaxLast=$al(FAV,MAXLAST)" puts $chan "MaxFiles=$al(MAXFILES)" puts $chan "barlablen=$al(INI,barlablen)" puts $chan "bartiplen=$al(INI,bartiplen)" puts $chan "isfindrepl=$al(INI,isfindrepl)" puts $chan prjtpls=[::alited::ProcEOL $al(PTP,list) out] puts $chan "backup=$al(BACKUP)" puts $chan "maxbackup=$al(MAXBACKUP)" puts $chan "gutterwidth=$al(ED,gutterwidth)" puts $chan "guttershift=$al(ED,guttershift)" puts $chan "btsbd=$al(ED,btsbd)" puts $chan "BlinkCurs=$al(ED,BlinkCurs)" puts $chan "ClrCurs=$al(CURSORCOLOR)" puts $chan "prjdefault=$al(PRJDEFAULT)" foreach k [array names al DEFAULT,*] { puts $chan "$k=$al($k)" } puts $chan "findunit=$al(findunitvals)" puts $chan "afterstart=$al(afterstart)" puts $chan "ALEversion=[AlitedVersion]" puts $chan "todoahead=$al(todoahead)" puts $chan {} puts $chan {[Templates]} foreach t $al(TPL,list) { puts $chan "tpl=$t" } foreach n {%d %t %u %U %m %w} { puts $chan "$n=$al(TPL,$n)" } puts $chan {} puts $chan {[Keys]} foreach k $al(KEYS,bind) { if {![string match template* $k] && ![string match action* $k]} { puts $chan "key=$k" } } puts $chan {} puts $chan {[EM]} puts $chan "emsave=$al(EM,save)" puts $chan "emPD=$al(EM,PD=)" puts $chan "emTcl=$al(EM,Tcl)" puts $chan "emTclList=$al(EM,TclList)" puts $chan "emh=$al(EM,h=)" puts $chan "emtt=$al(EM,tt=)" puts $chan "emttList=$al(EM,tt=List)" puts $chan "emwt=$al(EM,wt=)" puts $chan "emmenu=$al(EM,mnu)" puts $chan "emmenudir=$al(EM,mnudir)" puts $chan "emcs=$al(EM,CS)" puts $chan "emowncs=$al(EM,ownCS)" puts $chan "emgeometry=$al(EM,geometry)" # puts $chan "emexec=$al(EM,exec)" puts $chan "emdiff=$al(EM,DiffTool)" set em_N [Em_Number $em_Num] for {set i 0} {$i<$em_N} {incr i} { if {[info exists em_inf($i)]} { set em_run em_run= append em_run [alited::TextIcon $em_ico($i) in] \t $em_inf($i) puts $chan $em_run } } puts $chan {} puts $chan {[Tkcon]} foreach k [array names al tkcon,*] { puts $chan "[string range $k 6 end]=$al($k)" } # save misc settings puts $chan {} puts $chan {[Misc]} puts $chan "isfavor=$al(FAV,IsFavor)" puts $chan "chosencolor=$al(chosencolor)" puts $chan "showinfo=$al(TREE,showinfo)" set al(listSBL) [::alited::ProcEOL $al(listSBL) out] puts $chan "listSBL=$al(listSBL)" puts $chan "moveall=$al(moveall)" puts $chan "tonemoves=$al(tonemoves)" puts $chan "checkgeo=$al(checkgeo)" puts $chan "HelpedMe=$::alited::helpedMe" foreach k [array names al -glob TIPS,*] { puts $chan "$k=$al($k)" } foreach k [array names al -glob MNUGEO,*] { puts $chan "$k=$al($k)" } puts $chan "sortList=$al(sortList)" puts $chan "tplilast=$::alited::unit::ilast" puts $chan "incdec=$al(incdecName) $al(incdecDate) $al(incdecSize) $al(incdecExtn)" puts $chan "blifo=$al(lifo)" puts $chan "activemacro=$al(activemacro)" puts $chan InRE2=[::alited::ProcEOL $::alited::find::InRE2 out] puts $chan ExRE2=[::alited::ProcEOL $::alited::find::ExRE2 out] puts $chan "chInRE2=$::alited::find::chInRE2" puts $chan "chExRE2=$::alited::find::chExRE2" puts $chan "geoRE2=$::alited::find::geoRE2" puts $chan "commentmode=$al(commentmode)" puts $chan "format_separ1=$al(format_separ1)" puts $chan "format_separ2=$al(format_separ2)" puts $chan "markwidth=$al(markwidth)" puts $chan "klndweeks=$al(klndweeks)" puts $chan "topFindRepl=$al(topFindRepl)" # save the Edit/Formats pluginables puts $chan {} puts $chan {[Formats]} foreach n [array names al -glob FORMATS,*] { puts $chan "pluginable=$al($n)" } # save the geometry options puts $chan {} puts $chan {[Geometry]} puts $chan "runGeometry=$al(runGeometry)" puts $chan "geomfind=$::alited::find::geo" puts $chan "geomfind2=$::alited::find::geo2" puts $chan "geomproject=$::alited::project::geo" puts $chan "geompref=$::alited::pref::geo" puts $chan "dirgeometry=$::alited::DirGeometry" puts $chan "filgeometry=$::alited::FilGeometry" puts $chan "favgeometry=$::alited::favgeometry" puts $chan "tplgeometry=$::alited::tplgeometry" set wtree [$obPav Tree] set al(TREE,cw0) [$wtree column #0 -width] set al(TREE,cw1) [$wtree column #1 -width] puts $chan "treecw0=$al(TREE,cw0)" puts $chan "treecw1=$al(TREE,cw1)" foreach v {Pan PanL PanR PanBM PanTop} { if {[info exists al(width$v)]} { set w $al(width$v) } else { set w [winfo geometry [$obPav $v]] } puts $chan $v=$w } puts $chan "GEOM=[wm geometry $al(WIN)]" foreach id {1 2 3 4 5 6 7 8} { lassign [alited::file::DetachedInfo $id] pobj win if {[info exists $pobj]} { if {[winfo exists $win]} { set geo [wm geometry $win] } else { set geo [set $pobj] } puts $chan "detach$id=$geo" } else { break } } puts $chan "fontdetach=$al(fontdetach)" close $chan SaveIniPrj $newproject SaveIniGlob }
Save 3 lines of global configuration of alited: current .ini file, current project's path, list of config dirs
proc ::alited::ini::SaveIniGlob {} { # Save 3 lines of global configuration of alited: # current .ini file, current project's path, list of config dirs namespace upvar ::alited al al set cont [file dirname $al(INI)]\n[file dirname $al(prjfile)]\n$::alited::CONFIGS writeTextFile $::alited::USERLASTINI cont }
Saves settings of project.
| flag "for a new project" optional, default no |
proc ::alited::ini::SaveIniPrj {{newproject no}} { # Saves settings of project. # newproject - flag "for a new project" namespace upvar ::alited al al if {$al(prjroot) eq {}} return set tabs $al(tabs) set al(tabs) [list] puts "alited storing: $al(prjfile)" set chan [open $al(prjfile) w] chan configure $chan -buffering full -buffersize 262144 puts $chan {[Tabs]} lassign [alited::bar::GetBarState] TIDcur - wtxt if {!$newproject} { set tabs [alited::bar::BAR listTab] } foreach tab $tabs { ;# save the current files' list & states if {!$newproject} { set TID [lindex $tab 0] set tab [alited::bar::FileName $TID] if {[alited::file::IsNoName $tab]} continue if {$TID eq $TIDcur} { set pos [$wtxt index insert] } else { set pos [alited::bar::GetTabState $TID --pos] } # save the current cursor position (fit to all files) append tab \t $pos \t [alited::tree::IsExpandUT $tab] catch { set wrap [[alited::main::GetWTXT $TID] cget -wrap] if {$wrap ne {word}} { append tab \t $wrap ;# save the current wrap!=word (fit to strange files) } } } lappend al(tabs) $tab puts $chan tab=$tab } foreach rf $al(RECENTFILES) { if {![alited::file::IsNoName $rf]} { puts $chan recent=$rf } } foreach {key1 key2} {ENCODING encode EOL eol} { foreach k [array names al $key1,*] { if {$al($k) ni {utf-8 auto}} { # restrict the saved with currently used files only set fname [string range $k [string first , $k]+1 end] if {$fname in $al(RECENTFILES) || [alited::bar::FileTID $fname] ne {}} { puts $chan "$key2=$k\t$al($k)" } } } } puts $chan {} puts $chan {[Options]} puts $chan curtab=[alited::bar::CurrentTab 3] foreach {opt val} [array get al prj*] { puts $chan $opt=$val } if {!$newproject} { puts $chan {} puts $chan {[Favorites]} if {$al(FAV,IsFavor)} { set favlist [alited::tree::GetTree {} TreeFavor] } else { set favlist $al(FAV,current) } foreach curfav $favlist { puts $chan current=$curfav } foreach savfav [::alited::favor_ls::PutIni] { puts $chan saved=$savfav } foreach visited $al(FAV,visited) { puts $chan visited=$visited } puts $chan {} puts $chan {[Misc]} puts $chan datafind=[::alited::ProcEOL [array get ::alited::find::data] out] puts $chan comforce=$al(comForce) puts $chan comforcech=$al(comForceCh) puts $chan comforcels=$al(comForceLs) puts $chan expandFT=$al(expandFT) } puts \n close $chan }
Adds hotkeys to toolbar tips.
proc ::alited::ini::TipToolHotkeys {} { # Adds hotkeys to toolbar tips. namespace upvar ::alited al al append al(MC,icoSaveFile) \n $al(acc_0) append al(MC,icorun) \n $al(acc_3) append al(MC,icoe_menu) \n $al(acc_2) }
Gets a toolbar button's tip, mapping %f / %D to a current file / directory.
| index of e_menu item |
proc ::alited::ini::ToolbarTip {i} { # Gets a toolbar button's tip, mapping %f / %D to a current file / directory. # i - index of e_menu item set maplist [alited::menu::MapRunItems [alited::bar::FileName]] string map $maplist $::alited::pref::em_mnu($i) }
Runs a command after its hot key pressing in f5 tab of Projects.
| notebook's path |
| command |
proc ::alited::ini::ToolByKey {nbk com} { # Runs a command after its hot key pressing in f5 tab of Projects. # nbk - notebook's path # com - command # See also: project::_create if {[$nbk select] eq "$nbk.f5"} $com }
Executes project toolbar's command.
| index in toolbar |
proc ::alited::ini::ToolPrjCommand {im} { # Executes project toolbar's command. # im - index in toolbar set com [alited::tool::EM_command $im] append com " \"f=[ToolPrjFilename]\" \"d=[ToolPrjDirname]\" \"TF=[ToolPrjFilename]\"" {*}$com }
Gets dir name of current file.
proc ::alited::ini::ToolPrjDirname {} { # Gets dir name of current file. file dirname [ToolPrjFilename] }
Calls e_menu from toolbar.
proc ::alited::ini::ToolPrjEM {} { # Calls e_menu from toolbar. alited::tool::e_menu o=0 f=[ToolPrjFilename] d=[ToolPrjDirname] }
Gets file name of current file.
proc ::alited::ini::ToolPrjFilename {} { # Gets file name of current file. alited::project::CurrentFile }
Runs current file from toolbar.
proc ::alited::ini::ToolPrjRun {} { # Runs current file from toolbar. alited::tool::_run 1 {} -doit yes f=[ToolPrjFilename] }
Gets a toolbar button's tip, mapping %f / %D to a current file / directory.
| index of e_menu item |
proc ::alited::ini::ToolPrjTip {i} { # Gets a toolbar button's tip, mapping %f / %D to a current file / directory. # i - index of e_menu item set maplist [alited::menu::MapRunItems [ToolPrjFilename]] string map $maplist $::alited::pref::em_mnu($i) }
Runs tkcon from toolbar.
proc ::alited::ini::ToolPrjTkcon {} { # Runs tkcon from toolbar. alited::tool::tkcon -dir [ToolPrjDirname] }
Gets a tip for "Projects' Run" tool.
proc ::alited::ini::TooltipPrjRun {} { # Gets a tip for "Projects' Run" tool. namespace upvar ::alited al al set res $al(MC,icorun) append res [AddTooltipRun] }
Updates templates.
| ini file name of default templates |
proc ::alited::ini::UpdateTemplates {inideffile} { # Updates templates. # inideffile - ini file name of default templates set tplmode 0 # read new templates: from [Templates] to [Keys] foreach stini [split [readTextFile $inideffile {} 1] \n] { switch -exact $stini { {[Templates]} {set tplmode 1} {[Keys]} break } if {$tplmode && [set i [string first = $stini]]>0} { set nam [string range $stini 0 $i-1] set val [string range $stini $i+1 end] ReadIniTemplates $nam $val no } } }
Views changes for updating.
proc ::alited::ini::ViewUpdates {} { # Views changes for updating. namespace upvar ::alited DATADIR DATADIR obj vieweditFile [file join $DATADIR to-update.txt] {} -rotext 1 -h 25 }
Adds an item to a list of keys data.
| type of key |
| name of item |
| key combination |
| contents (data of binding) |
proc ::alited::keys::Add {type name keys cont} { # Adds an item to a list of keys data. # type - type of key # name - name of item # keys - key combination # cont - contents (data of binding) namespace upvar ::alited al al if {[string trim $keys] ne {}} { set item [list $type $name $keys $cont] if {[set i [Search $type $name]]>-1} { set al(KEYS,bind) [lreplace $al(KEYS,bind) $i $i $item] } else { lappend al(KEYS,bind) $item } } }
Binds all keys to appropriate events of text.
| text's path |
| do it for "find/replace" as well |
proc ::alited::keys::BindAllKeys {wtxt asfind} { # Binds all keys to appropriate events of text. # wtxt - text's path # asfind - do it for "find/replace" as well BindKeys $wtxt action $asfind BindKeys $wtxt template $asfind BindKeys $wtxt preference $asfind }
Binds keys to appropriate events of text.
| text's path |
| type of keys (template etc.) |
| do it for "find/replace" as well; optional, default no |
proc ::alited::keys::BindKeys {wtxt type {asfind no}} { # Binds keys to appropriate events of text. # wtxt - text's path # type - type of keys (template etc.) # asfind - do it for "find/replace" as well namespace upvar ::alited obPav obPav variable firstbind if {$firstbind || $asfind} { # some bindings must be active in "info" listbox, "find units" combobox and tree set activeForOthers [list ::tool: ::find:: ::file:: ::main::GotoLine ::bar::BAR] set w1 [$obPav LbxInfo] set w2 [$obPav CbxFindSTD] set w3 [$obPav Tree] set w4 $::alited::find::win } foreach kb [alited::keys::EngagedList $type all] { lassign $kb -> tpl keys tpldata if {[catch { if {[set i [string last - $keys]]>0} { set lt [string range $keys $i+1 end] if {[string length $lt]==1} { ;# for lower case of letters lappend keys "[string range $keys 0 $i][string tolower $lt]" } } foreach k $keys { if {$type eq "template"} { lassign $tpldata tex pos place set tex [string map [list $::alited::EOL \n % %%] $tex] bind $wtxt "<$k>" [list ::alited::unit::InsertTemplate [list $tex $pos $place]] } elseif {$type eq "preference"} { set tpldata [string map [list %k $keys] $tpldata] {*}$tpldata } else { if {$firstbind || $asfind} { foreach afo $activeForOthers { if {[string first $afo $tpldata]>-1} { if {$asfind} { bind $w4 "<$k>" $tpldata } else { bind $w1 "<$k>" $tpldata bind $w2 "<$k>" $tpldata bind $w3 "<$k>" $tpldata } break } } } bind $wtxt "<$k>" $tpldata } } } err]} then { puts "Error of binding: $tpl <$keys> - $err" } } set firstbind no }
Deletes an item from a list of keys data.
| type of key |
| name of item; optional, default "" |
proc ::alited::keys::Delete {type {name {}}} { # Deletes an item from a list of keys data. # type - type of key # name - name of item namespace upvar ::alited al al set deleted 0 while {[set i [Search $type $name]]>-1} { set al(KEYS,bind) [lreplace $al(KEYS,bind) $i $i] incr deleted } return $deleted }
Returns a list of keys engaged by a user.
| a type of keys ("template" etc.); optional, default "" |
| if "all", returns full info of keys; if "keysonly" - only key names; if "keyscont" - only key contents; optional, default keyscont |
Returns a list of keys engaged by a user.
proc ::alited::keys::EngagedList {{type {}} {mode keyscont}} { # Returns a list of keys engaged by a user. # type - a type of keys ("template" etc.) # mode - if "all", returns full info of keys; if "keysonly" - only key names; if "keyscont" - only key contents namespace upvar ::alited al al set res [list] foreach kb $al(KEYS,bind) { if {$type eq "" || $type eq [lindex $kb 0]} { switch $mode { all {lappend res $kb} keysonly {lappend res [lindex $kb 2]} keyscont {lappend res [lrange $kb 2 3]} } } } return $res }
Saves reserved ("action") keys to a list of keys data.
proc ::alited::keys::ReservedAdd {} { # Saves reserved ("action") keys to a list of keys data. namespace upvar ::alited al al Add action exit-app Alt-F4 {alited::Exit; break} Add action find-replace Control-F {alited::find::_run; break} Add action find-unit Shift-Control-F {::alited::find::FindUnit; break} Add action new-file Control-N {::alited::file::NewFile; break} Add action open-file Control-O {::alited::file::OpenFile; break} Add action save-all Shift-Control-S {::alited::file::SaveAll; break} Add action save-close Control-W {::alited::file::SaveAndClose; break} Add action close-delete Control-Alt-W {::alited::file::CloseAndDelete; break} Add action help F1 {alited::tool::Help} # other keys are customized in Preferences Add action save-file [alited::pref::BindKey 0 - Control-S] ::alited::file::SaveFile Add action save-as [alited::pref::BindKey 1 - Alt-S] {::alited::file::SaveFileAs; break} Add action e_menu [alited::pref::BindKey 2 - F4] alited::tool::e_menu3 Add action run [alited::pref::BindKey 3 - F5] alited::tool::_run Add action indent [alited::pref::BindKey 6 - Control-I] {::alited::edit::Indent; break} Add action unindent [alited::pref::BindKey 7 - Control-U] {::alited::edit::UnIndent; break} Add action comment [alited::pref::BindKey 8 - Control-bracketleft] {::alited::edit::Comment; break} Add action uncomment [alited::pref::BindKey 9 - Control-bracketright] {::alited::edit::UnComment; break} Add action find-next [alited::pref::BindKey 12 - F3] alited::find::FindNext Add action look-declaration [alited::pref::BindKey 13 - Control-L] "::alited::find::LookDecl ; break" Add action look-word [alited::pref::BindKey 14 - Control-Shift-L] "::alited::find::SearchWordInSession ; break" Add action RESERVED [alited::pref::BindKey 15 - F11] {+ ::apave::None} Add action play-macro [alited::pref::BindKey 16 - F12] {+ ::alited::edit::DispatchMacro} Add action goto-line [alited::pref::BindKey 17 - Control-G] {alited::main::GotoLine; break} Add action insert-line [alited::pref::BindKey 18 - Control-P] {alited::main::InsertLine; break} if {$::alited::al(IsWindows)} {set i1 %s==0} {set i1 1} Add action autocomplete [alited::pref::BindKey 19 - Tab] [list + if $i1 {alited::complete::AutoCompleteCommand; break}] Add action goto-bracket [alited::pref::BindKey 20 - Alt-B] {alited::main::GotoBracket; break} Add action file-list [alited::pref::BindKey 21 - F9] {alited::bar::BAR popList %X %Y; break} Add action run-file [alited::pref::BindKey 22 - Shift-F5] $al(runAsIs) }
Returns a list of keys reserved by alited.
Returns a list of keys reserved by alited.
proc ::alited::keys::ReservedList {} { # Returns a list of keys reserved by alited. list F1 F10 Control-A Control-B Control-C Control-E Control-F Control-N Control-O Control-T Control-V Control-W Control-X Control-Z Control-Alt-W Control-Shift-Z Control-Shift-F Alt-Up Alt-Down Alt-Left Alt-Right Alt-F4 }
Searches an item in a list of keys data.
| type of key |
| name of item |
proc ::alited::keys::Search {type name} { # Searches an item in a list of keys data. # type - type of key # name - name of item namespace upvar ::alited al al set i 0 foreach kb $al(KEYS,bind) { lassign $kb t n n2 if {($type eq {} || $t eq $type) && ($name eq {} || $name eq $n || $name eq $n2)} { return $i } incr i } return -1 }
It's just for testing keys.
| list of key combinations |
proc ::alited::keys::Test {klist} { # It's just for testing keys. # klist - list of key combinations foreach k $klist { if {[catch {bind . "<$k>" "puts $k"} err]} { puts $err } else { puts "Valid key combination: $k" } catch {bind . "<$k>" {}} } }
Clears key bindings of text.
| text's path |
| type of keys (template etc.) |
proc ::alited::keys::UnBindKeys {wtxt type} { # Clears key bindings of text. # wtxt - text's path # type - type of keys (template etc.) foreach kb [alited::keys::EngagedList $type all] { lassign $kb -> tpl keys tpldata if {[catch { set tpldata [::alited::ProcEOL $tpldata in] bind $wtxt "<$keys>" {} } err]} then { puts "Error of unbinding: $tpl <$keys> - $err" } } }
Returns a list of keys available to a user.
Returns a list of keys available to a user.
proc ::alited::keys::UserList {} { # Returns a list of keys available to a user. namespace upvar ::alited al al set reserved [ReservedList] lappend reserved {*}[alited::edit::PluginAccelerator $al(MENUFORMATS)] foreach mod {"" Control- Alt- Shift- Control-Shift- Control-Alt-} { if {$mod ni {Control- Control-Alt-}} { foreach k {F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12} { set key "$mod$k" if {$key ni $reserved} {lappend res $key} } } if {$mod ni {"" "Shift-"}} { foreach k [split 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ {}] { set key "$mod$k" if {$key ni $reserved} {lappend res $key} } } } lappend res Control-bracketleft lappend res Control-bracketright lappend res Tab return $res }
Returns a list of keys not yet engaged.
Returns a list of keys not yet engaged.
proc ::alited::keys::VacantList {} { # Returns a list of keys not yet engaged. set userlist [UserList] set englist [EngagedList {} keysonly] set res [list] foreach k $userlist { if {$k ni $englist} {lappend res $k} } return $res }
Creates a main form of the alited.
proc ::alited::main::_create {} { # Creates a main form of the alited. namespace upvar ::alited al al obPav obPav set al(AU!) 0 $obPav untouchWidgets *.frAText *.lbxInfo *.lbxFlist *.too* # make the main apave object and populate it $obPav makeWindow $al(WIN).fra alited # alited_checked ## ________________________ Main window _________________________ ## $obPav paveWindow $al(WIN).fra { {Menu - - - - - {-array { file File edit Edit search Search tool Tools setup Setup help Help }} alited::menu::FillMenu} {# ### ________________________ Main pan _________________________ ### } {frat - - - - {pack -fill both}} {frat.ToolTop - - - - {pack -side top} {-relief flat -borderwidth 0 -array {$::alited::al(atools)}}} {fra - - - - {pack -side top -fill both -expand 1 -pady 0}} {fra.Pan - - - - {pack -side top -fill both -expand 1} {-orient horizontal $::alited::Pan_wh}} {fra.pan.PanL - - - - {add} {-orient vertical $::alited::PanL_wh}} {.fraBot - - - - {add}} {# ### ________________________ Tree pan _________________________ ### } {.fraBot.PanBM - - - - {pack -fill both -expand 1} {$::alited::PanBM_wh}} {.fraBot.panBM.FraTree - - - - {pack -side top -fill both -expand 1}} {.fraBot.panBM.fraTree.fra1 - - - - {pack -side top -fill x}} {# #### ________________________ Tree's toolbar _________________________ #### } {.fraBot.panBM.fraTree.fra1.BtTswitch - - - - {pack -side left -fill x} {-image alimg_gulls -com alited::tree::SwitchTree}} {.fraBot.panBM.fraTree.fra1.BtTUpdT - - - - {pack -side left -fill x} {-image alimg_retry -tip {$al(MC,updtree)} -command alited::main::UpdateAll}} {.fraBot.panBM.fraTree.fra1.sev1 - - - - {pack -side left -fill y -padx 5}} {.fraBot.panBM.fraTree.fra1.BtTUp - - - - {pack -side left -fill x} {-image alimg_up -com {alited::tree::MoveItem up}}} {.fraBot.panBM.fraTree.fra1.BtTDown - - - - {pack -side left -fill x} {-image alimg_down -com {alited::tree::MoveItem down}}} {.fraBot.panBM.fraTree.fra1.sev2 - - - - {pack -side left -fill y -padx 5}} {.fraBot.panBM.fraTree.fra1.BtTAddT - - - - {pack -side left -fill x} {-image alimg_add -com alited::tree::AddItem}} {.fraBot.panBM.fraTree.fra1.BtTRenT - - - - {pack forget -side left -fill x} {-image alimg_change -tip "$al(MC,renamefile)\nF2" -com {::alited::file::RenameFileInTree 0 -geometry pointer+10+10}}} {.fraBot.panBM.fraTree.fra1.BtTDelT - - - - {pack -side left -fill x} {-image alimg_delete -com alited::tree::DelItem}} {.fraBot.panBM.fraTree.fra1.BtTCloT - - - - {pack forget -side left -fill x} {-image alimg_copy -com alited::file::CloneFile -tip "$al(MC,clonefile)"}} {.fraBot.panBM.fraTree.fra1.BtTOpen - - - - {pack forget -side left -fill x} {-image alimg_OpenFile -com ::alited::file::OpenWith -tip "$al(MC,openwith)"}} {.fraBot.panBM.fraTree.fra1.h_ - - - - {pack -anchor center -side left -fill both -expand 1}} {.fraBot.panBM.fraTree.fra1.btTCtr - - - - {pack -side left -fill x} {-image alimg_minus -com {alited::tree::ExpandContractTree Tree no} -tip "Contract All"}} {.fraBot.panBM.fraTree.fra1.btTExp - - - - {pack -side left -fill x} {-image alimg_plus -com {alited::tree::ExpandContractTree Tree} -tip "Expand All"}} {# #### ________________________ Tree _________________________ #### } {.fraBot.panBM.fraTree.fra1.sev3 - - - - {pack -side right -fill y -padx 0}} {.fraBot.panBM.fraTree.fra - - - - {pack -side bottom -fill both -expand 1} {}} {.fraBot.panBM.fraTree.fra.Tree - - - - {pack -side left -fill both -expand 1} {-columns {L1 L2 PRL ID LEV LEAF FL1} -displaycolumns {L1} -columnoptions "#0 {-width $al(TREE,cw0)} L1 {-width $al(TREE,cw1) -anchor e}" -style TreeNoHL -takefocus 0 -selectmode extended -tip {-BALTIP {alited::tree::GetTooltip %i %c} -SHIFTX 10}}} {# ### ________________________ Favorites _________________________ ### } {.fraBot.panBM.fraTree.fra.SbvTree .fraBot.panBM.fraTree.fra.Tree L - - {pack -side right -fill both}} {.FraFV - - - - {add}} {.fraFV.v_ - - - - {pack -side top -fill x} {-h 5}} {.fraFV.fra1 - - - - {pack -side top -fill x}} {.fraFV.fra1.seh - - - - {pack -side top -fill x -expand 1 -pady 0}} {# #### ________________________ Favorites' toolbar _________________________ #### } {.fraFV.fra1.BtTVisitF - - - - {pack -side left -fill x} {-image alimg_misc -tip {$al(MC,lastvisit)} -com alited::favor::SwitchFavVisit}} {.fraFV.fra1.sev0 - - - - {pack -side left -fill y -padx 5}} {.fraFV.fra1.BtTListF - - - - {pack -side left -fill x} {-image alimg_SaveFile -tip {$al(MC,FavLists)} -com alited::favor::Lists}} {.fraFV.fra1.SevF - - - - {pack -side left -fill y -padx 5}} {.fraFV.fra1.BtTAddF - - - - {pack -side left -fill x} {-image alimg_add -tip {$al(MC,favoradd)} -com alited::favor::Add}} {.fraFV.fra1.BtTRenF - - - - {pack -side left -fill x} {-image alimg_change -tip {$al(MC,favorren)} -command ::alited::favor::Rename}} {.fraFV.fra1.btTDelF - - - - {pack -side left -fill x} {-image alimg_delete -tip {$al(MC,favordel)} -com alited::favor::Delete}} {.fraFV.fra1.btTDelAllF - - - - {pack -side left -fill x} {-image alimg_trash -tip {$al(MC,favordelall)} -com alited::favor::DeleteAll}} {.fraFV.fra1.h_2 - - - - {pack -anchor center -side left -fill both -expand 1}} {.fraFV.fra1.sev2 - - - - {pack -side right -fill y -padx 0}} {.fraFV.fra - - - - {pack -fill both -expand 1} {}} {# #### ________________________ Favorites' list _________________________ #### } {.fraFV.fra.TreeFavor - - - - {pack -side left -fill both -expand 1} {-h 5 -style TreeNoHL -columns {C1 C2 C3 C4} -displaycolumns C1 -show headings -takefocus 0 -tip {-BALTIP {alited::favor::GetTooltip %i} -SHIFTX 10}}} {.fraFV.fra.SbvFavor .fraFV.fra.TreeFavor L - - {pack -side left -fill both}} {fra.pan.PanR - - - - {add} {-orient vertical $::alited::PanR_wh}} {# ### ________________________ Tab bar & Text _________________________ ### } {.fraTop - - - - {add}} {.fraTop.PanTop - - - - {pack -fill both -expand 1} {$::alited::PanTop_wh}} {.fraTop.panTop.BtsBar - - - - {pack -side top -fill x -pady 3}} {.fraTop.panTop.canmark - - - - {pack -side left -expand 0 -fill both -padx 0 -pady 0 -ipadx 0 -ipady 0} {-w $al(markwidth) -afteridle {alited::main::FillMarkBar %w}}} {.fraTop.panTop.GutText - - - - {pack -side left -expand 0 -fill both}} {.fraTop.panTop.FrAText - - - - {pack -side left -expand 1 -fill both -padx 0 -pady 0 -ipadx 0 -ipady 0} {-background $::apave::BGMAIN2}} {.fraTop.panTop.frAText.Text - - - - {pack -expand 1 -fill both} {-w 80 -h 30 -gutter GutText -gutterwidth $al(ED,gutterwidth) -guttershift $al(ED,guttershift)}} {.fraTop.panTop.fraSbv - - - - {pack -side right -fill y}} {# ### ________________________ Find units _________________________ ### } {.fraTop.panTop.fraSbv.SbvText .fraTop.panTop.frAText.text L - - {pack -fill y}} {.fraTop.FraSbh - - - - {pack forget -fill x}} {.fraTop.fraSbh.SbhText .fraTop.panTop.frAText.text T - - {pack -fill x}} {.fraTop.FraHead - - - - {pack forget -side bottom -fill x} {-padding {4 4 4 4} -relief groove}} {.fraTop.fraHead.labFind - - - - {pack -side left} {-t { Unit: }}} {.fraTop.fraHead.CbxFindSTD - - - - {pack -side left} {-tvar ::alited::al(findunit) -values {$al(findunitvals)} -w 30 -tip {$al(MC,findunit)}}} {.fraTop.fraHead.btT - - - - {pack -side left -padx 4} {-t {Find: } -com alited::find::DoFindUnit -w 8 -anchor e -tip {Find Unit}}} {.fraTop.fraHead.rad1 - - - - {pack -side left -padx 4} {-takefocus 0 -var ::alited::main::findunits -t {in all} -value 1}} {.fraTop.fraHead.rad2 - - - - {pack -side left -padx 4} {-takefocus 0 -var ::alited::main::findunits -t {in current} -value 2}} {.fraTop.fraHead.h_ - - - - {pack -side left -fill x -expand 1}} {.fraTop.fraHead.btTno - - - - {pack -side left} {-command {alited::find::HideFindUnit}}} {# ### ________________________ Info & status bar _________________________ ### } {.fraBot - - - - {add}} {.fraBot.fra - - - - {pack -fill both -expand 1}} {.fraBot.fra.LbxInfo - - - - {pack -side left -fill both -expand 1} {-h 1 -w 40 -lvar ::alited::info::list -font $al(FONT,defsmall) -highlightthickness 0}} {.fraBot.fra.sbv .fraBot.fra.LbxInfo L - - pack} {.fraBot.fra.SbhInfo .fraBot.fra.LbxInfo T - - {pack -side bottom -before %w}} {.fraBot.stat - - - - {pack -side bottom} {-array { {{$al(MC,Row:)}} 12 {{$al(MC,Col:)}} 4 {{} -anchor w -expand 1} 51 {{} -anchor e} 25 }}} } UpdateProjectInfo # a pause (and cycles) must be enough for FillBar to have proper -wbar option after idle after 50 after idle after 50 after idle after 50 after idle after 50 alited::main::InitActions bind [$obPav Pan] <ButtonRelease> ::alited::tree::AdjustWidth set sbhi [$obPav SbhInfo] set lbxi [$obPav LbxInfo] pack forget $sbhi bind $lbxi <FocusIn> "alited::info::FocusIn $sbhi $lbxi" bind $lbxi <FocusOut> "alited::info::FocusOut $sbhi" bind $lbxi <<ListboxSelect>> {alited::info::ListboxSelect %W} bind $lbxi <ButtonPress-3> {alited::info::PopupMenu %X %Y} bind [$obPav ToolTop] <ButtonPress-3> {::alited::tool::PopupBar %X %Y} bind [$obPav Labstat3] <Button-1> alited::main::ProcMessage ::baltip tip [$obPav Labstat4] = -command ::alited::main::TipStatus -per10 0 }
Runs the alited, displaying its main form with attributes 'modal', 'not closed by Esc', 'decorated with Contract/Expand buttons', 'minimal sizes' and 'saved geometry'. After closing the alited, saves its settings (geometry etc.).
proc ::alited::main::_run {} { # Runs the alited, displaying its main form with attributes # 'modal', 'not closed by Esc', 'decorated with Contract/Expand buttons', # 'minimal sizes' and 'saved geometry'. # After closing the alited, saves its settings (geometry etc.). # See also: menu::TearoffCascadeMenu namespace upvar ::alited al al obPav obPav ::apave::setAppIcon $al(WIN) $::alited::img::_AL_IMG(ale) after idle after 8 after idle after 8 after idle after 8 {incr ::alited::al(AU!)} after 3000 {incr ::alited::al(AU!)} ;# control shot after 2000 [list wm iconphoto $al(WIN) -default [::apave::getAppIcon]] after 1000 {alited::ini::CheckUpdates no} set ans [$obPav showModal $al(WIN) -decor 1 -minsize {500 500} -escape no -onclose alited::Exit {*}$al(GEOM) -resizable 1 -waitme ::alited::al(AU!) -ontop 0] # ans==2 means 'no saves of settings' (imaginary mode) if {$ans ne {2}} {alited::ini::SaveIni} destroy $al(WIN) $obPav destroy return $ans }
Actions after cutting text: resets the unit tree's selection.
proc ::alited::main::AfterCut {} { # Actions after cutting text: resets the unit tree's selection. namespace upvar ::alited al al obPav obPav if {$al(TREE,isunits)} { [$obPav Tree] selection set {} after idle alited::main::FocusText } }
Actions after undo/redo.
proc ::alited::main::AfterUndoRedo {} { # Actions after undo/redo. HighlightLine after 0 {after idle { alited::main::SaveVisitInfo alited::main::UpdateUnitTree alited::main::FocusText} } }
Sets bindings for a code.
| text widget's path |
| current file's name |
proc ::alited::main::BindsForCode {wtxt curfile} { # Sets bindings for a code. # wtxt - text widget's path # curfile - current file's name # if {[alited::file::IsTcl $curfile] || [alited::file::IsClang $curfile]} { bind $wtxt <Control-Right> "alited::edit::ControlRight $wtxt %s" bind $wtxt <Control-Left> "alited::edit::ControlLeft $wtxt %s" # } }
Sets bindings for a text.
| tab's ID |
| text widget's path |
proc ::alited::main::BindsForText {TID wtxt} { # Sets bindings for a text. # TID - tab's ID # wtxt - text widget's path namespace upvar ::alited al al obPav obPav if {[alited::bar::BAR isTab $TID]} { bind $wtxt <FocusIn> [list after 500 "::alited::main::FocusInText $TID $wtxt"] } bind $wtxt <Control-ButtonRelease-1> "::alited::find::LookDecl ; break" bind $wtxt <Control-Shift-ButtonRelease-1> {::alited::find::SearchWordInSession ; break} bind $wtxt <Control-Tab> {::alited::bar::ControlTab} if {$al(IsWindows)} { # unlike Unix, Shift+Key doesn't work in Windows bind $wtxt <Tab> [list + if {{%K} eq {Tab} && {%s}==1} "focus [$obPav LbxInfo]; break"] } bind $wtxt <Alt-BackSpace> {::alited::unit::SwitchUnits ; break} bind $wtxt <space> "+ alited::unit::PutTypeTemplate $wtxt" ::apave::bindToEvent $wtxt <ButtonRelease-1> alited::main::SaveVisitInfo $wtxt ::apave::bindToEvent $wtxt <KeyRelease> alited::main::SaveVisitInfo $wtxt %K %s ::apave::bindToEvent $wtxt <<Undo>> alited::main::AfterUndoRedo ::apave::bindToEvent $wtxt <<Redo>> alited::main::AfterUndoRedo ::apave::bindToEvent $wtxt <<Cut>> after 50 {after 50 alited::main::AfterCut} alited::keys::ReservedAdd alited::keys::BindAllKeys $wtxt no alited::edit::BindPluginables $wtxt }
Check for "Auto detection of indentation" and calculates it at need.
| text's path; optional, default "" |
| if yes, recalculates the indentation; optional, default no |
proc ::alited::main::CalcIndentation {{wtxt {}} {doit no}} { # Check for "Auto detection of indentation" and calculates it at need. # wtxt - text's path # doit - if yes, recalculates the indentation namespace upvar ::alited al al set res [list $al(prjindent) { }] if {$al(prjindentAuto)} { if {$wtxt eq {}} { if {[catch {set wtxt [CurrentWTXT]}]} {return $res} } if {!$doit && [info exists al(_INDENT_,$wtxt)]} {return $al(_INDENT_,$wtxt)} foreach line [split [$wtxt get 1.0 end] \n] { if {[set lsp [obj leadingSpaces $line]]>0} { # check if the indentation is homogeneous if {[string first [string repeat { } $lsp] $line]==0} { set res [list $lsp { }] break } elseif {[string first [string repeat \t $lsp] $line]==0} { set res [list $lsp \t] break } } } set al(_INDENT_,$wtxt) $res ;# to omit the calculation next time } return $res }
Calculates the indenting pad for the edited text.
| text's path; optional, default "" |
proc ::alited::main::CalcPad {{wtxt {}}} { # Calculates the indenting pad for the edited text. # wtxt - text's path lassign [CalcIndentation $wtxt] pad padchar return [string repeat $padchar $pad] }
Clears a combobox's value and removes it from the combobox' list.
| the combobox's path |
| name of variable used in the current namespace |
proc ::alited::main::ClearCbx {cbx varname} { # Clears a combobox's value and removes it from the combobox' list. # cbx - the combobox's path # varname - name of variable used in the current namespace set val [string trim [$cbx get]] set values [$cbx cget -values] if {[set i [lsearch -exact $values $val]]>-1} { set values [lreplace $values $i $i] $cbx configure -values $values } set $varname $values }
Gets a current text widget's path.
proc ::alited::main::CurrentWTXT {} { # Gets a current text widget's path. return [lindex [alited::bar::GetBarState] 2] }
Displays a current text's row and column in the status bar.
| text widget's path |
| contains a cursor position, |
proc ::alited::main::CursorPos {wtxt args} { # Displays a current text's row and column in the status bar. # wtxt - text widget's path # args - contains a cursor position, namespace upvar ::alited obPav obPav if {![winfo exists $wtxt]} return if {$args eq {}} {set args [$wtxt index {end -1 char}]} lassign [split [$wtxt index insert] .] r c set R [expr {int([lindex $args 0])}] set c [incr c] set wrow [$obPav Labstat1] set wcol [$obPav Labstat2] set textrow "$r / $R" set textcol "$c" ::baltip tip $wrow $textrow ::baltip tip $wcol $textcol if {$R>99999} {set textrow "$r / *****"} if {$c>9999} {set textcol ****} $wrow configure -text $textrow $wcol configure -text $textcol alited::tree::SaveCursorPos alited::edit::RectSelection 1 }
Fills the mark bar, makes bindings for its tags.
| if set, contains canvas' path |
It's run from InitActions without args.
proc ::alited::main::FillMarkBar {args} { # Fills the mark bar, makes bindings for its tags. # args - if set, contains canvas' path # It's run from InitActions without *args*. # See also: InitActions namespace upvar ::alited al al obPav obPav variable wcan variable fgcan variable bgcan lassign [MarkOptions] N if {[llength $args]} { lassign $args wcan $wcan create rectangle "0 0 99 9999" -fill $bgcan -outline $bgcan return } lassign [split [winfo geometry [$obPav Text]] x+] -> h set hp [expr {int($h/$N-0.5)}] $wcan configure -highlightbackground $bgcan -highlightthickness 0 for {set i 0; set y 1} {$i<($N+1)} {incr i} { lassign [MarkOptions $i] -> tip mark set y2 [expr {$y+$hp}] if {$i==$N} {incr y2 9999} set al($mark) [$wcan create rectangle "1 $y 99 $y2" -fill $bgcan -outline $fgcan] if {$i<$N} { $wcan bind $al($mark) <ButtonPress-1> "alited::main::SetMark $i" $wcan bind $al($mark) <ButtonPress-3> "alited::main::UnsetMark $i %X %Y" UnsetOneMark $i } incr y $hp } }
Processes
| tab's ID |
| text widget's path |
proc ::alited::main::FocusInText {TID wtxt} { # Processes <FocusIn> event on the text. # TID - tab's ID # wtxt - text widget's path namespace upvar ::alited obPav obPav if {![alited::bar::BAR isTab $TID]} return catch { CursorPos $wtxt [$obPav TreeFavor] selection set {} alited::file::OutwardChange $TID } }
Sets a focus on a current text.
| contains tab's ID and a cursor position. |
proc ::alited::main::FocusText {args} { # Sets a focus on a current text. # args - contains tab's ID and a cursor position. namespace upvar ::alited al al obPav obPav lassign $args TID pos if {$pos eq {}} { set wtxt [CurrentWTXT] set TID [alited::bar::CurrentTabID] set pos [$wtxt index insert] } else { set wtxt [GetWTXT $TID] } # find a current unit/file in the tree set ::alited::tree::doFocus no set wtree [$obPav Tree] catch { if {$al(TREE,isunits)} { # search the tree for a unit with current line of text set itemID [alited::tree::CurrentItemByLine $pos] } else { # search the tree for a current file set fname [alited::bar::FileName] set wtree [$obPav Tree] while {1} { incr iit set ID [alited::tree::NewItemID $iit] if {![$wtree exists $ID]} break lassign [$wtree item $ID -values] -> tip isfile if {$tip eq $fname} { set itemID $ID break } } } } # display a current item of the tree catch { if {$itemID ni [$wtree selection]} {$wtree selection set $itemID} after 10 alited::tree::SeeSelection } # focus on the text catch {focus -force $wtxt} catch {::tk::TextSetCursor $wtxt $pos} after idle {set ::alited::tree::doFocus yes} }
Creates or gets a text widget for a tab.
| tab's ID |
| flag "this widget should be displayed" optional, default no |
| flag "this text should be highlighted" optional, default yes |
Returns a list of: curfile (current file name), wtxt (text's path), wsbv (scrollbar's path), pos (cursor's position), doinit (flag "initialized") dopack (flag "packed") selrange (selected text's range)
proc ::alited::main::GetText {TID {doshow no} {dohighlight yes}} { # Creates or gets a text widget for a tab. # TID - tab's ID # doshow - flag "this widget should be displayed" # dohighlight - flag "this text should be highlighted" # Returns a list of: curfile (current file name), # wtxt (text's path), wsbv (scrollbar's path), # pos (cursor's position), doinit (flag "initialized") # dopack (flag "packed") # selrange (selected text's range) namespace upvar ::alited al al obPav obPav set curfile [alited::bar::FileName $TID] # initial text and its scrollbar: set wtxt [$obPav Text] set wsbv [$obPav SbvText] # get data of the current tab lassign [alited::bar::GetBarState] TIDold fileold wold1 wold2 lassign [alited::bar::GetTabState $TID --pos --selection --wrap] pos selrange wrap set doreload no ;# obsolete set doinit yes if {$TIDold eq {-1} && $TID eq {tab0}} { ;# first text to edit in original Text widget: create its scrollbar BindsForText $TID $wtxt ::apave::logMessage "first $curfile" } elseif {[GetWTXT $TID] ne {}} { # edited text: get its widgets' data lassign [alited::bar::GetTabState $TID --wtxt --wsbv] wtxt wsbv set doinit no } else { # till now, not edited text: create its own Text/SbvText widgets append wtxt "_$TID" ;# new text append wsbv "_$TID" ;# new scrollbar } if {![string is double -strict $pos]} {set pos 1.0} # check for previous text and hide it, if it's not the selected one set dopack [expr {$TID ne $TIDold}] alited::bar::SetTabState $TID --fname $curfile --wtxt $wtxt --wsbv $wsbv # create the text and the scrollbar if new if {![winfo exists $wtxt]} { lassign [GutterAttrs] canvas width shift set texopts [lindex [::apave::defaultAttrs tex] 1] lassign [::apave::extractOptions texopts -selborderwidth 1] selbw text $wtxt {*}$texopts $wtxt tag configure sel -borderwidth $selbw $obPav themeNonThemed [winfo parent $wtxt] $obPav bindGutter $wtxt $canvas $width $shift ttk::scrollbar $wsbv -orient vertical -takefocus 0 $wtxt configure -yscrollcommand "$wsbv set" $wsbv configure -command "$wtxt yview" BindsForText $TID $wtxt } if {[winfo exists $wold1]} { # previous text: save its state alited::bar::SetTabState $TIDold --pos [$wold1 index insert] --selection [$wold1 tag ranges sel] if {$dopack && $doshow} { # hide both previous pack forget $wold1 ;# a text pack forget $wold2 ;# a scrollbar after idle update } } # show the selected text if {$doshow} { alited::bar::SetBarState [alited::bar::CurrentTabID] $curfile $wtxt $wsbv } if {$doinit} { # if the file isn't read yet, read it and initialize its highlighting if {$al(prjindent)>1 && $al(prjindent)<9 && !$al(prjindentAuto)} { SetTabs $wtxt $al(prjindent) } alited::file::DisplayFile $TID $curfile $wtxt $doreload RestoreMarks $curfile $wtxt if {$al(prjindentAuto)} { SetTabs $wtxt [lindex [CalcIndentation $wtxt] 0] } if {$doshow} { HighlightText $TID $curfile $wtxt } else { alited::file::MakeThemHighlighted $TID ;# postpone the highlighting till a show } } elseif {$dohighlight && [alited::file::ToBeHighlighted $wtxt]} { HighlightText $TID $curfile $wtxt if {$al(TREE,isunits)} alited::tree::RecreateTree } list $curfile $wtxt $wsbv $pos $doinit $dopack $selrange $wrap }
Gets a text widget's path of a tab.
| ID of the tab |
proc ::alited::main::GetWTXT {TID} { # Gets a text widget's path of a tab. # TID - ID of the tab return [alited::bar::GetTabState $TID --wtxt] }
Processes Alt+B keypressing: "go to a matched bracket".
| yes, if run from a menu; optional, default no |
proc ::alited::main::GotoBracket {{frommenu no}} { # Processes Alt+B keypressing: "go to a matched bracket". # frommenu - yes, if run from a menu # search a pair for a bracket highlighted set wtxt [CurrentWTXT] if {[llength [set tagged [$wtxt tag ranges tagBRACKET]]]==4} { set p [$wtxt index insert] set p1 [$wtxt index "$p +1c"] set p2 [$wtxt index "$p -1c"] foreach {pos1 pos2} $tagged { if {[incr -]==2 || ($pos1!=$p && $pos1!=$p1 && $pos1!=$p2)} { FocusText [alited::bar::CurrentTabID] $pos1 if {$frommenu} SaveVisitInfo break } } } }
Processes Ctrl+G keypressing: "go to a line".
proc ::alited::main::GotoLine {} { # Processes Ctrl+G keypressing: "go to a line". namespace upvar ::alited al al obDl2 obDl2 set head [msgcat::mc {Go to Line}] set prompt1 [msgcat::mc {Line number:}] set prompt2 [msgcat::mc { In unit:}] set wtxt [CurrentWTXT] set ln 1 ;#[expr {int([$wtxt index insert])}] set lmax [expr {int([$wtxt index "end -1c"])}] set units [list] set TID [alited::bar::CurrentTabID] foreach it $al(_unittree,$TID) { lassign $it lev leaf fl1 title l1 l2 if {$leaf && [set title [string trim $title]] ne {}} { lappend units $title } } set ::alited::main::gotoline2 [linsert [lsort -nocase $units] 0 {}] if {$::alited::main::gotolineTID ne $TID} { set ::alited::main::gotoline1 {} set ::alited::main::gotolineTID $TID } after 300 {catch {bind [apave::dlgPath] <F1> {alited::main::Help goline}}} lassign [$obDl2 input {} $head [list spx "{$prompt1} {} {-from 1 -to $lmax -selected yes}" "{$ln}" cbx "{$prompt2} {} {-tvar ::alited::main::gotoline1 -state readonly -h 16 -w 25}" "{$::alited::main::gotoline1} $::alited::main::gotoline2" ]] res ln unit if {$res} { set ::alited::main::gotoline1 $unit if {$unit ne {}} { # for a chosen unit - a relative line number if {[set it [lsearch -index 3 $al(_unittree,$TID) $unit]] >- 1} { lassign [lindex $al(_unittree,$TID) $it] lev leaf fl1 title l1 l2 set l $l1 set fst 1 foreach line [split [$wtxt get $l1.0 $l2.end] \n] { # gentlemen, use \ for continuation of long lines & strings! set continued [expr {[string index $line end] eq "\\"}] if {!$continued || $fst} { if {$fst} { set l $l1 if {[incr ln -1]<1} break } set fst [expr {!$continued}] } incr l1 } set ln $l } } after 200 " alited::main::FocusText $TID $ln.0 ; alited::tree::NewSelection {} $ln.0 yes; alited::main::HighlightLine" } }
Returns list of gutter's data (canvas widget, width, shift)
Returns list of gutter's data (canvas widget, width, shift)
proc ::alited::main::GutterAttrs {} { # Returns list of gutter's data (canvas widget, width, shift) namespace upvar ::alited al al obPav obPav list [$obPav GutText] $al(ED,gutterwidth) $al(ED,guttershift) }
Display context helps.
| suffix of file name; optional, default "" |
proc ::alited::main::Help {{suff {}}} { # Display context helps. # suff - suffix of file name alited::Help $::alited::al(WIN) $suff }
Highlights a current line of a current text.
proc ::alited::main::HighlightLine {} { # Highlights a current line of a current text. set wtxt [CurrentWTXT] if {[alited::file::IsClang [alited::bar::FileName]]} { ::hl_c::hl_line $wtxt } else { ::hl_tcl::hl_line $wtxt } }
Highlights a file's syntax constructs.
| tab's ID |
| file name |
| text widget's path |
| callback for modifying text; optional, default "" |
| callback for changing cursor position; optional, default "" |
| text font size; optional, default "" |
Depending on a file name, Tcl or C highlighter is called.
proc ::alited::main::HighlightText {TID curfile wtxt {cmd {}} {cmdpos {}} {fontsize {}}} { # Highlights a file's syntax constructs. # TID - tab's ID # curfile - file name # wtxt - text widget's path # cmd - callback for modifying text # cmdpos - callback for changing cursor position # fontsize - text font size # Depending on a file name, Tcl or C highlighter is called. namespace upvar ::alited al al obPav obPav # the language (Tcl or C) is defined by the file's extension set ext [string tolower [file extension $curfile]] set itwas [info exists al(HL,$wtxt)] if {!$itwas || $al(HL,$wtxt) ne $ext} { if {$itwas} { # remove old syntax foreach tag [$wtxt tag names] { if {![string match hil* $tag] && $tag ni {sel fndTag}} { $wtxt tag delete $tag } } } if {$cmd eq {}} { set cmd "::alited::edit::Modified $TID" set cmdpos ::alited::main::CursorPos } set clrnams [::hl_tcl::hl_colorNames] set clrCURL [lindex [$obPav csGet] 16] # get a color list for the highlighting Tcl and C foreach lng {{} C} { foreach nam $clrnams { lappend "${lng}colors" $al(ED,${lng}$nam) } lappend "${lng}colors" $clrCURL } set tfont $al(FONT,txt) if {$fontsize ne {}} {append tfont " -size $fontsize"} if {[alited::file::IsClang $curfile]} { lassign [::hl_tcl::addingColors] -> clrCMN2 lappend Ccolors $clrCMN2 ::hl_c::hl_init $wtxt -dark [$obPav csDark] -multiline 1 -keywords $al(ED,CKeyWords) -cmd $cmd -cmdpos $cmdpos -font $tfont -colors $Ccolors } else { set pltext [expr {![alited::file::IsTcl $curfile]}] if {$pltext} { set plcom [alited::HighlightAddon $wtxt $curfile $colors $fontsize] if {$plcom ne {}} {set pltext 0} } else { set plcom {} } ::hl_tcl::hl_init $wtxt -dark [$obPav csDark] -multiline $al(prjmultiline) -keywords $al(ED,TclKeyWords) -cmd $cmd -cmdpos $cmdpos -plaintext $pltext -plaincom $plcom -font $tfont -colors $colors } UpdateText $wtxt $curfile BindsForCode $wtxt $curfile } set al(HL,$wtxt) $ext }
Initializes working with a main form of alited.
proc ::alited::main::InitActions {} { # Initializes working with a main form of alited. namespace upvar ::alited al al obPav obPav # fill the bars waiting for full size of text widget alited::bar::FillBar [$obPav BtsBar] FillMarkBar # check for outdated TODOs for current project lassign [alited::project::IsOutdated $al(prjname) yes] is date todo if {$is} { ShowOutdatedTODO $al(prjname) $date $todo $is } else { # check other projects alited::project::SaveSettings alited::project::GetProjects set prjname [alited::project::CheckOutdated] if {$prjname ne {}} { lassign [alited::project::IsOutdated $prjname yes] is date todo ShowOutdatedTODO $prjname $date $todo $is } } after idle {alited::main::UpdateGutter; alited::main::FocusText} ;# get it for sure if {$al(INI,isfindrepl)} { after idle {after 100 { ;# for getting a current word to find alited::find::_run focus $::alited::al(WIN); alited::main::FocusText after idle {after 100 {after idle {after 100 alited::main::FocusText}}} }} } # Ctrl-click for Run, e_menu, Tkcon buttons foreach ico {run e_menu other} { set but [alited::tool::ToolButName $ico] bind $but <Control-Button-1> $al(runAsIs) set tip [::baltip::cget $but -text][alited::tool::AddTooltipRun] after idle [list ::baltip::tip $but $tip] } foreach ico {undo redo} { set but [alited::tool::ToolButName $ico] bind $but <Control-Button-1> alited::tool::${ico}All set tip [::baltip::cget $but -text] append tip "\n\nCtrl+click = [msgcat::mc {All in text}]" after idle [list ::baltip::tip $but $tip] } }
Puts a new line into a text, attentive to a previous line's indentation.
proc ::alited::main::InsertLine {} { # Puts a new line into a text, attentive to a previous line's indentation. set wtxt [CurrentWTXT] set ln [expr {int([$wtxt index insert])}] set line [$wtxt get $ln.0 $ln.end] set leadsp [obj leadingSpaces $line] if {[string index [string trimleft $line] 0] eq "\}"} { incr leadsp [lindex [CalcIndentation] 0] } $wtxt insert $ln.0 "[string repeat { } $leadsp]\n" set pos $ln.$leadsp ::tk::TextSetCursor $wtxt $pos }
Returns options for marks.
| index of tag; optional, default 0 |
Returns options for marks.
proc ::alited::main::MarkOptions {{idx 0}} { # Returns options for marks. # idx - index of tag namespace upvar ::alited al al obPav obPav variable fgcan variable bgcan lassign [$obPav csGet] - - - bgcan - - - - fgcan if {!$al(TIPS,Marks) || [info exists al(MARK_TIPOFF)]} { set tip {} } else { set tip [msgcat::mc "Left click sets / goes to a mark.\nRight click clears it."] } # 12 greenish lappend colors #00ff00 #00f500 #00eb00 #00e100 #00d700 #00cd00 lappend colors #00c300 #00b900 #00af00 #00a500 #009b00 #009100 # 12 reddish lappend colors #910000 #9b0000 #a50000 #af0000 #b90000 #c30000 lappend colors #cd0000 #d70000 #e10000 #eb0000 #f50000 #ff0000 list [llength $colors] $tip MARK,$idx MARKDATA,$idx $colors }
Change the mark bar's width.
| 1/-1 to increment/decrement |
proc ::alited::main::MarkWidth {i} { # Change the mark bar's width. # i - 1/-1 to increment/decrement namespace upvar ::alited al al variable wcan variable saveini set width [$wcan cget -width] incr width $i if {$width>=5 && $width<=99} { $wcan configure -width $width set al(markwidth) $width set saveini yes after 3000 alited::main::MarkWidthSave } else { bell } }
Saves alited.ini at need.
proc ::alited::main::MarkWidthSave {} { # Saves alited.ini at need. variable saveini if {$saveini} { set saveini no alited::ini::SaveIni } }
Packs a text and its scrollbar.
| text widget's path |
| scrollbar widget's path |
proc ::alited::main::PackTextWidgets {wtxt wsbv} { # Packs a text and its scrollbar. # wtxt - text widget's path # wsbv - scrollbar widget's path namespace upvar ::alited al al obPav obPav pack $wtxt -side left -expand 1 -fill both pack $wsbv -fill y -expand 1 lassign [GutterAttrs] canvas width shift # widgets created outside apave require the theming: $obPav csSet [$obPav csCurrent] $al(WIN) -doit $obPav bindGutter $wtxt $canvas $width $shift }
Handles clicking on message label.
proc ::alited::main::ProcMessage {} { # Handles clicking on message label. namespace upvar ::alited obPav obPav set lab [$obPav Labstat3] set msg [baltip cget $lab -text] alited::Message $msg 3 $lab }
Restores mark data for a text to be shown.
| file name |
| text's path |
proc ::alited::main::RestoreMarks {fname wtxt} { # Restores mark data for a text to be shown. # fname - file name # wtxt - text's path namespace upvar ::alited al al lassign [MarkOptions] N for {set i 0} {$i<$N} {incr i} { lassign [MarkOptions $i] N tip mark markdata if {[info exists al($markdata)]} { lassign $al($markdata) fname2 pos if {$fname eq $fname2} { set tag MARK$i set al($markdata) [list $fname $pos $wtxt $tag] catch {$wtxt tag delete $tag} $wtxt tag add $tag $pos } } } }
Saves mark data for a text to be closed.
| text's path |
proc ::alited::main::SaveMarks {wtxt} { # Saves mark data for a text to be closed. # wtxt - text's path namespace upvar ::alited al al foreach tag [$wtxt tag names] { if {[string match MARK* $tag]} { set idx [string range $tag 4 end] lassign [MarkOptions $idx] -> tip mark markdata catch { lassign $al($markdata) fname pos lassign [$wtxt tag ranges $tag] pos set al($markdata) [list $fname $pos $wtxt $tag] } } } }
Remembers data about current unit.
| text's path; optional, default "" |
| key pressed (to check keypressings); optional, default "" |
| key's state; optional, default 0 |
proc ::alited::main::SaveVisitInfo {{wtxt {}} {K {}} {s 0}} { # Remembers data about current unit. # wtxt - text's path # K - key pressed (to check keypressings) # s - key's state namespace upvar ::alited al al obPav obPav # only for unit tree and not navigation key if {!$al(TREE,isunits) || [alited::favor::SkipVisited] || $K in {Tab Up Down Left Right Next Prior Home End Insert} || [string match *Cont* $K]} { return } # check for current text and current unit's lines set wcur [CurrentWTXT] if {$wtxt eq {}} { set wtxt $wcur } elseif {$wtxt ne $wcur} { return } set wtree [$obPav Tree] set pos [$wtxt index insert] lassign [alited::tree::CurrentItemByLine $pos 1] itemID - - - name l1 set header [alited::unit::GetHeader $wtree $itemID] set gokeys [list {}] foreach gk {F3 AltQ AltW} { lappend gokeys {*}[apave::getTextHotkeys $gk] } if {$K in $gokeys || ($s & 0b1000)} { set l1 -1 ;# to avoid a unit's name spawned in last visits at its change } alited::favor::LastVisited [$wtree item $itemID] $header $l1 set selID [$wtree selection] if {[llength $selID]<2 && $selID ne $itemID} { $wtree selection set $itemID $wtree see $itemID alited::tree::AddTagSel $wtree $itemID } set TID [alited::bar::CurrentTabID] foreach it $al(_unittree,$TID) { set treeID [alited::tree::NewItemID [incr iit]] lassign $it lev leaf fl1 title l1 l2 if {$name eq [alited::tree::UnitTitle $title $l1 $l2]} { set al(CPOS,$TID,$header) [::apave::p+ $pos -$l1] return } } }
Sets a mark in the mark bar.
| index of tag used as the mark |
proc ::alited::main::SetMark {idx} { # Sets a mark in the mark bar. # idx - index of tag used as the mark namespace upvar ::alited al al variable wcan lassign [MarkOptions $idx] -> tip mark markdata colors $wcan itemconfigure $al($mark) -fill [lindex $colors $idx] set tag MARK$idx if {[info exists al($markdata)]} { lassign $al($markdata) fname pos set TID [alited::file::OpenFile $fname] if {$TID ne {}} { set wtxt [GetWTXT $TID] lassign [$wtxt tag ranges $tag] pos2 if {[string is double -strict $pos2]} {set pos $pos2} after idle "::tk::TextSetCursor $wtxt $pos ; alited::main::UpdateAll" } } else { set fname [alited::bar::FileName] set wtxt [CurrentWTXT] set pos [$wtxt index insert] set nl [expr {int($pos)}] set al($markdata) [list $fname $pos $wtxt $tag] set line [string trim [$wtxt get $nl.0 $nl.end]] set lmax 50 if {[string length $line]>$lmax} { set line [string range $line 0 $lmax]... } set tip [string trim "[file tail $fname] $nl:\n$line"] ::baltip::tip $wcan $tip -ctag $al($mark) -shiftX 10 -pause 0 ::baltip repaint $wcan } catch {$wtxt tag delete $tag} $wtxt tag add $tag $pos }
Configures tabs of a text.
| text's path |
| indentation (= tab's length) |
proc ::alited::main::SetTabs {wtxt indent} { # Configures tabs of a text. # wtxt - text's path # indent - indentation (= tab's length) namespace upvar ::alited al al set texttabs [expr {$indent * [font measure $al(FONT,txt) 0]}] $wtxt configure -tabs "$texttabs left" -tabstyle wordprocessor }
Displays a file's name and modification flag (*) in alited's title.
| if yes, displays unconditionally; optional, default no |
If doit is no, displays only at changing a file name or a flag.
proc ::alited::main::ShowHeader {{doit no}} { # Displays a file's name and modification flag (*) in alited's title. # doit - if yes, displays unconditionally. # If *doit* is *no*, displays only at changing a file name or a flag. namespace upvar ::alited al al if {[alited::file::IsModified]} {set modif "*"} {set modif " "} set TID [alited::bar::CurrentTabID] if {$doit || "$modif$TID" ne [alited::bar::BAR cget -ALmodif]} { alited::bar::BAR configure -ALmodif "$modif$TID" set f [alited::bar::CurrentTab 1] set d [file normalize [file dirname [alited::bar::CurrentTab 2]]] set ttl [string map [list %f $f %d $d %p $al(prjname)] $al(TITLE)] wm title $al(WIN) [string trim "$modif$ttl"] } }
Shows a balloon with outdated TODO.
| project's name |
| date of TODO |
| text of TODO |
| 1 for current day TODO, 2 for "ahead" TODO |
proc ::alited::main::ShowOutdatedTODO {prj date todo is} { # Shows a balloon with outdated TODO. # prj - project's name # date - date of TODO # todo - text of TODO # is - 1 for current day TODO, 2 for "ahead" TODO namespace upvar ::alited al al set todo "\n$al(MC,prjName) $prj\n\n$al(MC,on) $date\n\n$todo\n" set opts {} if {[string first !!! $todo]>-1 || ($is==1 && $al(todoahead))} { set opts {-ontop 1 -eternal 1 -fg white -bg red} } ::alited::Balloon $todo yes 2500 {*}$opts }
Displays a current text.
proc ::alited::main::ShowText {} { # Displays a current text. namespace upvar ::alited al al obPav obPav set TID [alited::bar::CurrentTabID] lassign [GetText $TID yes] curfile wtxt wsbv pos doinit dopack selrange wrap if {$dopack} { PackTextWidgets $wtxt $wsbv } if {$doinit || $dopack} { # for newly displayed text: create also its unit tree set al(TREE,units) no alited::tree::Create } # this code below redraws the tree's scrollbar set wtree [$obPav Tree] $wtree configure -yscrollcommand [$wtree cget -yscrollcommand] FocusText $TID $pos focus $wtxt alited::tree::SeeTreeItem alited::tree::IconContract if {$selrange ne {}} { catch {$wtxt tag add sel {*}$selrange} } if {$wrap eq {none}} { alited::bar::SetTabState $TID --wrap {} ;# because it's the very first enter alited::file::WrapLines yes } # update "File" menu and app's header alited::menu::CheckMenuItems ShowHeader # fill Type Templates menu catch {after cancel $al(afterFillTTMenu)} set al(afterFillTTMenu) [after 500 {after idle alited::unit::FillTypeTplMenu}] }
Gets a tip for a status bar's short info.
proc ::alited::main::TipStatus {} { # Gets a tip for a status bar's short info. namespace upvar ::alited al al obPav obPav set run "$al(MC,run) " switch $al(prjincons) { 0 {append run $al(MC,intkcon)} 1 {append run $al(MC,inconsole)} 2 {append run $al(MC,asis)} } if {[alited::tool::ComForced]} { append run :\ $al(comForce) } else { lassign [alited::tool::RunArgs] ar rf ex append run :\ $ar$rf$ex } set tip [[$obPav Labstat4] cget -text] set tip [string map [list eol= "$al(MC,EOL:) " ind= "$al(MC,indent:) " {, } \n ] $tip] return "$run\n\n[msgcat::mc Encoding]: $tip" }
Unsets all marks in the mark bar.
proc ::alited::main::UnsetAllMarks {} { # Unsets all marks in the mark bar. variable wcan variable bgcan lassign [MarkOptions] N for {set i 0} {$i<$N} {incr i} { UnsetOneMark $i } }
Unsets a mark in the mark bar or call a popup menu.
| index of tag used as the mark |
| X-coordinate of pointer |
| Y-coordinate of pointer |
proc ::alited::main::UnsetMark {idx X Y} { # Unsets a mark in the mark bar or call a popup menu. # idx - index of tag used as the mark # X - X-coordinate of pointer # Y - Y-coordinate of pointer namespace upvar ::alited al al variable wcan set disabletips no lassign [MarkOptions $idx] N tip mark markdata if {[info exists al($markdata)]} { set disabletips yes UnsetOneMark $idx } else { set disabletips yes set popm $al(WIN).popmMARK catch {destroy $popm} menu $popm -tearoff 1 -title $al(MC,marks) $popm add command -label [msgcat::mc {Clear All}] -command "alited::main::UnsetAllMarks" $popm add separator set lab [msgcat::mc Width] $popm add command -label "$lab +" -command "alited::main::MarkWidth 1" $popm add command -label "$lab -" -command "alited::main::MarkWidth -1" $popm add separator $popm add command -label $al(MC,help) -command {alited::main::Help mark} tk_popup $popm $X $Y } if {$disabletips && ![info exists al(MARK_TIPOFF)]} { # disable all default tips on empty marks set al(MARK_TIPOFF) 1 for {set i 0} {$i<$N} {incr i} { lassign [MarkOptions $i] - - - data if {![info exists al($data)]} { UnsetOneMark $i } } } }
Unsets one mark in the mark bar.
| index of tag used as the mark |
proc ::alited::main::UnsetOneMark {idx} { # Unsets one mark in the mark bar. # idx - index of tag used as the mark namespace upvar ::alited al al variable wcan variable bgcan lassign [MarkOptions $idx] N tip mark markdata $wcan itemconfigure $al($mark) -fill $bgcan ::baltip::tip $wcan $tip -ctag $al($mark) -shiftX 10 catch { lassign $al($markdata) fname pos wtxt tag unset al($markdata) $wtxt tag delete $tag } }
Updates tree, text and gutter.
| headers of all selected units; optional, default "" |
proc ::alited::main::UpdateAll {{headers {}}} { # Updates tree, text and gutter. # headers - headers of all selected units alited::tree::RecreateTree {} $headers UpdateTextGutter HighlightLine }
Redraws the gutter.
proc ::alited::main::UpdateGutter {} { # Redraws the gutter. namespace upvar ::alited obPav obPav set wtxt [CurrentWTXT] after idle [list after 0 "$obPav fillGutter $wtxt"] }
Updates the current text's highlighting.
proc ::alited::main::UpdateHighlighting {} { # Updates the current text's highlighting. set TID [alited::bar::CurrentTabID] lassign [GetText $TID] curfile wtxt HighlightText $TID $curfile $wtxt }
Updates after replacements: icons.
proc ::alited::main::UpdateIcons {} { # Updates after replacements: icons. alited::bar::OnTabSelection [alited::bar::CurrentTabID] }
Updates mark bar at changing -bg color.
proc ::alited::main::UpdateMarkBar {} { # Updates mark bar at changing -bg color. namespace upvar ::alited al al lassign [MarkOptions] N for {set i 0} {$i<$N} {incr i} { lassign [MarkOptions $i] - - - markdata if {![info exists al($markdata)]} {UnsetOneMark $i} } }
Displays a project settings in the status bar.
| indentation calculated for a text; optional, default "" |
proc ::alited::main::UpdateProjectInfo {{indent {}}} { # Displays a project settings in the status bar. # indent - indentation calculated for a text namespace upvar ::alited al al obPav obPav if {$al(prjroot) ne {}} {set stsw normal} {set stsw disabled} [$obPav BtTswitch] configure -state $stsw if {[catch {set eol [alited::file::EOL]}] || $eol eq {}} { if {[set eol $al(prjEOL)] eq {}} {set eol auto} } else { lassign [split $eol] -> eol } if {$indent eq {}} {set indent [lindex [CalcIndentation] 0]} if {[catch {set enc [alited::file::Encoding]}] || $enc eq {}} { set enc utf-8 } else { lassign [split $enc] -> enc } set info "$enc, eol=$eol, ind=$indent" if {$al(prjindentAuto)} {append info /auto} [$obPav Labstat4] configure -text $info }
Redraws a text.
| the text widget's path; optional, default "" |
| file name of the text; optional, default "" |
proc ::alited::main::UpdateText {{wtxt {}} {curfile {}}} { # Redraws a text. # wtxt - the text widget's path # curfile - file name of the text namespace upvar ::alited obPav obPav if {$wtxt eq {}} {set wtxt [CurrentWTXT]} if {$curfile eq {}} {set curfile [alited::bar::FileName]} if {[alited::file::IsClang $curfile]} { ::hl_c::hl_text $wtxt } else { ::hl_tcl::hl_text $wtxt } }
Redraws both a text and a gutter.
proc ::alited::main::UpdateTextGutter {} { # Redraws both a text and a gutter. UpdateGutter UpdateText }
Updates after replacements: text, gutter, unit tree.
proc ::alited::main::UpdateTextGutterTree {} { # Updates after replacements: text, gutter, unit tree. UpdateTextGutter UpdateUnitTree }
Updates after replacements: text, gutter, unit tree, icons.
proc ::alited::main::UpdateTextGutterTreeIcons {} { # Updates after replacements: text, gutter, unit tree, icons. UpdateTextGutterTree UpdateIcons }
Redraws unit tree at need.
proc ::alited::main::UpdateUnitTree {} { # Redraws unit tree at need. set fname [alited::bar::FileName] if {$::alited::al(TREE,isunits) && [alited::file::IsUnitFile $fname]} { alited::tree::RecreateTree } }
Disables/enables "File/Close All..." menu items.
Sets a check in menu "Tint" according to the current tint.
| "yes" at restarting this procedure after a pause; optional, default no |
Comapares two names of files, by their rootnames.
| 1st name |
| 2nd name |
Fills Edit/Format submenu with items taken from "alited/data/format" directory.
| submenu's path |
| directory name; optional, default "" |
| current level of subdirectory; optional, default 0 |
| menu's ID; optional, default 0 |
Fills play macro items.
Populates alited's main menu.
Fills Tools/e_menu items, depending on a currently edited file.
| the current file name |
Maps %f & %D wildcards to the current file & directory names.
Gets a Formats item's name.
| formatter file's name |
Gets a list of Help/Context (file names and labels).
Gets play macro item's options.
| argument of command |
| label of macro |
Gets a map list to map %f & %D wildcards to the current file & directory names.
| the current file name |
Creates a cascade submenu, saving its title (for saved/restored submenus).
| parent menu's path |
| submenu name |
| parent's title |
| submenu's title; optional, default "" |
Loads and calls Paver tool.
| 0 run paver; 1 auto update flag; 2 view code; 3 help |
Restores cascade menus at starting alited.
Saves the geometry of tear-off menus.
MenuCascade, RestoreCascadeMenu
Sets a tint of a current color scheme.
| value of the tint |
Tear off a cascade menus at starting alited.
| menu's path |
| tearoff menu's path |
| geometry of menu |
Gets the range for tints, counting the current one as the middle point.
Creates and shows the paver's window.
| widget list to handle; optional, default "" |
proc ::alited::paver::_create {{inplist {}}} { # Creates and shows the paver's window. # inplist - widget list to handle variable pobj variable win variable paverttl variable geometry variable widgetlist if {$inplist ne {}} { set widgetlist [list] foreach widitem $inplist { lassign $widitem wid nei pos rspan cspan gridpack attrs lassign [CheckCommentedOptions $gridpack $attrs] gridpack attrs if {[string index $wid 0] ne {#}} { lappend widgetlist [list $wid $nei $pos $rspan $cspan $gridpack $attrs] } } } Destroy ::apave::APave create $pobj $win $pobj makeWindow $win.fra $paverttl $pobj paveWindow $win.fra $widgetlist if {$geometry ne {}} {set geo "-geometry $geometry"} {set geo {}} after 300 {::alited::paver::AutoUpdate 2} set res [$pobj showModal $win -modal no -waitvar 1 -resizable 1 -minsize {50 50} -escape 1 -onclose ::alited::paver::Close {*}$geo] Destroy }
Runs the paver.
proc ::alited::paver::_run {} { # Runs the paver. variable widgetlist variable viewpos WidgetList if {$widgetlist eq {}} { MessageNotList } else { set viewpos 1.0 _create } }
Auto-updates the paver.
| if 1, runs the paver; optional, default 0 |
proc ::alited::paver::AutoUpdate {{dorun 0}} { # Auto-updates the paver. # dorun - if 1, runs the paver namespace upvar ::alited al al variable pobj variable win variable paverTID variable modtime set fname [alited::bar::FileName] if {!$al(paverauto)} return if {!$dorun && [winfo exists $win]} { ::apave::deiconify $::alited::paver::win after idle alited::paver::_run } if {[file exists $fname]} { set TID [alited::bar::CurrentTabID] if {$TID eq $paverTID && [set dt [file mtime $fname]] ne $modtime} { set modtime $dt if {$dorun==1} {after idle alited::paver::_run} after 500 {after idle alited::main::FocusText} } } after 300 {::alited::paver::AutoUpdate 1} }
Checks for commented options of gridpack & attrs of widget list item
| grid/pack item of widget list item |
| attrs item of widget list item |
proc ::alited::paver::CheckCommentedOptions {gridpack attrs} { # Checks for commented options of gridpack & attrs of widget list item # gridpack - grid/pack item of widget list item # attrs - attrs item of widget list item foreach vl {gridpack attrs} { # gridpack & attrs lists: check both for items commented, e.g. #-side left... # (not implemented in APave for the sake of performance) set lst [set $vl] if {[set i [lsearch -glob $lst #*]]>-1} { set $vl [lreplace $lst $i end] } } list $gridpack $attrs }
Closes paver's window.
| Optional arguments. |
proc ::alited::paver::Close {args} { # Closes paver's window. variable pobj variable win variable geometry catch { set geo [wm geometry $win] set geo [string range $geo [string first + $geo] end] if {$geo ne {+0+0}} {set geometry $geo} } catch {$pobj res $win 0} catch {destroy $win} }
Destroys paver's window.
| Optional arguments. |
proc ::alited::paver::Destroy {args} { # Destroys paver's window. variable pobj variable win Close catch {$pobj destroy} }
Closes the viewer.
| Optional arguments. |
proc ::alited::paver::ExitViewer {args} { # Closes the viewer. HandleViewer 0 }
Handles viewer's save/close actions.
| if 1, saves a code and updates the paver's window; if 0 closes the viewer; optional, default 1 |
| Optional arguments. |
proc ::alited::paver::HandleViewer {{act 1} args} { # Handles viewer's save/close actions. # act - if 1, saves a code and updates the paver's window; if 0 closes the viewer namespace upvar ::alited obDl2 obDl2 variable win2 variable viewpos variable code variable viewgeo catch { set viewgeo [wm geometry $win2] if {$act} { set tex [$obDl2 TexM] set code [string trim [$tex get 1.0 end]]\n set viewpos [$tex index insert] after idle [list alited::paver::_create $code] after idle after 100 "focusByForce $tex" } else { $obDl2 res $win2 0 destroy $win2 } } }
Handles hitting Help button.
| Optional arguments. |
proc ::alited::paver::Help {args} { # Handles hitting Help button. variable win alited::Help $win }
Show a message about absent widget list.
proc ::alited::paver::MessageNotList {} { # Show a message about absent widget list. set msg {For paveWindow's widget list to be recognized, set the cursor inside it.} alited::Message [msgcat::mc $msg] 4 }
Removes some options with variable values.
| list of options/value pairs |
proc ::alited::paver::RemoveVarOptions {attrs} { # Removes some options with variable values. # attrs - list of options/value pairs if {[llength $attrs]%2} {return $attrs} set wasvar 0 set attrsorig $attrs foreach opt {-w -h -width -height} { lassign [::apave::extractOptions attrs $opt {}] val if {$val ne {}} { if {[string is integer -strict $val]} { lappend attrs $opt $val } set wasvar 1 } } if {!$wasvar} { return $attrsorig } return $attrs }
Shows the widget list.
proc ::alited::paver::Viewer {} { # Shows the widget list. namespace upvar ::alited al al obDl2 obDl2 variable paverttl variable code variable geometry variable viewgeo variable viewpos variable win2 WidgetList if {$code eq {}} { MessageNotList return } catch {destroy $win2} if {$viewgeo ne {}} { set geo "-geometry $viewgeo" } else { set geo -geometry\ +[winfo vrootx $al(WIN)]+[winfo vrooty $al(WIN)] } after idle "catch { set txt \[$obDl2 TexM\] ; ::hl_tcl::hl_init \$txt -dark [$obDl2 csDark] -colors {[alited::SyntaxColors]} -cmdpos ::apave::None -font {$al(FONT,txt)} ; ::hl_tcl::hl_text \$txt}" after idle "set ::alited::paver::win2 \[$obDl2 dlgPath\]" $obDl2 misc info $paverttl $code {OK ::alited::paver::HandleViewer Close ::alited::paver::ExitViewer} TEXT -modal no -waitvar 1 -text 1 -savetext 0 -ro 0 -rotext ::alited::paver::code -minsize {300 200} -w {40 80} -h {5 20} -resizable 1 -pos $viewpos {*}$geo catch {destroy $win2} }
Finds and gets a paveWindow's widget list from a current text.
proc ::alited::paver::WidgetList {} { # Finds and gets a paveWindow's widget list from a current text. variable widgetlist variable paverttl variable paverTID variable code set code {} # 1st attempt: search the widget list in a current unit (by default) lassign [alited::tree::CurrentItemByLine {} 1] - - leaf - paverttl l1 l2 set wtxt [alited::main::CurrentWTXT] set lcur [expr {int([$wtxt index insert])}] set lend [expr {int([$wtxt index end])}] # 2nd attempt: search the widget list edged by "# paver" comments (by force) set RE {^\s*#\s*paver} for {set l $lcur} {$l>0} {incr l -1} { set line [$wtxt get $l.0 $l.end] if {[regexp -nocase $RE $line] || [string match {* paveWindow *} $line]} { set l1 [incr l -1] set l2 $lend break } } for {set l $lcur} {$l<=$lend} {} { incr l set line [$wtxt get $l.0 $l.end] if {[regexp -nocase $RE $line]} { set l2 $l break } } if {$l1>=$l2} {return {}} set paverTID [alited::bar::CurrentTabID] set widgetlist [set com {}] for {set l [incr l1]} {$l<=$l2} {incr l} { set line [$wtxt get $l.0 $l.end] set line [string trimright $line " \\"] # search by completeness of a command the cursor is in append com $line \n if {[info complete $com]} { if {$l>=$lcur} { set widgetlist $com break } set com {} } } set widgetlist [string trim $widgetlist] set i1 [string first \{ $widgetlist] set i2 [string first \[list $widgetlist] if {$i1>-1 && $i2>-1 && $i1<$i2 || $i2<0} { set i $i1 if {$i<0} {set i 9999999} } else { set i $i2 if {$i<0} {set i 9999999} {incr i 5} } set widgetlist [string trim [string range $widgetlist [incr i] end-1]] catch { set wlist [list] foreach widitem $widgetlist { #! catch #\{set widitem [subst -nobackslashes -nocommands $widitem]#\} lappend wlist $widitem } set widgetlist $wlist } set widgetlist [string map [list "\[list " "\{" "\]" "\}" "\[" "\{" "\$" ""] $widgetlist] set wlist [list] foreach widitem $widgetlist { lassign $widitem wid nei pos rspan cspan gridpack attrs switch -glob $wid { {#*} - {after} - {} continue } lassign [CheckCommentedOptions $gridpack $attrs] gridpack attrs if {[lindex $gridpack 0] eq {pack}} { if {[lindex $gridpack 1] eq {forget}} {set i 2} {set i 1} set opts [lrange $gridpack $i end] foreach opt {-in} { lassign [::apave::extractOptions opts $opt {}] val if {$val ne {} && [string first . $val]==0} { lappend opts $opt $val } } set gridpack [lrange $gridpack 0 $i-1] lappend gridpack {*}$opts } foreach opt {-validate -validatecommand -foreground -background -fg -bg -from -to -variable -textvariable -listvariable -command -var -tvar -lvar -com -array -afteridle -ALL -dateformat} { ::apave::extractOptions attrs $opt {} } set font [::apave::extractOptions attrs -font {}] if {$font ne "{}" && ![catch {font actual $font}]} { append attrs " -font $font" } set style [::apave::extractOptions attrs -style {}] if {![catch {set _ [ttk::style configure $style]}] && $_ ne {}} { append attrs " -style $style" } set attrs [RemoveVarOptions $attrs] set attrs2 [list] foreach {opt val} $attrs { set val [RemoveVarOptions $val] if {[llength $val]%2} { lappend attrs2 $opt $val continue } set val2 [list] foreach {o v} $val { set v [RemoveVarOptions $v] if {$v eq {}} continue lappend val2 $o $v } if {$val2 eq {}} continue lappend attrs2 $opt $val2 } set attrs $attrs2 set widitem [list $wid $nei $pos $rspan $cspan $gridpack $attrs] lappend wlist $widitem append code [list $widitem] \n } set widgetlist $wlist }
Creates "Preferences" dialogue.
| previous open tab |
proc ::alited::pref::_create {tab} { # Creates "Preferences" dialogue. # tab - previous open tab fetchVars set tipson [baltip::cget -on] set preview 0 baltip::configure -on $al(TIPS,Preferences) ::apave::APave create $obPrf $win $obPrf makeWindow $win.fra "$al(MC,pref) :: $::alited::USERDIR" $obPrf paveWindow $win.fra [MainFrame] $win.fra.fraR.nbk.f1 [General_Tab1] $win.fra.fraR.nbk.f2 [General_Tab2] $win.fra.fraR.nbk.f3 [General_Tab3] $win.fra.fraR.nbk2.f1 [Edit_Tab1] $win.fra.fraR.nbk2.f2 [Edit_Tab2] $win.fra.fraR.nbk2.f3 [Edit_Tab3] $win.fra.fraR.nbk2.f4 [Edit_Tab4] $win.fra.fraR.nbk3.f1 [Units_Tab] $win.fra.fraR.nbk4.f1 [Template_Tab] $win.fra.fraR.nbk5.f1 [Keys_Tab1] $win.fra.fraR.nbk6.f1 [Common_Tab] $win.fra.fraR.nbk6.f2 [Emenu_Tab] $win.fra.fraR.nbk6.f3 [Runs_Tab $tab] $win.fra.fraR.nbk6.f4 [Tkcon_Tab] set wtxt [$obPrf TexNotes] set fnotes [file join $::alited::USERDIR notes.txt] if {[file exists $fnotes]} { $wtxt insert end [readTextFile $fnotes] } after idle "alited::ini::HighlightFileText $wtxt .md 0" $wtxt edit reset; $wtxt edit modified no [$obPrf TexTclKeys] insert end $al(ED,TclKeyWords) [$obPrf TexCKeys] insert end $al(ED,CKeyWords) set 1st "$win.fra.fraR.nbk select $arrayTab(nbk)" ;# to restore 1st nbk's tab if {$tab ne {}} { switch -exact $tab { Emenu_Tab { set nbk nbk6 set nt $win.fra.fraR.nbk6.f3 after idle "$1st ; ::alited::pref::Tab $nbk $nt yes" } } } elseif {$oldTab ne {}} { after idle "$1st ; ::alited::pref::Tab $oldTab {} yes" } else { after idle "::alited::pref::Tab nbk" ;# first entering } foreach o {o O} {bind $win <Control-$o> alited::ini::EditSettings} bind $win <F1> "[$obPrf ButHelp] invoke" bind [$obPrf LabMess] <Button-1> alited::pref::ProcMessage $obPrf untouchWidgets *.texSample *.texCSample if {$geo in [list {} "{}"]} {set geo root=$al(WIN)} set res [$obPrf showModal $win -geometry $geo -minsize {800 600} -resizable 1 -onclose ::alited::pref::Cancel] set fcont [$wtxt get 1.0 {end -1c}] writeTextFile $fnotes fcont if {[llength $res] < 2} {set res ""} set geo [wm geometry $win] ;# save the new geometry of the dialogue set oldTab $curTab set arrayTab($curTab) [$win.fra.fraR.$curTab select] CheckTheming no baltip::configure {*}$tipson foreach arr {data prevkeys savekeys} {array unset $arr *} catch {destroy $win} $obPrf destroy return $res }
Initializes "Preferences" dialogue.
proc ::alited::pref::_init {} { # Initializes "Preferences" dialogue. fetchVars InitLocales SaveSettings set curTab "nbk" IniKeys }
Runs "Preferences" dialogue.
| previous open tab; optional, default "" |
Returns yes, if settings were saved.
proc ::alited::pref::_run {{tab {}}} { # Runs "Preferences" dialogue. # tab - previous open tab # Returns yes, if settings were saved. update ;# if run from menu: there may be unupdated space under it (in some DE) _init set res [_create $tab] return $res }
Binds a key event to a key combination.
| index of combobox corresponding to the event |
| key combination or "-" (for not engaged keys); optional, default "" |
| default key combination; optional, default "" |
Returns a bound keys for not engaged keys or {} for others.
proc ::alited::pref::BindKey {nk {key {}} {defk {}}} { # Binds a key event to a key combination. # nk - index of combobox corresponding to the event # key - key combination or "-" (for not engaged keys) # defk - default key combination # Returns a bound keys for not engaged keys or {} for others. fetchVars if {$key eq {-}} { # not engaged event: bind to a new combination if defined if {[info exists keys($nk)]} { return $keys($nk) } # otherwise bind to the default return $defk } switch $nk { 4 { ;# "Double Selection" ::apave::setTextHotkeys CtrlD $keys($nk) } 5 { ;# "Delete Line" ::apave::setTextHotkeys CtrlY $keys($nk) } 10 { ;# "Highlight First" ::apave::setTextHotkeys AltQ $keys($nk) } 11 { ;# "Highlight Last" ::apave::setTextHotkeys AltW $keys($nk) } } return {} }
Almost the same as BindKey, but gets a list of upper & lower keys.
| index of combobox corresponding to the event |
| key combination or "-" (for not engaged keys); optional, default "" |
| default key combination; optional, default "" |
proc ::alited::pref::BindKey2 {nk {key {}} {defk {}}} { # Almost the same as BindKey, but gets a list of upper & lower keys. # nk - index of combobox corresponding to the event # key - key combination or "-" (for not engaged keys) # defk - default key combination # See also: BindKey set res [BindKey $nk $key $defk] set char [string range $res end-1 end] if {[regexp {^[-][[:alpha:]]$} $char]} { set res [string range $res 0 end-2] set res [list $res[string toupper $char] $res[string tolower $char]] } return $res }
Sets default colors to highlight C.
| index of syntax colors |
| yes, if only variables should be initialized; optional, default no |
proc ::alited::pref::C_Default {isyn {init no}} { # Sets default colors to highlight C. # isyn - index of syntax colors # init - yes, if only variables should be initialized fetchVars set al(ClangExts) $al(ClangExtsDef) set Dark [CsDark] set clrnams [::hl_tcl::hl_colorNames] set clrvals [::hl_c::hl_colors $isyn $Dark] foreach nam $clrnams val $clrvals { set al(ED,C$nam) $val } if {!$init} {UpdateSyntaxTab 2} set al(syntaxidx) $isyn }
Closes Preferences.
| not empty, if called by Esc, Alt+F4 or "X" button |
proc ::alited::pref::Cancel {args} { # Closes Preferences. # args - not empty, if called by Esc, Alt+F4 or "X" button fetchVars if {[llength $args]} { set ischanged [expr { $al(THEME) ne $opc1 || $al(INI,CS) ne [GetCS] || $al(EM,CS) ne [GetCS 2]}] foreach o [SavedOptions] { if {[info exist data($o)] && $al($o) ne $data($o)} { set ischanged yes break } } for {set i 0} {$i<$em_Num} {incr i} { catch { lassign $em_inf($i) em1 idx1 item1 lassign $data(em_inf,$i) em2 idx2 item2 set em1 [file rootname $em1] ;# for compatibility set em2 [file rootname $em2] ;# with old ".mnu" extension if {$em_mnu($i) ne $data(em_mnu,$i) || $em_ico($i) ne $data(em_ico,$i) || $em1 ne $em2 || $idx1 ne $idx2 || $item1 ne $item2} { set ischanged yes } } } if {$ischanged} { if {![alited::msg okcancel warn {Changes will be lost!} CANCEL]} return } } RestoreSettings alited::CloseDlg $obPrf res $win 0 }
Check for access to SpxMaxBak field. If CbxBackup is empty (no backup), SpxMaxBak should be disabled.
proc ::alited::pref::CbxBackup {} { # Check for access to SpxMaxBak field. # If CbxBackup is empty (no backup), SpxMaxBak should be disabled. fetchVars if {$al(BACKUP) eq {}} {set state disabled} {set state normal} [$obPrf SpxMaxBak] configure -state $state [$obPrf LabMaxBak] configure -state $state }
Checks if the color scheme is changed and, if so, sets "Color of cursor" field.
proc ::alited::pref::CheckCS {} { # Checks if the color scheme is changed and, if so, sets "Color of cursor" field. fetchVars set cs [GetCS] set cclr [lindex [obj csGet $cs] 7] if {$al(CURSORCOLOR) ne $cclr} { catch { .alwin.diaPref.fra.fraR.nbk.f1.fra1.labclrCC configure -background $cclr set al(CURSORCOLOR) $cclr } } return $cs }
Sets "auto indentation", if indent is 1 (for indentation by Tabs)
| prefix: if {}, refers to a project's settings, by default to preferences'; optional, default DEFAULT, |
proc ::alited::pref::CheckIndent {{pre DEFAULT,}} { # Sets "auto indentation", if indent is 1 (for indentation by Tabs) # pre - prefix: if {}, refers to a project's settings, by default to preferences' namespace upvar ::alited al al if {$al(${pre}prjindent)<=1} {set al(${pre}prjindentAuto) 1} }
Checker for "OK" button.
Returns yes if OK button may be handled, else no.
proc ::alited::pref::CheckOk {} { # Checker for "OK" button. # Returns yes if OK button may be handled, else no. fetchVars if {$al(INI,LEAF) && $al(RE,leaf) eq {}} { bell ::alited::pref::Tab nbk3 $win.fra.fraR.nbk3.f1 yes no focus [$obPrf EntLf] return no } return yes }
Checks periodically theming options and, if changed, shows their preview.
| if no, deletes both a temporary file and the possible preview; optional, default yes |
| if yes, shows the preview by force; optional, default no |
The theming cannot be nice viewed "on fly", so we need to use a separate app.
proc ::alited::pref::CheckTheming {{doit yes} {force no}} { # Checks periodically theming options and, if changed, shows their preview. # doit - if no, deletes both a temporary file and the possible preview # force - if yes, shows the preview by force # The theming cannot be nice viewed "on fly", so we need to use a separate app. namespace upvar ::alited SRCDIR SRCDIR fetchVars set fname [file join [alited::tool::EM_dir] preview~] if {!$doit || (!$force && ![file exists $fname])} { catch {file delete $fname} catch {unset al(checkTheming)} return } set cs [GetCS] if {$al(CURSORCOLOR) ne {}} {set cc $al(CURSORCOLOR)} {set cc "{}"} if {[string is double -strict $al(INI,HUE)]} {set hue $al(INI,HUE)} {set hue 0} if {[string is double -strict $al(CURSORWIDTH)]} {set cw $al(CURSORWIDTH)} {set cw 2} set thopts "$opc1 $cs $hue $cw $al(ED,BlinkCurs) $cc" if {![info exists al(checkTheming)] || $al(checkTheming) ne $thopts || $force} { incr al(prefCheckID) lassign [split [wm geometry $win] x+] w h x y set ch [open $fname w] puts $ch "+[expr {$x+$w/6}]+[expr {$y+$h/3}] $thopts {$al(MC,test)} $al(prefCheckID)" close $ch alited::Runtime [file join $SRCDIR preview.tcl] $fname $al(prefCheckID) set al(checkTheming) $thopts } after 100 {alited::pref::CheckTheming yes} }
Enables/disables the project default fields.
proc ::alited::pref::CheckUseDef {} { # Enables/disables the project default fields. fetchVars if {$al(PRJDEFAULT)} { set state normal [$obPrf CbxEOL] configure -state readonly } else { set state disabled [$obPrf CbxEOL] configure -state $state } foreach w {EntIgn SpxIndent SpxRedunit SwiMult ChbIndAuto SwiTrWs} { [$obPrf $w] configure -state $state } }
Enables/disables the "Regexp of a leaf" field.
proc ::alited::pref::CheckUseLeaf {} { # Enables/disables the "Regexp of a leaf" field. fetchVars if {$al(INI,LEAF)} { set state1 disabled set state2 normal } else { set state1 normal set state2 disabled } if {$al(RE,proc) eq {}} {set al(RE,proc) [string trimright $al(RE,procDEF)]} if {$al(RE,proc2) eq {}} {set al(RE,proc2) [string trimright $al(RE,proc2DEF)]} [$obPrf EntPr] configure -state $state1 [$obPrf EntLf] configure -state $state2 }
Serves to layout "Tools/Common" tab.
proc ::alited::pref::Common_Tab {} { # Serves to layout "Tools/Common" tab. fetchVars if {$al(EM,Tcl) eq {}} { set al(TCLINIDIR) [info nameofexecutable] } else { set al(TCLINIDIR) $al(EM,Tcl) } set al(TCLINIDIR) [file dirname $al(TCLINIDIR)] set al(TCLLIST) [split $al(EM,TclList) \t] set al(TTLIST) [split $al(EM,tt=List) \t] set al(WTLIST) [split $al(EM,wt=List) \t] set res { {v_ - - 1 1} {fra + T 1 1 {-st nsew -cw 1 -rw 1}} {fra.scf - - 1 1 {pack -fill both -expand 1} {-mode x}} {.labTcl - - 1 1 {-st e -pady 1 -padx 3} {-t "tclsh, wish or tclkit:"}} {.fiLTcl + L 1 2 {-st sw -pady 5} {-tvar ::alited::al(EM,Tcl) -values {$al(TCLLIST)} -w 45 -initialdir $al(TCLINIDIR) -clearcom {alited::main::ClearCbx %w ::alited::al(TCLLIST)}}} {.labDF .labTT T 1 1 {-st e -pady 1 -padx 3} {-t "Diff tool:"}} {.filDF + L 1 2 {-st sw -pady 1} {-tvar ::alited::al(EM,DiffTool) -w 45 -tabnext alited::Tnext}} {.labDoc .labDF T 1 1 {-st e -pady 1 -padx 3} {-t "Path to man/tcl:"}} {.dirDoc + L 1 2 {-st sw -pady 5} {-tvar ::alited::al(EM,h=) -w 45}} } if {$al(IsWindows)} { set tt {{.labTT .labTcl T 1 1 {-st e -pady 1 -padx 3} {-t "MS Windows shell:"}} {.cbxTT + L 1 1 {-st swe -pady 5} {-tvar ::alited::al(EM,wt=) -w 45 -values {$al(WTLIST)}}} {.butOK + L 1 1 {} {-t Test -com {alited::tool::_run 5}}}} } else { set tt {{.labTT .labTcl T 1 1 {-st e -pady 1 -padx 3} {-t "Linux terminal:"}} {.cbxTT + L 1 1 {-st swe -pady 5} {-tvar ::alited::al(EM,tt=) -w 45 -values {$al(TTLIST)} -clearcom {alited::main::ClearCbx %w ::alited::al(TTLIST)}}} {.butOK + L 1 1 {-pady 5} {-t Test -com {alited::tool::_run 5}}}} } linsert $res 5 {*}$tt }
Gets a lightness of a color scheme.
| the color scheme's index (if omitted, the chosen one's); optional, default "" |
proc ::alited::pref::CsDark {{cs {}}} { # Gets a lightness of a color scheme. # cs - the color scheme's index (if omitted, the chosen one's) if {$cs eq {}} {set cs [GetCS]} return [obj csDark $cs] }
Set default a_menu settings.
Deletes a current "bar-menu" action.
proc ::alited::pref::DelRun {} { # Deletes a current "bar-menu" action. fetchVars if {[set idx [FocusedRun]]<0} return for {set i $idx} {$i<$em_Num} {incr i} { if {$i==($em_Num-1)} { lassign {} em_mnu($i) em_ico($i) em_inf($i) } else { # make upper all the rest actions set ip [expr {$i+1}] set em_ico($i) $em_ico($ip) set em_mnu($i) $em_mnu($ip) set em_inf($i) $em_inf($ip) } } Em_ShowAll ScrollRuns }
Move a current run item down.
proc ::alited::pref::DownRun {} { # Move a current run item down. if {[set fr [FocusedRun]]<0} return set f2 [expr {$fr + 1}] if {$f2>=$::alited::pref::em_Num} { bell } else { ExchangeRuns $fr $f2 } }
Serves to layout "Editor" tab.
proc ::alited::pref::Edit_Tab1 {} { # Serves to layout "Editor" tab. return { {v_ - - 1 1} {fra v_ T 1 1 {-st nsew -cw 1 -rw 1}} {fra.scf - - 1 1 {pack -fill both -expand 1} {-mode y}} {.labFon - - 1 1 {-st e -pady 8 -padx 3} {-t Font:}} {.fonTxt2 + L 1 9 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(FONT,txt) -w 50}} {.labSp1 .labFon T 1 1 {-st e -pady 1 -padx 3} {-t {Space above lines:}}} {.spxSp1 .labSp1 L 1 1 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(ED,sp1) -from 0 -to 16}} {.labSp3 .labSp1 T 1 1 {-st e -pady 1 -padx 3} {-t {Space below lines:}}} {.spxSp3 + L 1 1 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(ED,sp3) -from 0 -to 16}} {.labSp2 .labSp3 T 1 1 {-st e -pady 1 -padx 3} {-t {Space between wraps:}}} {.spxSp2 + L 1 1 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(ED,sp2) -from 0 -to 16}} {.labBC .labSp2 T 1 1 {-st e -pady 1 -padx 3} {-t {Blinking cursor:}}} {.swiBC + L 1 1 {-st sw -pady 5 -padx 3} {-var ::alited::al(ED,BlinkCurs)}} {.seh .labBC T 1 10 {-pady 3}} {.labGW + T 1 1 {-st e -pady 1 -padx 3} {-t {Gutter's width:}}} {.spxGW + L 1 1 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(ED,gutterwidth) -from 3 -to 7}} {.labGS .labGW T 1 1 {-st e -pady 1 -padx 3} {-t {Gutter's shift from text:}}} {.spxGS + L 1 1 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(ED,guttershift) -from 0 -to 10}} {.seh2 .labGS T 1 10 {-pady 3}} {.labLl + T 1 1 {-st e -pady 1 -padx 3} {-t {Tab bar label's length:}}} {.spxLl + L 1 1 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(INI,barlablen) -from 10 -to 100}} {.labTl .labLl T 1 1 {-st e -pady 1 -padx 3} {-t {Tab bar tip's length:}}} {.spxTl + L 1 1 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(INI,bartiplen) -from 10 -to 100}} {.labBD .labTl T 1 1 {-st e -pady 1 -padx 3} {-t {Border for bar tabs:}}} {.swiBD + L 1 1 {-st sw -pady 5 -padx 3} {-var ::alited::al(ED,btsbd) -tabnext alited::Tnext}} } }
Serves to layout "Tcl syntax" tab.
proc ::alited::pref::Edit_Tab2 {} { # Serves to layout "Tcl syntax" tab. return { {v_ - - 1 1} {FraTab2 v_ T 1 1 {-st nsew -cw 1 -rw 1}} {fraTab2.scf - - 1 1 {pack -fill both -expand 1} {-mode y}} {.labExt - - 1 1 {-st e -pady 3 -padx 3} {-t {Tcl files' extensions:}}} {.entExt + L 1 1 {-st swe -pady 3} {-tvar ::alited::al(TclExts) -w 50}} {.labCOM .labExt T 1 1 {-st e -pady 3 -padx 3} {-t {Color of Tcl commands:}}} {.clrCOM + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrCOM) -w 20}} {.labCOMTK .labCOM T 1 1 {-st e -pady 3 -padx 3} {-t {Color of Tk commands:}}} {.clrCOMTK + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrCOMTK) -w 20}} {.labSTR .labCOMTK T 1 1 {-st e -pady 3 -padx 3} {-t {Color of strings:}}} {.clrSTR + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrSTR) -w 20}} {.labVAR .labSTR T 1 1 {-st e -pady 3 -padx 3} {-t {Color of variables:}}} {.clrVAR + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrVAR) -w 20}} {.labCMN .labVAR T 1 1 {-st e -pady 3 -padx 3} {-t {Color of comments:}}} {.clrCMN + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrCMN) -w 20}} {.labPROC .labCMN T 1 1 {-st e -pady 3 -padx 3} {-t {Color of proc/methods:}}} {.clrPROC + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrPROC) -w 20}} {.labOPT .labPROC T 1 1 {-st e -pady 3 -padx 3} {-t {Color of options:}}} {.clrOPT + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrOPT) -w 20}} {.labBRA .labOPT T 1 1 {-st e -pady 3 -padx 3} {-t {Color of brackets:}}} {.clrBRA + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,clrBRA) -w 20}} {fraTab2.scf.FraDefClr1 .labBRA T 1 2 {-st nsew -pady 3}} {.but - - 1 1 {-st w -padx 0} {-t Standard -com {alited::pref::Tcl_Default 0}}} {.but1 + L 1 1 {-st w -padx 8} {-t {Standard 2} -com {alited::pref::Tcl_Default 1}}} {.but2 + L 1 1 {-st w -padx 0} {-t {Standard 3} -com {alited::pref::Tcl_Default 2}}} {.but3 + L 1 1 {-st w -padx 8} {-t {Standard 4} -com {alited::pref::Tcl_Default 3}}} {fraTab2.scf.sehclr fraTab2.scf.FraDefClr1 T 1 2 {-pady 3}} {fraTab2.scf.fra2 + T 1 2 {-st nsew -pady 5}} {.lab - - - - {pack -side left -anchor ne -pady 0 -padx 3} {-t {Code snippet:}}} {.TexSample - - - - {pack -side left -fill both -expand 1} {-h 7 -w 48 -afteridle alited::pref::UpdateSyntaxTab -tabnext {*.texTclKeys *.but3}}} {.sbv + L - - {pack -side right}} {fraTab2.scf.fra3 fraTab2.scf.fra2 T 1 2 {-st nsew -pady 3}} {.labAddKeys - - - - {pack -side left -anchor ne -pady 0 -padx 3} {-t {Your commands:}}} {.TexTclKeys - - - - {pack -side left -fill both -expand 1} {-h 3 -w 48 -wrap word -tabnext {alited::Tnext *.texSample}}} {.sbv + L - - {pack -side right}} } }
Serves to layout "C/C++ syntax" tab.
proc ::alited::pref::Edit_Tab3 {} { # Serves to layout "C/C++ syntax" tab. return { {v_ - - 1 1} {FraTab3 + T 1 1 {-st nsew -cw 1 -rw 1}} {fraTab3.scf - - 1 1 {pack -fill both -expand 1} {-mode y}} {.labExt - - 1 1 {-st e -pady 3 -padx 3} {-t {C/C++ files' extensions:}}} {.entExt + L 1 1 {-st swe -pady 3} {-tvar ::alited::al(ClangExts) -w 47}} {.labCOM2 .labExt T 1 1 {-st e -pady 3 -padx 3} {-t {Color of C key words:}}} {.clrCOM2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrCOM) -w 20}} {.labCOMTK2 .labCOM2 T 1 1 {-st e -pady 3 -padx 3} {-t {Color of C++ key words:}}} {.clrCOMTK2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrCOMTK) -w 20}} {.labSTR2 .labCOMTK2 T 1 1 {-st e -pady 3 -padx 3} {-t {Color of strings:}}} {.clrSTR2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrSTR) -w 20}} {.labVAR2 .labSTR2 T 1 1 {-st e -pady 3 -padx 3} {-t {Color of punctuation:}}} {.clrVAR2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrVAR) -w 20}} {.labCMN2 .labVAR2 T 1 1 {-st e -pady 3 -padx 3} {-t {Color of comments:}}} {.clrCMN2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrCMN) -w 20}} {.labPROC2 .labCMN2 T 1 1 {-st e -pady 3 -padx 3} {-t {Color of return/goto:}}} {.clrPROC2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrPROC) -w 20}} {.labOPT2 .labPROC2 T 1 1 {-st e -pady 3 -padx 3} {-t {Color of your key words:}}} {.clrOPT2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrOPT) -w 20}} {.labBRA2 .labOPT2 T 1 1 {-st e -pady 3 -padx 3} {-t {Color of brackets:}}} {.clrBRA2 + L 1 1 {-st sw -pady 3} {-tvar ::alited::al(ED,CclrBRA) -w 20}} {fraTab3.scf.FraDefClr2 .labBRA2 T 1 2 {-st nsew -pady 3}} {.but - - 1 1 {-st w -padx 0} {-t Standard -com {alited::pref::C_Default 0}}} {.but1 + L 1 1 {-st w -padx 8} {-t {Standard 2} -com {alited::pref::C_Default 1}}} {.but2 + L 1 1 {-st w -padx 0} {-t {Standard 3} -com {alited::pref::C_Default 2}}} {.but3 + L 1 1 {-st w -padx 8} {-t {Standard 4} -com {alited::pref::C_Default 3}}} {fraTab3.scf.sehclr fraTab3.scf.fraDefClr2 T 1 2 {-pady 3}} {fraTab3.scf.fra2 + T 1 2 {-st nsew -pady 5}} {.lab - - - - {pack -side left -anchor ne -pady 0 -padx 3} {-t {Code snippet:}}} {.TexCSample - - - - {pack -side left -fill both -expand 1} {-h 8 -w 48 -wrap word -tabnext {*.texCKeys *.but3}}} {.sbv + L - - {pack -side right}} {fraTab3.scf.fra3 fraTab3.scf.fra2 T 1 2 {-st nsew -pady 3}} {.lab - - - - {pack -side left -anchor ne -pady 0 -padx 3} {-t {Your key words:}}} {.TexCKeys - - - - {pack -side left -fill both -expand 1} {-h 3 -w 48 -wrap word -tabnext {alited::Tnext *.texCSample}}} {.sbv + L - - {pack -side right}} } }
Serves to layout "Plain texts" tab.
proc ::alited::pref::Edit_Tab4 {} { # Serves to layout "Plain texts" tab. return { {v_ - - 1 1} {FraTab4 + T 1 1 {-st nsew -cw 1 -rw 1}} {fraTab4.scf - - 1 1 {pack -fill both -expand 1} {-mode y}} {.labExt - - 1 1 {-st e -pady 3 -padx 3} {-t {Plain texts' extensions:}}} {.entExt + L 1 1 {-st swe -pady 3} {-tvar ::alited::al(TextExts) -w 50}} {.seh .labExt T 1 10 {-pady 3}} {.but + T 1 1 {-st w} {-t Standard -com alited::pref::Text_Default -tabnext alited::Tnext}} } }
Handles separators of bar-menu.
| if yes, displays the widgets of bar-menu settings; optional, default yes |
proc ::alited::pref::Em_ShowAll {{upd yes}} { # Handles separators of bar-menu. # upd - if yes, displays the widgets of bar-menu settings. fetchVars for {set i 0} {$i<$em_Num} {incr i} { if {![info exists em_inf($i)]} { lassign {} em_inf($i) em_mnu($i) em_ico($i) } if {$em_ico($i) eq {none}} {set em_ico($i) {}} if {$upd} { [$obPrf ButMnu$i] configure -text $em_mnu($i) set ico [$obPrf OpcIco$i] if {[set k [lsearch $listIcons [$ico cget -text]]]>-1} { set img [::apave::iconImage [lindex $listIcons $k]] set cmpd left } else { set img alimg_none set cmpd right } $ico configure -image $img -compound $cmpd } } if {$upd} ScrollRuns }
Serves to layout "Tools/e_menu" tab.
Exchanges two run items.
| 1st item |
| 2nd item |
proc ::alited::pref::ExchangeRuns {f1 f2} { # Exchanges two run items. # f1 - 1st item # f2 - 2nd item fetchVars set ico1 $em_ico($f2) set mnu1 $em_mnu($f2) set inf1 $em_inf($f2) set em_ico($f2) $em_ico($f1) set em_mnu($f2) $em_mnu($f1) set em_inf($f2) $em_inf($f1) set em_ico($f1) $ico1 set em_mnu($f1) $mnu1 set em_inf($f1) $inf1 Em_ShowAll set foc [focus] if {$foc eq [$obPrf OpcIco$f1]} {focus [$obPrf OpcIco$f2] } elseif {$foc eq [$obPrf ButMnu$f1]} {focus [$obPrf ButMnu$f2] } else {focus [$obPrf ChbMT$f2]} }
Delivers namespace variables to a caller.
proc ::alited::pref::fetchVars {} { # Delivers namespace variables to a caller. uplevel 1 { namespace upvar ::alited al al variable obPrf variable win variable geo variable data variable keys variable prevkeys variable savekeys variable arrayTab variable curTab variable oldTab variable opcThemes variable opc1 variable opcColors variable opcc variable opcc2 variable em_Num variable em_mnu variable em_ico variable em_inf variable em_Icons variable listIcons variable listMenus variable stdkeys variable StdkeysSize variable locales variable preview } }
Sets a bg color of tab canvas.
| canvas' path |
| yes for selected tab; optional, default no |
proc ::alited::pref::fillCan {w {selected no}} { # Sets a bg color of tab canvas. # w - canvas' path # selected - yes for selected tab fetchVars catch {$w delete $data(CANVAS,$w)} lassign [$obPrf csGet] - - - bg selbg - - - - hotbg if {$selected} { set bg $hotbg $w configure -highlightbackground $hotbg } else { $w configure -highlightbackground $bg } set data(CANVAS,$w) [$w create rectangle {0 0 10 100} -fill $bg -outline $selbg] }
Gets an index of current run.
proc ::alited::pref::FocusedRun {} { # Gets an index of current run. fetchVars set foc [focus] set fr -1 for {set i 0} {$i<$::alited::pref::em_Num} {incr i} { if {$foc in [list [$obPrf OpcIco$i] [$obPrf ButMnu$i]]} { set fr $i break } } if {$fr<0} {Message [msgcat::mc {Select any of run item}] 3} return $fr }
Serves to layout "General" tab.
proc ::alited::pref::General_Tab1 {} { # Serves to layout "General" tab. fetchVars set opcc [set opcc2 [msgcat::mc {-2: Default}]] set opcColors [list "{$opcc}"] for {set i -1; set n [apave::cs_MaxBasic]} {$i<=$n} {incr i} { if {(($i+2) % ($n/2+2)) == 0} {lappend opcColors |} set csname [$obPrf csGetName $i] lappend opcColors [list $csname] if {$i == $al(INI,CS)} {set opcc $csname} if {$i == $al(EM,CS)} {set opcc2 $csname} } set lightdark [msgcat::mc {Light / Dark}] set opcThemes [list default clam classic alt -- "{$lightdark} awlight awdark -- azure-light azure-dark -- forest-light forest-dark -- sun-valley-light sun-valley-dark -- lightbrown darkbrown -- plastik"] if {$al(IsWindows)} { lappend opcThemes -- "{[msgcat::mc {Windows themes}]} vista xpnative winnative" } if {[string first $al(THEME) $opcThemes]<0} { set opc1 [lindex $opcThemes 0] } else { set opc1 $al(THEME) } return { {v_ - - 1 1} {fra1 v_ T 1 2 {-st nsew -cw 1}} {.labTheme - - 1 1 {-st e -pady 1 -padx 3} {-t {Ttk theme:}}} {.opc1 + L 1 1 {-st sw -pady 1} {::alited::pref::opc1 ::alited::pref::opcThemes {-width 21 -compound left -image alimg_gulls -tip {-indexedtips 5 "-BALTIP {$al(MC,needcs)} -MAXEXP 1"}} {}}} {.labCS .labTheme T 1 1 {-st e -pady 1 -padx 3} {-t {Color scheme:}}} {.opc2 + L 1 1 {-st sw -pady 1} {::alited::pref::opcc ::alited::pref::opcColors {-width 21 -compound left -image alimg_color -com alited::pref::CheckCS -tip {-indexedtips 0 {$al(MC,nocs)} 2 {$al(MC,fitcs): awlight} 3 {$al(MC,fitcs): azure-light} 4 {$al(MC,fitcs): forest-light} 5 {$al(MC,fitcs): sun-valley-light} 6 {$al(MC,fitcs): lightbrown} 26 {$al(MC,fitcs): sun-valley-dark} 27 {$al(MC,fitcs): awdark} 28 {$al(MC,fitcs): azure-dark} 29 {$al(MC,fitcs): forest-dark} 30 {$al(MC,fitcs): sun-valley-dark} 31 {$al(MC,fitcs): darkbrown} }} {alited::pref::opcToolPre %a}}} {.butOK + L 1 1 {-padx 20} {-t "$al(MC,test)" -com {alited::pref::CheckTheming yes yes}}} {.labHue .labCS T 1 1 {-st e -pady 1 -padx 3} {-t Tint:}} {.spxHue + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(INI,HUE) -from -50 -to 50 -increment 5 -tip {$al(MC,hue)}}} {.labCurw .labHue T 1 1 {-st e -pady 1 -padx 3} {-t {Cursor width:}}} {.spxCurw + L 1 1 {-st sw -pady 1 -padx 3} {-tvar ::alited::al(CURSORWIDTH) -from 1 -to 8}} {.labCC + L 1 1 {-st we -pady 1 -padx 3} {-t {Color of cursor:}}} {.clrCC + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(CURSORCOLOR) -w 14}} {seh_ fra1 T 1 2 {-pady 4}} {fra2 + T 1 2 {-st nsew -cw 1}} {.labLocal - - 1 1 {-st e -pady 1 -padx 3} {-t {Preferable locale:} -tip {$al(MC,locale)}}} {.cbxLocal + L 1 1 {-st sew -pady 1 -padx 3} {-tvar ::alited::al(LOCAL) -values {$::alited::pref::locales} -w 4 -tip {$al(MC,locale)} -state readonly -selcombobox alited::pref::GetLocaleImage -afteridle alited::pref::GetLocaleImage}} {.LabLocales + L 1 7} {.labFon .labLocal T 1 1 {-st e -pady 1 -padx 3} {-t Font:}} {.fonTxt1 + L 1 7 {-st sw -pady 1 -padx 3} {-tvar ::alited::al(FONT) -w 50}} {.labFsz1 .labFon T 1 1 {-st e -pady 1 -padx 3} {-t {Small font size:}}} {.spxFsz1 + L 1 1 {-st sw -pady 1 -padx 3} {-tvar ::alited::al(FONTSIZE,small) -from 6 -to 72}} {.labFsz2 .labFsz1 T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,middlefont)}}} {.spxFsz2 + L 1 1 {-st sw -pady 1 -padx 3} {-tvar ::alited::al(FONTSIZE,std) -from 7 -to 72}} {seh_2 fra2 T 1 2 {-pady 4}} {lab + T 1 2 {-st w -pady 4 -padx 3} {-t Notes:}} {fra3 + T 1 2 {-st nsew -rw 1 -cw 1}} {.TexNotes - - - - {pack -side left -expand 1 -fill both -padx 3} {-h 20 -w 70 -wrap word -tabnext {alited::Tnext *.spxCurw} -tip {-BALTIP {$al(MC,notes)} -MAXEXP 1}}} {.sbv + L - - {pack -side left}} } }
Serves to layout "General/Saving" tab.
proc ::alited::pref::General_Tab2 {} { # Serves to layout "General/Saving" tab. return { {v_ - - 1 1} {fra v_ T 1 1 {-st nsew -cw 1 -rw 1}} {fra.scf - - 1 1 {pack -fill both -expand 1} {-mode y}} {.labport - - 1 1 {-st e -pady 1 -padx 3} {-t "Port to listen alited:"}} {.cbxport + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(comm_port) -values {$al(comm_port_list)} -w 8 -tip "The empty value allows\nmultiple alited apps."}} {.labConf .labport T 1 1 {-st e -pady 1 -padx 3} {-t "Confirm exit:"}} {.spxConf + L 1 1 {-st sw -pady 1 -padx 3} {-tvar ::alited::al(INI,confirmexit) -from 0 -to 60 -tip {"> 1" : N sec.}}} {.seh1 .labConf T 1 4 {-st ew -pady 5}} {.labS + T 1 1 {-st e -pady 1 -padx 3} {-t "Save configuration on"}} {.labSonadd + T 1 1 {-st e -pady 1 -padx 3} {-t "opening a file:"}} {.swiOnadd + L 1 1 {-st sw -pady 1 -padx 3} {-var ::alited::al(INI,save_onadd)}} {.labSonclose .labSonadd T 1 1 {-st e -pady 1 -padx 3} {-t "closing a file:"}} {.swiOnclose + L 1 1 {-st sw -pady 1 -padx 3} {-var ::alited::al(INI,save_onclose)}} {.labSonsave .labSonclose T 1 1 {-st e -pady 1 -padx 3} {-t "saving a file:"}} {.swiOnsave + L 1 1 {-st sw -pady 1 -padx 3} {-var ::alited::al(INI,save_onsave)}} {.labSave .labSonsave T 1 1 {-st e -pady 1 -padx 3} {-t "Save before bar-menu runs:"}} {.rad1 + L 1 1 {-st sw -padx 3} {-var ::alited::al(EM,save) -value 1 -t "$al(MC,allfiles)"}} {.rad2 + L 1 1 {-st sw -padx 3} {-var ::alited::al(EM,save) -value 2 -t "$al(MC,currfile)"}} {.rad3 + L 1 1 {-st sw -padx 3} {-var ::alited::al(EM,save) -value 3 -t "$al(MC,none)"}} {.seh3 .labSave T 1 4 {-st ew -pady 5}} {.labRecnt + T 1 1 {-st e -pady 1 -padx 3} {-t "'Recent Files' length:"}} {.spxRecnt + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(INI,RECENTFILES) -from 10 -to 50}} {.labMaxLast .labRecnt T 1 1 {-st e -pady 1 -padx 3} {-t "'Last Visited' length:"}} {.spxMaxLast + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(FAV,MAXLAST) -from 10 -to 100}} {.labMaxFiles .labMaxLast T 1 1 {-st e -pady 1 -padx 3} {-t "Maximum of project files:"}} {.spxMaxFiles + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(MAXFILES) -from 1000 -to 9999}} {.seh4 .labMaxFiles T 1 4 {-st ew -pady 5}} {.labBackup + T 1 1 {-st e -pady 1 -padx 3} {-t "Back up files to a project's subdirectory:"}} {.cbxBackup + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(BACKUP) -values {{} .bak} -state readonly -w 6 -tip "A subdirectory of projects where backup copies of files will be saved to.\nSet the field blank to cancel the backup." -afteridle alited::pref::CbxBackup -selcombobox alited::pref::CbxBackup}} {.LabMaxBak + L 1 1 {-st e -pady 1 -padx 1} {-t " Maximum:"}} {.SpxMaxBak + L 1 1 {-st sw -pady 1 -padx 1} {-tvar ::alited::al(MAXBACKUP) -from 1 -to 99 -tip {$al(MC,maxbak)}}} {.labBell .labBackup T 1 1 {-st e -pady 1 -padx 3} {-t "Bell at warnings:"}} {.swiBell + L 1 1 {-st sw -pady 1 -padx 3} {-var ::alited::al(INI,belltoll) -tabnext alited::Tnext}} } }
Serves to layout "General/Projects" tab.
proc ::alited::pref::General_Tab3 {} { # Serves to layout "General/Projects" tab. return { {v_ - - 1 10} {fra2 v_ T 1 2 {-st nsew -cw 1}} {.labDef - - 1 1 {-st e -pady 1 -padx 3} {-t {Default values for new projects:}}} {.swiDef + L 1 1 {-st sw -pady 3 -padx 3} {-var ::alited::al(PRJDEFAULT) -com alited::pref::CheckUseDef -afteridle alited::pref::CheckUseDef}} {.seh .labDef T 1 10 {-st ew -pady 3 -padx 3}} {.labIgn + T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,Ign:)}}} {.EntIgn + L 1 9 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(DEFAULT,prjdirign) -w 50}} {.labEOL .labIgn T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,EOL:)}}} {.CbxEOL + L 1 1 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(DEFAULT,prjEOL) -values {{} LF CR CRLF} -state readonly -w 9}} {.labIndent .labEOL T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,indent:)}}} {.SpxIndent + L 1 1 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(DEFAULT,prjindent) -from 0 -to 8 -com ::alited::pref::CheckIndent}} {.ChbIndAuto + L 1 1 {-st sw -pady 3 -padx 3} {-var ::alited::al(DEFAULT,prjindentAuto) -t {$al(MC,indentAuto)}}} {.labRedunit .labIndent T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,redunit)}}} {.SpxRedunit + L 1 1 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(DEFAULT,prjredunit) -from $al(minredunit) -to 100}} {.labMult .labRedunit T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,multiline)} -tip {$al(MC,notrecomm)}}} {.SwiMult + L 1 1 {-st sw -pady 3 -padx 3} {-var ::alited::al(DEFAULT,prjmultiline) -tip {$al(MC,notrecomm)}}} {.labTrWs .labMult T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,trailwhite)}}} {.SwiTrWs + L 1 1 {-st sw -pady 1 -padx 3} {-var ::alited::al(DEFAULT,prjtrailwhite) -tabnext alited::Tnext}} } }
Gets a color scheme's index from opcc / opcc2 variable.
| {} for opcc, {2} for opcc2; optional, default "" |
proc ::alited::pref::GetCS {{ncc {}}} { # Gets a color scheme's index from *opcc* / *opcc2* variable. # ncc - {} for opcc, {2} for opcc2 fetchVars return [scan [set opcc$ncc] %d:] }
Gets a list of available (not engaged) key combinations.
| index of combobox that will get the list as -values option |
proc ::alited::pref::GetKeyList {nk} { # Gets a list of available (not engaged) key combinations. # nk - index of combobox that will get the list as -values option fetchVars RegisterKeys [$obPrf CbxKey$nk] configure -values [alited::keys::VacantList] }
proc ::alited::pref::GetLocaleImage {} { fetchVars [$obPrf LabLocales] configure -image ::alited::pref::LOC$al(LOCAL) }
Shows a help on a current tab.
proc ::alited::pref::Help {} { # Shows a help on a current tab. fetchVars set sel [lindex [split [$win.fra.fraR.$curTab select] .] end] alited::Help $win "-${curTab}-$sel" }
Gets key settings at opening "Preferences" dialogue.
proc ::alited::pref::IniKeys {} { # Gets key settings at opening "Preferences" dialogue. fetchVars # default settings dict for {k info} $stdkeys { set keys($k) [set prevkeys($k) [set savekeys($k) [lindex $info 1]]] } # new settings foreach kitem [alited::keys::EngagedList preference] { lassign $kitem key comi lassign $comi com k set keys($k) [set prevkeys($k) [set savekeys($k) $key]] } }
Creates flag images to display at "Preferable locale".
proc ::alited::pref::InitLocales {} { # Creates flag images to display at "Preferable locale". fetchVars if {[llength $locales]} return set imd [file join $::alited::DATADIR img] set locales [list] foreach lm [glob -nocomplain [file join $imd ??.png]] { set loc [file rootname [file tail $lm]] image create photo ::alited::pref::LOC$loc -file $lm lappend locales $loc } if {![file exists [file join $::alited::MSGSDIR $al(LOCAL).msg]]} { set al(LOCAL) en } set locales [lsort $locales] }
Updates and initializes color fields.
| {} for Tcl, {2} for C/C++ |
proc ::alited::pref::InitSyntax {lng} { # Updates and initializes color fields. # lng - {} for Tcl, {2} for C/C++ fetchVars foreach nam {COM COMTK STR VAR CMN PROC OPT BRA} { set ent [$obPrf Entclr$nam$lng] ;# method's name, shown by -debug attribute set lab [string map [list .entclr .labclr] $ent] ;# colored label $lab configure -background [$ent get] ::apave::bindToEvent $ent <FocusIn> alited::pref::UpdateSyntaxTab $lng ::apave::bindToEvent $ent <FocusOut> alited::pref::UpdateSyntaxTab $lng } }
Initializes syntax stuff for C/C++.
| highlighting colors |
proc ::alited::pref::InitSyntaxC {colors} { # Initializes syntax stuff for C/C++. # colors - highlighting colors fetchVars set tex [$obPrf TexCSample] if {[string trim [$tex get 1.0 end]] eq {}} { $obPrf displayText $tex {static sample(const char *ptr) { char *tx, *st; tx = get_text(); // inline comment st = get_string(); //! TODO if (strstr(tx,st)!=tx) return FALSE; /* it's okay */ tx += strlen(st); ptr = strstr(tx+1,"My string"); return TRUE }}} set wk [$obPrf TexCKeys] ::apave::bindToEvent $wk <FocusOut> alited::pref::UpdateSyntaxTab 2 set keywords [string trim [$wk get 1.0 end]] alited::SyntaxHighlight c $tex $colors [GetCS] -keywords $keywords }
Initializes syntax stuff for Tcl.
| highlighting colors |
proc ::alited::pref::InitSyntaxTcl {colors} { # Initializes syntax stuff for Tcl. # colors - highlighting colors fetchVars set tex [$obPrf TexSample] lassign [$obPrf csGet] - - - - - - - - tfgD bclr $tex configure -highlightbackground $tfgD -highlightcolor $bclr set texC [$obPrf TexCSample] $texC configure -highlightbackground $tfgD -highlightcolor $bclr if {[string trim [$tex get 1.0 end]] eq {}} { $obPrf displayText $tex {proc foo {args} { # Tcl code to test colors. set var "(Multiline string) Args=$args" winfo interps -displayof [lindex $args 0] return $var ;#! text of TODO }}} set wk [$obPrf TexTclKeys] ::apave::bindToEvent $wk <FocusOut> alited::pref::UpdateSyntaxTab set keywords [string trim [$wk get 1.0 end]] alited::SyntaxHighlight tcl $tex $colors [GetCS] -keywords $keywords }
Gets a key accelerator for a combobox of keys, bound to an action.
| index of combobox |
| default key combination |
proc ::alited::pref::KeyAccelerator {nk defk} { # Gets a key accelerator for a combobox of keys, bound to an action. # nk - index of combobox # defk - default key combination set acc [BindKey $nk - $defk] return [::apave::KeyAccelerator $acc] }
Gets a full list of key accelerators,
proc ::alited::pref::KeyAccelerators {} { # Gets a full list of key accelerators, fetchVars dict for {k info} $stdkeys { set al(acc_$k) [KeyAccelerator $k [lindex $info 1]] } }
Serves to layout "Keys" tab.
proc ::alited::pref::Keys_Tab1 {} { # Serves to layout "Keys" tab. return { {after idle} {v_ - - 1 1} {fra + T 1 1 {-st nsew -cw 1 -rw 1}} {fra.scf - - 1 1 {pack -fill both -expand 1} {-mode y}} {tcl { set pr - for {set i 0} {$i<$::alited::pref::StdkeysSize} {incr i} { set lab "lab$i" set cbx "CbxKey$i" lassign [dict get $::alited::pref::stdkeys $i] text key set lwid ".$lab $pr T 1 1 {-st e -pady 1 -padx 3} {-t \"$text\"}" %C $lwid if {($i+1)==$::alited::pref::StdkeysSize} { set pr {-tabnext alited::Tnext} } else { set pr {} } set lwid ".$cbx + L 1 1 {-st we} {-tvar ::alited::pref::keys($i) -postcommand {::alited::pref::GetKeyList $i} -selcombobox {::alited::pref::SelectKey $i} -state readonly -h 16 -w 20 $pr}" %C $lwid set pr .$lab } }} } }
Creates a main frame of the dialogue.
proc ::alited::pref::MainFrame {} { # Creates a main frame of the dialogue. fetchVars $obPrf untouchWidgets *.cannbk* return { {fraL - - 1 1 {-st nws -rw 2}} {.ButHome - - 1 1 {-st we -pady 0} {-t "General" -com "alited::pref::Tab nbk" -style TButtonWest}} {.Cannbk + L 1 1 {-st ns} {-w 2 -h 10 -highlightthickness 1 -afteridle {alited::pref::fillCan %w}}} {.ButChange .butHome T 1 1 {-st we -pady 1} {-t "Editor" -com "alited::pref::Tab nbk2" -style TButtonWest}} {.Cannbk2 + L 1 1 {-st ns} {-w 2 -h 10 -highlightthickness 1 -afteridle {alited::pref::fillCan %w}}} {.ButCategories .butChange T 1 1 {-st we -pady 0} {-t "Units" -com "alited::pref::Tab nbk3" -style TButtonWest}} {.Cannbk3 + L 1 1 {-st ns} {-w 2 -h 10 -highlightthickness 1 -afteridle {alited::pref::fillCan %w}}} {.ButActions .butCategories T 1 1 {-st we -pady 1} {-t "Templates" -com "alited::pref::Tab nbk4" -style TButtonWest}} {.Cannbk4 + L 1 1 {-st ns} {-w 2 -h 10 -highlightthickness 1 -afteridle {alited::pref::fillCan %w}}} {.ButKeys .butActions T 1 1 {-st we -pady 0} {-image alimg_kbd -compound left -t "Keys" -com "alited::pref::Tab nbk5" -style TButtonWest}} {.Cannbk5 + L 1 1 {-st ns} {-w 2 -h 10 -highlightthickness 1 -afteridle {alited::pref::fillCan %w}}} {.ButTools .butKeys T 1 1 {-st we -pady 1} {-t "Tools" -com "alited::pref::Tab nbk6" -style TButtonWest}} {.Cannbk6 + L 1 1 {-st ns} {-w 2 -h 10 -highlightthickness 1 -afteridle {alited::pref::fillCan %w}}} {.v_ .butTools T 1 1 {-st ns} {-h 30}} {fraR fraL L 1 1 {-st nsew -cw 1}} {fraR.nbk - - - - {pack -side top -expand 1 -fill both} { f1 {-t View} f2 {-t Saving} f3 {-t Projects} }} {fraR.nbk2 - - - - {pack forget -side top} { f1 {-t Editor} f2 {-t "Tcl syntax"} f3 {-t "C/C++ syntax"} f4 {-t "Plain text"} }} {fraR.nbk3 - - - - {pack forget -side top} { f1 {-t Units} }} {fraR.nbk4 - - - - {pack forget -side top} { f1 {-t Templates} }} {fraR.nbk5 - - - - {pack forget -side top} { f1 {-t Keys} }} {fraR.nbk6 - - - - {pack forget -side top} { f1 {-t Common} f2 {-t e_menu} f3 {-t bar-menu} f4 {-t Tkcon} }} {seh fraL T 1 2 {-st nsew -pady 2}} {fraB + T 1 2 {-st nsew} {-padding {2 2}}} {.ButHelp - - - - {pack -side left} {-t {$::alited::al(MC,help)} -tip F1 -com ::alited::pref::Help}} {.LabMess - - - - {pack -side left -expand 1 -fill both -padx 8}} {.ButOK - - - - {pack -side left -anchor s -padx 2} {-t Save -com ::alited::pref::Ok}} {.butCancel - - - - {pack -side left -anchor s} {-t Cancel -com ::alited::pref::Cancel}} } }
Displays a message in statusbar of preferences dialogue.
| message |
| mode of Message; optional, default 2 |
proc ::alited::pref::Message {msg {mode 2}} { # Displays a message in statusbar of preferences dialogue. # msg - message # mode - mode of Message fetchVars alited::Message $msg $mode [$obPrf LabMess] }
Handler of "OK" button.
| Optional arguments. |
proc ::alited::pref::Ok {args} { # Handler of "OK" button. fetchVars if {![CheckOk]} return alited::CloseDlg if {$al(INI,confirmexit)>1} { set timo "-timeout {$al(INI,confirmexit) ButOK}" } else { set timo {} } set ans [alited::msg okcancel info $al(MC,restart) OK -centerme $win {*}$timo] if {$ans} { # check options that can make alited unusable if {![::apave::intInRange $al(INI,HUE) -50 50]} {set al(INI,HUE) 0} if {![::apave::intInRange $al(FONTSIZE,small) 6 72]} {set al(FONTSIZE,small) 9} if {![::apave::intInRange $al(FONTSIZE,std) 7 72]} {set al(FONTSIZE,std) 10} if {![::apave::intInRange $al(INI,RECENTFILES) 10 50]} {set al(INI,RECENTFILES) 16} if {![::apave::intInRange $al(FAV,MAXLAST) 10 100]} {set al(FAV,MAXLAST) 100} if {![::apave::intInRange $al(MAXFILES) 1000 9999]} {set al(MAXFILES) 5000} if {![::apave::intInRange $al(INI,barlablen) 10 100]} {set al(INI,barlablen) 16} if {![::apave::intInRange $al(INI,bartiplen) 10 100]} {set al(INI,bartiplen) 32} if {![::apave::intInRange $al(CURSORWIDTH) 1 8]} {set al(CURSORWIDTH) 2} set al(THEME) $opc1 set al(INI,CS) [GetCS] if {![string is integer -strict $al(INI,CS)]} {set al(INI,CS) $al(defCS)} set al(EM,CS) [GetCS 2] if {![string is integer -strict $al(EM,CS)]} {set al(EM,CS) $al(defCS)} set al(ED,TclKeyWords) [[$obPrf TexTclKeys] get 1.0 {end -1c}] set al(ED,TclKeyWords) [string map [list \n { }] $al(ED,TclKeyWords)] set al(ED,CKeyWords) [[$obPrf TexCKeys] get 1.0 {end -1c}] set al(ED,CKeyWords) [string map [list \n { }] $al(ED,CKeyWords)] set al(BACKUP) [string trim $al(BACKUP)] catch {set al(TCLLIST) [lreplace $al(TCLLIST) 32 end]} set al(EM,TclList) $al(EM,Tcl) foreach tcl $al(TCLLIST) { if {[::apave::lsearchFile [split $al(EM,TclList) \t] $tcl]<0} { append al(EM,TclList) \t $tcl } } set al(EM,TclList) [string trim $al(EM,TclList)] catch {set al(TTLIST) [lreplace $al(TTLIST) 32 end]} set al(EM,tt=List) $al(EM,tt=) foreach tt $al(TTLIST) { if {[::apave::lsearchFile [split $al(EM,tt=List) \t] $tt]<0} { append al(EM,tt=List) \t $tt } } set al(EM,tt=List) [string trim $al(EM,tt=List)] catch {set al(WTLIST) [lreplace $al(WTLIST) 32 end]} set al(EM,wt=List) $al(EM,wt=) foreach wt $al(WTLIST) { if {$wt ni [split $al(EM,wt=List) \t]} {append al(EM,wt=List) \t $wt} } set al(EM,wt=List) [string trim $al(EM,wt=List)] set plst [lsort [list {} $al(comm_port) {*}$al(comm_port_list)]] set al(comm_port_list) [list] foreach pt $plst { if {$pt ni $al(comm_port_list)} {lappend al(comm_port_list) $pt} if {[llength $al(comm_port_list)]>32} break } set al(EM,DiffTool) [file join {*}[file split $al(EM,DiffTool)]] set al(RE,proc) [string trimright $al(RE,proc)] $obPrf res $win 1 alited::Exit - 1 no } }
Gets an item for icon list of a bar-menu action.
| contains a name of current icon |
proc ::alited::pref::opcIcoPre {args} { # Gets an item for icon list of a bar-menu action. # args - contains a name of current icon fetchVars lassign $args a if {[set i [lsearch $listIcons $a]]>-1} { set img [::apave::iconImage [lindex $listIcons $i]] set res "-image $img -compound left " } else { set res {} } append res "-label " [alited::TextIcon $a] }
Gets colors for "Color schemes" items.
| a color scheme's index and name, separated by ":" |
proc ::alited::pref::opcToolPre {args} { # Gets colors for "Color schemes" items. # args - a color scheme's index and name, separated by ":" lassign $args a set a [string trim $a :] if {[string is integer $a]} { lassign [obj csGet $a] - fg - bg return "-background $bg -foreground $fg" } else { return {} } }
Looks for ownCS option.
proc ::alited::pref::OwnCS {} { # Looks for ownCS option. fetchVars if {$al(EM,exec)} {set st normal} {set st disabled; set al(EM,ownCS) no} [$obPrf SwiCS] configure -state $st if {$al(EM,ownCS)} {set st normal} {set st disabled} [$obPrf OpcCS] configure -state $st }
Selects e_menu's action for a "bar-menu" item.
| index of "bar-menu" item |
proc ::alited::pref::PickMenuItem {it} { # Selects e_menu's action for a "bar-menu" item. # it - index of "bar-menu" item fetchVars ::alited::Source_e_menu set w [$obPrf ButMnu$it] set X [winfo rootx $w] set Y [winfo rooty $w] set res [::em::main -prior 1 -modal 1 -remain 0 -noCS 1 {*}[alited::tool::EM_Options "pk=yes dk=dock o=-1 t=1 g=+[incr X 5]+[incr Y 25] mp=1"]] lassign $res menu idx item if {$item ne {}} { set item1 [lindex [alited::tool::EM_Structure $menu] $idx-1 1] lassign [split $item1 -\n] -> item2 item3 if {$item2 ne $item3 && [string match *.em $item2]} { append item2 ": $item3" ;# it's a menu call title set idx - ;# to open the whole menu } $w configure -text $item2 set em_mnu($it) [::apave::NormalizeName $item2] set em_inf($it) [list [file tail $menu] $idx $item2] ScrollRuns } focus -force $w }
Handles clicking on message label.
proc ::alited::pref::ProcMessage {} { # Handles clicking on message label. fetchVars set msg [baltip cget [$obPrf LabMess] -text] Message $msg 3 }
Adds key bindings to keys array.
proc ::alited::pref::RegisterKeys {} { # Adds key bindings to keys array. fetchVars alited::keys::Delete preference for {set k 0} {$k<$StdkeysSize} {incr k} { alited::keys::Add preference $k [set keys($k)] "alited::pref::BindKey $k {%k}" } }
Returns a list of icons already engaged by alited.
Returns a list of icons already engaged by alited.
proc ::alited::pref::ReservedIcons {} { # Returns a list of icons already engaged by alited. list file OpenFile box SaveFile saveall undo redo help replace run other ok color }
Restores original settings.
proc ::alited::pref::RestoreSettings {} { # Restores original settings. fetchVars foreach o [SavedOptions] { catch {set al($o) $data($o)} } dict for {k info} $stdkeys { set keys($k) $savekeys($k) SelectKey $k } for {set i 0} {$i<$em_Num} {incr i} { catch { set em_mnu($i) $data(em_mnu,$i) set em_ico($i) $data(em_ico,$i) set em_inf($i) $data(em_inf,$i) } } if {[info exists ::em::geometry]} {set ::em::geometry $al(EM,geometry)} }
Prepares and layouts "Tools/bar-menu" tab.
| a tab to open (saved at previous session) or {} |
proc ::alited::pref::Runs_Tab {tab} { # Prepares and layouts "Tools/bar-menu" tab. # tab - a tab to open (saved at previous session) or {} fetchVars # get a list of all available icons for "bar-menu" actions set listIcons [::apave::iconImage] set em_Icons [list] set n [llength $listIcons] set icr 0 set ncr 0 for {set i 0} {$i<($n+43)} {incr i} { if {$icr && ($icr % 13) == 0} {lappend em_Icons |} set ii [expr {$icr-$ncr}] if {$i<$n} { set ico [lindex $listIcons $i] if {$ico in [ReservedIcons]} continue lappend em_Icons $ico incr ncr } elseif {$ii<10} { lappend em_Icons $ii } else { set ico [string index [TextIcons] [expr {$ii -10}]] lappend em_Icons [alited::TextIcon $ico] } incr icr } Em_ShowAll no # get a layout of "bar-menu" tab set res { {v_ - - 1 1} {fra + T 1 1 {-st nsew -cw 1 -rw 1 -padx 8} {-afteridle ::alited::pref::Em_ShowAll}} {fra.fraButs - - 1 1 {pack -anchor w -pady 4}} {.btTUp - - - - {pack -side left} {-image alimg_up -com ::alited::pref::UpRun -tip {Move an item up}}} {.btTDown - - - - {pack -side left} {-image alimg_down -com ::alited::pref::DownRun -tip {Move an item down}}} {.btTDelRun - - - - {pack -side left} {-image alimg_delete -com ::alited::pref::DelRun -tip {Delete an item}}} {fra.ScfRuns - - 1 1 {pack -fill both -expand 1}} {tcl { set prt "- -" for {set i 0} {$i<$::alited::pref::em_Num} {incr i} { set nit [expr {$i+1}] set lwid ".OpcIco$i $prt 1 1 {-st nsw} {::alited::pref::em_ico($i) ::alited::pref::em_Icons {-width 9 -com alited::pref::Em_ShowAll -tip {{An icon puts the run into the toolbar.\nBlank or 'none' excludes it from the toolbar.}}} {alited::pref::opcIcoPre %a}}" %C $lwid set lwid ".ButMnu$i + L 1 1 {-st sw -pady 1 -padx 8} {-t {$::alited::pref::em_mnu($i)} -com {alited::pref::PickMenuItem $i} -style TButtonWest -tip {{The run item for the menu and/or the toolbar.\nSelect it from the e_menu items.}}}" %C $lwid set prt ".OpcIco$i T" }} } } if {$tab eq {Emenu_Tab} || ($oldTab ne {} && [string match *nbk6.f3 $arrayTab($oldTab)])} { # "Run" items should be displayed immediately return $res } # "Run" items can be created with a little delay # imperceptible for a user, saving his/her time return [linsert $res 0 {after 500}] }
Returns a list of names of main settings.
Returns a list of names of main settings.
proc ::alited::pref::SavedOptions {} { # Returns a list of names of main settings. fetchVars return [array names al] }
Saves original settings.
proc ::alited::pref::SaveSettings {} { # Saves original settings. fetchVars foreach o [SavedOptions] { set data($o) $al($o) } for {set i 0} {$i<$em_Num} {incr i} { catch { set data(em_mnu,$i) $em_mnu($i) set data(em_ico,$i) $em_ico($i) set data(em_inf,$i) $em_inf($i) } } set data(INI,CSsaved) $data(INI,CS) if {[info exists ::em::geometry]} {set ::em::geometry $al(EM,geometry)} }
Updates scrollbars of bar-menu tab because its contents may have various length.
proc ::alited::pref::ScrollRuns {} { # Updates scrollbars of bar-menu tab because its contents may have various length. fetchVars update ::apave::sframe resize [$obPrf ScfRuns] }
Handles <
| index of combobox |
proc ::alited::pref::SelectKey {nk} { # Handles <<ComboboxSelected>> event on a combobox of keys. # nk - index of combobox fetchVars alited::keys::Delete {} $prevkeys($nk) set prevkeys($nk) $keys($nk) GetKeyList $nk }
Handles changing tabs of notebooks.
| name of notebook |
| tab of notebook; optional, default "" |
| if yes, forces changing tabs; optional, default no |
| if yes, focuses 1st widget of tab; optional, default yes |
At changing the current notebook: we need to save the old selection in order to restore the selection at returning to the notebook.
proc ::alited::pref::Tab {tab {nt {}} {doit no} {focus1st yes}} { # Handles changing tabs of notebooks. # tab - name of notebook # nt - tab of notebook # doit - if yes, forces changing tabs # focus1st - if yes, focuses 1st widget of tab # At changing the current notebook: we need to save the old selection # in order to restore the selection at returning to the notebook. fetchVars foreach nbk {nbk nbk2 nbk3 nbk4 nbk5 nbk6} {fillCan [$obPrf Can$nbk]} foreach but {Home Change Categories Actions Keys Tools} { [$obPrf But$but] configure -style TButtonWest } switch $tab { nbk {set but Home} nbk2 {set but Change} nbk3 {set but Categories} nbk4 {set but Actions} nbk5 {set but Keys} nbk6 {set but Tools} } [$obPrf But$but] configure -style TButtonWestHL fillCan [$obPrf Can$tab] yes if {$tab ne $curTab || $doit} { if {$curTab ne {}} { set arrayTab($curTab) [$win.fra.fraR.$curTab select] pack forget $win.fra.fraR.$curTab } set curTab $tab pack $win.fra.fraR.$curTab -expand yes -fill both catch { if {$nt eq {}} {set nt $arrayTab($curTab)} $win.fra.fraR.$curTab select $nt } } if {$tab eq {nbk2}} { # check if a color scheme is switched light/dark - if yes, disable colors set cs [GetCS] if {$data(INI,CSsaved)!=$cs} { Tcl_Default 0 yes C_Default 0 yes UpdateSyntaxTab UpdateSyntaxTab 2 } lassign [$obPrf csGet $cs] fg - bg - - sbg sfg ibg [$obPrf TexSample] configure -fg $fg -bg $bg -selectbackground $sbg -selectforeground $sfg -insertbackground $ibg [$obPrf TexCSample] configure -fg $fg -bg $bg -selectbackground $sbg -selectforeground $sfg -insertbackground $ibg set data(INI,CSsaved) $cs } if {[string match root* $geo]} { # the geometry of the dialogue - its first setting # (makes sense at switching tabs, when open 1st time) after 10 [list after 10 [list after 10 [list after 10 "wm geometry $win \[wm geometry $win\]"]]] } if {$focus1st} { foreach w [$win.fra.fraR.$curTab tabs] { if {[string match *$nt $w]} { after 10 [list after 10 [list after 10 [list after 10 "::apave::focusFirst $w"]]] break } } } }
Sets default colors to highlight Tcl.
| index of syntax colors |
| yes, if only variables should be initialized; optional, default no |
proc ::alited::pref::Tcl_Default {isyn {init no}} { # Sets default colors to highlight Tcl. # isyn - index of syntax colors # init - yes, if only variables should be initialized fetchVars set al(TclExts) $al(TclExtsDef) set Dark [CsDark] set clrnams [::hl_tcl::hl_colorNames] set clrvals [::hl_tcl::hl_colors $isyn $Dark] foreach nam $clrnams val $clrvals { set al(ED,$nam) $val } set al(ED,Dark) $Dark if {!$init} UpdateSyntaxTab set al(syntaxidx) $isyn }
Serves to layout "Template" tab.
proc ::alited::pref::Template_Tab {} { # Serves to layout "Template" tab. return { {v_ - - 1 1} {fra v_ T 1 2 {-st nsew -cw 1}} {.labH - - 1 2 {-st w -pady 5 -padx 3} {-t "Enter %U, %u, %m, %w, %d, %t wildcards of templates:"}} {.labU + T 1 1 {-st e -pady 1 -padx 3} {-t "User name:"}} {.entU + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(TPL,%U) -w 40}} {.labu .labU T 1 1 {-st e -pady 1 -padx 3} {-anc e -t "Login:"}} {.entu + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(TPL,%u) -w 30}} {.labm .labu T 1 1 {-st e -pady 1 -padx 3} {-t "E-mail:"}} {.entm + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(TPL,%m) -w 40}} {.labw .labm T 1 1 {-st e -pady 1 -padx 3} {-t "WWW:"}} {.entw + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(TPL,%w) -w 40}} {.labd .labw T 1 1 {-st e -pady 1 -padx 3} {-t "Date format:"}} {.entd + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(TPL,%d) -w 30}} {.labt .labd T 1 1 {-st e -pady 1 -padx 3} {-t "Time format:"}} {.entt + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(TPL,%t) -w 30}} {.seh .labt T 1 2 {-pady 3}} {.but + T 1 1 {-st w} {-t {$al(MC,tpl)} -com {alited::EnsureAlArray ::alited::al alited::unit::Run_unit_tpl no "-centerme $::alited::pref::win"} -tabnext alited::Tnext}} } }
Tests a_menu settings.
Sets defaults for plain text.
proc ::alited::pref::Text_Default {} { # Sets defaults for plain text. fetchVars set al(TextExts) $al(TextExtsDef) update }
Returns a list of letters to be toolbar "icons".
Returns a list of letters to be toolbar "icons".
proc ::alited::pref::TextIcons {} { # Returns a list of letters to be toolbar "icons". return &~=@$#%ABCDEFGHIJKLMNOPQRSTUVWXYZ }
Sets defaults for "Tools/Tkcon" tab.
proc ::alited::pref::Tkcon_Default {} { # Sets defaults for "Tools/Tkcon" tab. namespace upvar ::alited al al set g "{}" catch { set ls [split $al(tkcon,options)] if {[set i [lsearch $ls -geometry]]>-1} { set g [lindex $ls [incr i]] } } set al(tkcon,options) "-rows 24 -cols 80 -fontsize 13 -geometry $g -showmenu 1 -topmost [::asKDE]" }
Sets light theme colors for Tkcon.
proc ::alited::pref::Tkcon_Default1 {} { # Sets light theme colors for Tkcon. fetchVars Tkcon_Default foreach {clr val} { bg #FFFFFF blink #FFFF00 cursor #000000 disabled #4D4D4D proc #008800 var #FFC0D0 prompt #8F4433 stdin #000000 stdout #0000FF stderr #FF0000} { set al(tkcon,clr$clr) $val } }
Sets dark theme colors for Tkcon.
proc ::alited::pref::Tkcon_Default2 {} { # Sets dark theme colors for Tkcon. fetchVars Tkcon_Default foreach {clr val} { bg #25292b blink #929281 cursor #FFFFFF disabled #999797 proc #66FF10 var #565608 prompt #ffff00 stdin #FFFFFF stdout #aeaeae stderr #ff7272} { set al(tkcon,clr$clr) $val } }
Serves to layout "Tools/Tkcon" tab.
proc ::alited::pref::Tkcon_Tab {} { # Serves to layout "Tools/Tkcon" tab. return { {v_ - - 1 1} {fra + T 1 1 {-st nsew -cw 1 -rw 1}} {fra.scf - - 1 1 {pack -fill both -expand 1} {-mode y}} {fra.scf.lfr - - 1 1 {pack -fill x} {-t Colors}} {.Labbg - - 1 1 {-st e -pady 1 -padx 3} {-t "bg:"}} {.clrbg + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrbg) -w 20}} {.labblink .labbg T 1 1 {-st e -pady 1 -padx 3} {-t "blink:"}} {.clrblink + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrblink) -w 20}} {.labcursor .labblink T 1 1 {-st e -pady 1 -padx 3} {-t "cursor:"}} {.clrcursor + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrcursor) -w 20}} {.labdisabled .labcursor T 1 1 {-st e -pady 1 -padx 3} {-t "disabled:"}} {.clrdisabled + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrdisabled) -w 20}} {.labproc .labdisabled T 1 1 {-st e -pady 1 -padx 3} {-t "proc:"}} {.clrproc + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrproc) -w 20}} {.labvar .labproc T 1 1 {-st e -pady 1 -padx 3} {-t "var:"}} {.clrvar + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrvar) -w 20}} {.labprompt .labvar T 1 1 {-st e -pady 1 -padx 3} {-t "prompt:"}} {.clrprompt + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrprompt) -w 20}} {.labstdin .labprompt T 1 1 {-st e -pady 1 -padx 3} {-t "stdin:"}} {.clrstdin + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrstdin) -w 20}} {.labstdout .labstdin T 1 1 {-st e -pady 1 -padx 3} {-t "stdout:"}} {.clrstdout + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrstdout) -w 20}} {.labstderr .labstdout T 1 1 {-st e -pady 1 -padx 3} {-t "stderr:"}} {.clrstderr + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,clrstderr) -w 20}} {fra.scf.v_ fra.scf.lfr T 1 1 pack {-h 10}} {fra.scf.lfr2 - - - - {pack -fill x} {-t Options}} {.entopts - - 1 1 {-st sw -pady 1} {-tvar ::alited::al(tkcon,options) -w 80}} {fra.scf.frabuts - - - - {pack -fill x}} {.but1 - - - - {-pady 8} {-t Standard -com {alited::pref::Tkcon_Default1; alited::pref::UpdateTkconTab}}} {.but2 + L 1 1 {-padx 8} {-t {Standard 2} -com {alited::pref::Tkcon_Default2; alited::pref::UpdateTkconTab}}} {.butok + L 1 1 {} {-t "$al(MC,test)" -com alited::tool::tkcon -tabnext alited::Tnext}} } }
Sets the default settings of units.
proc ::alited::pref::Units_Default {} { # Sets the default settings of units. fetchVars set al(INI,LINES1) 10 set al(INI,LEAF) 0 set al(RE,branch) $al(RE,branchDEF) set al(RE,leaf) $al(RE,leafDEF) set al(RE,proc) $al(RE,procDEF) set al(RE,leaf2) $al(RE,leaf2DEF) set al(RE,proc2) $al(RE,proc2DEF) CheckUseLeaf }
Serves to layout "Units" tab.
proc ::alited::pref::Units_Tab {} { # Serves to layout "Units" tab. return { {v_ - - 1 1} {fra + T 1 1 {-st nsew -cw 1 -rw 1}} {fra.scf - - 1 1 {pack -fill both -expand 1} {-mode x}} {.labBr - - 1 1 {-st e -pady 1 -padx 3} {-t "Branch's regexp:"}} {.entBr + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(RE,branch) -w 70}} {.labPr .labBr T 1 1 {-st e -pady 1 -padx 3} {-t "Proc's regexp:"}} {.EntPr + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(RE,proc) -w 70}} {.labUself .labPr T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,useleafRE)}}} {.swiUself + L 1 1 {-st sw -pady 1} {-var ::alited::al(INI,LEAF) -com alited::pref::CheckUseLeaf -afteridle alited::pref::CheckUseLeaf}} {.labLf .labUself T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,leafRE)}}} {.EntLf + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(RE,leaf) -w 70}} {.labLf2 .labLf T 1 1 {-st e -pady 1 -padx 3} {-t "Check branch's regexp:"}} {.entLf2 + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(RE,leaf2) -w 70}} {.labPr2 .labLf2 T 1 1 {-st e -pady 1 -padx 3} {-t "Check proc's regexp:"}} {.entPr2 + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(RE,proc2) -w 70}} {.labUnt .labPr2 T 1 1 {-st e -pady 1 -padx 3} {-t "Unaffected top lines:"}} {.spxUnt + L 1 1 {-st sw -pady 1} {-tvar ::alited::al(INI,LINES1) -from 2 -to 200 -w 9}} {.but .labUnt T 1 1 {-st w} {-t Standard -com alited::pref::Units_Default -tabnext alited::Tnext}} } }
Updates color labels at clicking "Default" button.
| {} for Tcl, {2} for C/C++; optional, default "" |
proc ::alited::pref::UpdateSyntaxTab {{lng {}}} { # Updates color labels at clicking "Default" button. # lng - {} for Tcl, {2} for C/C++ fetchVars catch { InitSyntax $lng foreach nam [::hl_tcl::hl_colorNames] { lappend colors $al(ED,$nam) lappend Ccolors $al(ED,C$nam) } lassign [::hl_tcl::addingColors [CsDark] {} [GetCS]] clrCURL clrCMN2 lappend colors $clrCURL $clrCMN2 lappend Ccolors $clrCURL $clrCMN2 InitSyntaxTcl $colors InitSyntaxC $Ccolors } }
Updates color labels for "Tools/Tkcon" tab.
proc ::alited::pref::UpdateTkconTab {} { # Updates color labels for "Tools/Tkcon" tab. fetchVars set lab1 [$obPrf Labbg] foreach nam {bg blink cursor disabled proc var prompt stdin stdout stderr} { set lab [string map [list labbg labclr$nam] $lab1] set ent [string map [list labbg entclr$nam] $lab1] $lab configure -background [$ent get] } }
Move a current run item up.
proc ::alited::pref::UpRun {} { # Move a current run item up. if {[set fr [FocusedRun]]<0} return if {$fr==0} { bell } else { set f2 [expr {$fr - 1}] ExchangeRuns $fr $f2 } }
Creates Project Printer dialogue.
proc ::alited::printer::_create {} { # Creates Project Printer dialogue. fetchVars set tipmark "[msgcat::mc (Un)Select]\nSpace" lassign [alited::FgFgBold] -> fgbold set wden 44 $obDl2 makeWindow $win.fra [msgcat::mc {Project Printer}] $obDl2 paveWindow $win.fra { {labh - - 1 3 {} {-t {Project Printer} -foreground $fgbold -font {$::apave::FONTMAINBOLD}}} {fraTop labh L 1 3 {-st ew}} {.btTmark - - - - {pack -padx 4 -side left} {-image alimg_ok -com alited::printer::MarkUnmarkFile -tip {$tipmark}}} {.sev2 - - - - {pack -side left -fill y -padx 5}} {.btTCtr - - - - {pack -side left -padx 4} {-image alimg_minus -com {alited::printer::ExpandContract no} -tip "Contract All"}} {.btTExp - - - - {pack -side left} {-image alimg_plus -com {alited::printer::ExpandContract} -tip "Expand All"}} {.btTExp2 - - - - {pack -side left -padx 4} {-image alimg_add -com {alited::printer::ExpandMarked} -tip "Expand Selected"}} {fraBody labh T 1 3 {-st news}} {.lab1 - - 1 1 {-st nw} {-t {Output directory:}}} {.Dir + T 1 3 {-st new} {-tvar ::alited::printer::dir -w $wden}} {.v_1 + T 1 1 {-pady 8}} {.lab2 + T 1 1 {-st nw} {-t {Markdown processor:}}} {.cbx + T 1 3 {-st nw} {-tvar ::alited::printer::mdproc -value {$::alited::printer::mdprocs} -w $wden}} {.v_2 + T 1 3 {-pady 8}} {.lfr + T 1 3 {-st nwe} {-t {Directory title colors}}} {.lfr.lab1 - - 1 1 {-st ne} {-t {Foreground:}}} {.lfr.Clr1 + L 1 1 {-st new} {-tvar ::alited::printer::ttlfg}} {.lfr.butClr1 + L 1 1 {-st new} {-t Standard -takefocus 0 -com {alited::printer::StdClr Clr1 ttlfg Clr2 ttlbg}}} {.lfr.lab2 .lfr.lab1 T 1 1 {-st ne} {-t {Background:}}} {.lfr.Clr2 + L 1 1 {-st new} {-tvar ::alited::printer::ttlbg}} {.v_3 .lfr T 1 1 {-pady 8}} {.lfr2 + T 1 3 {-st nwe} {-t {File title colors}}} {.lfr2.lab1 - - 1 1 {-st ne} {-t {Foreground:}}} {.lfr2.Clr3 + L 1 3 {-st nw} {-tvar ::alited::printer::leaffg}} {.lfr2.butClr3 + L 1 1 {-st new} {-t Standard -takefocus 0 -com {alited::printer::StdClr Clr3 leaffg Clr4 leafbg}}} {.lfr2.lab2 .lfr2.lab1 T 1 1 {-st ne} {-t {Background:}}} {.lfr2.Clr4 + L 1 3 {-st nw} {-tvar ::alited::printer::leafbg}} {.fraw .lfr2 T 1 3 {-st nw -pady 6}} {.fraw.labcs - - 1 1 {-st ne -pady 4} {-t {Syntax colors:}}} {.fraw.rad1 + L 1 1 {-st nsw -padx 4} {-var ::alited::printer::cs -value 1 -t 1}} {.fraw.rad2 + L 1 1 {-st nsw -padx 9} {-var ::alited::printer::cs -value 2 -t 2}} {.fraw.rad3 + L 1 1 {-st nsw -padx 4} {-var ::alited::printer::cs -value 3 -t 3}} {.fraw.rad4 + L 1 1 {-st nsw -padx 9} {-var ::alited::printer::cs -value 4 -t 4}} {.fraw.labst .fraw.labcs T 1 1 {-st nse} {-t {Sort units:}}} {.fraw.swist + L 1 1 {-st nsw -padx 4} {-var alited::printer::dosort}} {.fraw.labwc .fraw.labst T 1 1 {-st nse} {-t {Width of contents:}}} {.fraw.SpxCwidth + L 1 4 {-st nsw -padx 4} {-tvar ::alited::printer::cwidth -from 5 -to 99 -w 4 -justify center}} {.seh .fraw T 1 3 {-pady 8}} {.lab4 + T 1 2 {-st nw} {-t {Final processor:}}} {.btT + L 1 1 {-st e -padx 3} {-image alimg_run -com {::alited::printer::RunFinal 1} -tip {Runs the final processor.}}} {.Fil .lab4 T 1 3 {-st new} {-tvar ::alited::printer::final -w $wden}} {fraTree fraTop T 2 1 {-st news -cw 1}} {.Tree - - - - {pack -side left -fill both -expand 1} {-height 20 -columns {L1 L2 PRL ID LEV LEAF FL1} -displaycolumns {L1} -columnoptions "#0 {-width $width1} L1 {-width $width2 -anchor e}" -style TreeNoHL -selectmode browse -tip {-BALTIP {alited::tree::GetTooltip %i %c} -SHIFTX 10}}} {.SbvTree fraTree.Tree L - - {pack -side right -fill both}} {fraMid fraBody T 1 3 {-st wes -rw 1 -padx 2}} {.seh1 - - - - {pack -side top -expand 1 -fill both -pady 4}} {.butHelp - - - - {pack -side left} {-t Help -com alited::printer::Help -takefocus 0}} {.h_ - - - - {pack -side left -expand 1 -fill both -padx 4}} {.butOK - - - - {pack -side left} {-t OK -com alited::printer::Ok}} {.butCancel - - - - {pack -side left -padx 2} {-t Cancel -com alited::printer::Cancel}} {.TexTmp - - - - {pack forget -side left}} {.TexTmp2 - - - - {pack forget -side left}} {fraBot fraMid T 1 4 {-st we}} {.stat - - - - {pack -side bottom} {-array { {{} -anchor w -expand 1} 30 {Selected -anchor center} 4 }}} } set wtree [$obDl2 Tree] bind $wtree <space> "alited::printer::Mark1 $wtree; break" bind $wtree <FocusIn> "alited::printer::FocusIn $wtree" bind $wtree <FocusOut> "alited::printer::FocusOut $wtree" bind $win <F1> "alited::printer::Help" bind [$obDl2 Labstat1] <Button-1> alited::printer::ProcMessage alited::tree::AddTags $wtree FillTree $wtree $obDl2 showModal $win -resizable 1 -minsize {500 400} -geometry $geometry -focus Tab catch {destroy $win} }
Runs Project Printer dialogue.
proc ::alited::printer::_run {} { # Runs Project Printer dialogue. fetchVars set dir [file join [apave::HomeDir] TMP alited $al(prjname)] set tpldir [file join $DATADIR printer] set indextpl [file join $tpldir $indexname] set indextpl2 [file join $tpldir $indexname2] set titletpl [file join $tpldir title.html] set cssdir [file join $tpldir $CSS] set csstpl [file join $cssdir $cssname] set inifile [file join $INIDIR printer.ini] set iniprjfile [file join $PRJDIR $al(prjname).prn] ReadIni _create }
Cancel handling the dialog.
proc ::alited::printer::Cancel {} { # Cancel handling the dialog. fetchVars $obDl2 res $win 0 }
Check for correctness of the dialog's data.
proc ::alited::printer::CheckData {} { # Check for correctness of the dialog's data. fetchVars set dir [string trim $dir] if {$dir eq {}} { set errfoc [$obDl2 chooserPath Dir] } elseif {![::apave::intInRange $cwidth 5 99]} { set errfoc [$obDl2 SpxCwidth] } if {[info exists errfoc]} { bell focusByForce $errfoc return no } foreach {fld var} {Clr1 ttlfg Clr2 ttlbg Clr3 leaffg Clr4 leafbg} { set val [set $var] if {![regexp "^#\[0-9a-fA-F\]{6}\$" $val]} { bell focus [$obDl2 chooserPath $fld] return no } } return yes }
Checks the output directory.
proc ::alited::printer::CheckDir {} { # Checks the output directory. fetchVars set dircont [glob -nocomplain [file join $dir *]] if {![llength $dircont]} {return yes} # possible errors: set err1 {Output directory cannot be cleared: alien files} set err2 [msgcat::mc {Output directory cannot be cleared: alien %n}] set err3 {Output directory cannot be cleared: alien directories} set cntdir [set cntfile [set aliendir 0]] foreach fn $dircont { set ftail [file tail $fn] if {[file isfile $fn]} { incr cntfile if {$ftail ne $indexname} { Message $err1 4 return no ;# alien file } if {![CheckFile $fn]} { Message [string map [list %n $indexname] $err2] 4 return no ;# alien content file } } elseif {$ftail in [list $FILES $CSS]} { incr cntdir } else { incr aliendir } } if {$aliendir} { Message $err3 4 ;# only 1 content file with subdirectories return no } if {$cntdir} { set msg [msgcat::mc "The output directory\n %n\ncontains %c subdirectories.\n\nAll will be replaced with the new!"] set msg [string map [list %n $dir %c $cntdir] $msg] if {![alited::msg okcancel warn $msg OK -title $al(MC,warning)]} { set fname [file join $dir $indexname] if {[file exists $fname]} {openDoc $fname} return no } } catch {file delete -force {*}$dircont} return yes }
Checks the file of contents.
| the file name |
proc ::alited::printer::CheckFile {fname} { # Checks the file of contents. # fname - the file name variable copyleft set fcont [readTextFile $fname] expr {[string first $copyleft $fcont]>=0} }
Checks alited's templates for .html files.
proc ::alited::printer::CheckTemplates {} { # Checks alited's templates for .html files. fetchVars set csscont [readTextFile $csstpl] if {$csscont eq {}} { Message "No template file for $cssname found: alited broken?" 4 return no } return yes }
Compares the unit tree items by their titles. Useful for trees without branches.
| 1st item |
| 2nd item |
proc ::alited::printer::CompareUnits {item1 item2} { # Compares the unit tree items by their titles. Useful for trees without branches. # item1 - 1st item # item2 - 2nd item lassign $item1 lev1 leaf1 - title1 lassign $item2 lev2 leaf2 - title2 set leaf1 [expr {$title1 ne {} && $leaf1}] set leaf2 [expr {$title2 ne {} && $leaf2}] set title1 "$leaf1 [string toupper [string trimleft $title1]]" set title2 "$leaf2 [string toupper [string trimleft $title2]]" if {$title1 < $title2} { return -1 } elseif {$title1 > $title2} { return 1 } return 0 }
Expands or contracts the tree.
| yes, if to expand; no, if to contract; optional, default yes |
proc ::alited::printer::ExpandContract {{isexp yes}} { # Expands or contracts the tree. # isexp - yes, if to expand; no, if to contract fetchVars set wtree [$obDl2 Tree] set itemID [alited::tree::CurrentItem {} $wtree] set branch [set selbranch {}] foreach item [alited::tree::GetTree {} {} $wtree] { lassign $item lev cnt ID if {[llength [$wtree children $ID]]} { set branch $ID $wtree item $ID -open $isexp } if {$ID eq $itemID} {set selbranch $branch} } if {$isexp} { if {$itemID ne {}} {$wtree selection set $itemID} alited::tree::SeeSelection $wtree } elseif {$selbranch ne {}} { $wtree selection set $selbranch alited::tree::SeeSelection $wtree } TryFocusTree $wtree }
Shows all marked tree item.
proc ::alited::printer::ExpandMarked {} { # Shows all marked tree item. fetchVars ExpandContract no set wtree [$obDl2 Tree] set parent {} foreach itemID $markedIDs { set itemParent [$wtree parent $itemID] if {$itemParent ne {} && $parent ne $itemParent} { $wtree see $itemID set parent $itemParent } } TryFocusTree $wtree }
Delivers namespace variables to a caller.
proc ::alited::printer::fetchVars {} { # Delivers namespace variables to a caller. uplevel 1 { namespace upvar ::alited al al obDl2 obDl2 INIDIR INIDIR PRJDIR PRJDIR DATADIR DATADIR foreach _ {win itemID1 inifile iniprjfile tpldir cssdir CSS indextpl indextpl2 csstpl titletpl csscont indexname indexname2 cssname readmecont markedIDs markedfiles copyleft wcbttl wcstyle wctitle wctoc wclink wcrmcon wcbody wcwidth wcback wcfg wcbg tmpC cs geometry width1 width2 dir mdproc mdprocs ttlfg ttlbg leaffg leafbg cwidth indexcont final leafttl wcleaft wctipw wcrmttl dosort wclt wcgt copyright colors lastreadme filesdir FILES prebeg preend paragr} { variable $_ } } }
Populates the tree of project files.
| tree's path |
proc ::alited::printer::FillTree {wtree} { # Populates the tree of project files. # wtree - tree's path fetchVars $wtree heading #0 -text ":: $al(prjname) ::" $wtree heading #1 -text $al(MC,files) alited::tree::PrepareDirectoryContents set markedIDs [list] set itemID1 {} foreach item [alited::tree::GetDirectoryContents $al(prjroot)] { set itemID [alited::tree::NewItemID [incr iit]] lassign $item lev isfile fname fcount iroot set title [file tail $fname] if {$iroot<0} { set parent {} } else { set parent [alited::tree::NewItemID [incr iroot]] } if {$isfile} { if {[alited::file::IsTcl $fname]} { set imgopt {-image alimg_tclfile} } else { set imgopt {-image alimg_file} } } else { set imgopt {-image alimg_folder} } if {$fcount} {set fc $fcount} {set fc {}} $wtree insert $parent end -id $itemID -text "$title" -values [list $fc $fname $isfile $itemID] -open no {*}$imgopt $wtree tag add tagNorm $itemID if {!$isfile} { $wtree tag add tagBranch $itemID } if {$fname in $markedfiles} { lappend markedIDs $itemID $wtree tag add tagSel $itemID } if {$itemID1 eq {}} {set itemID1 $itemID} } ExpandMarked MarkTotal catch {$wtree see $itemID1} }
Focuses an item of the tree.
| tree's path |
| item's ID |
| Not documented; optional, default 1 |
proc ::alited::printer::FocusID {wtree itemID {cnt 1}} { # Focuses an item of the tree. # wtree - tree's path # itemID - item's ID if {$cnt} { # will restart after idle after idle "alited::printer::FocusID $wtree $itemID [incr cnt -1]" } else { $wtree focus $itemID $wtree see $itemID $wtree selection set $itemID } }
Focuses 1st item of the tree.
| tree's path |
proc ::alited::printer::FocusID1 {wtree} { # Focuses 1st item of the tree. # wtree - tree's path variable itemID1 if {$itemID1 ne {}} {FocusID $wtree $itemID1} }
Handles focusing the tree.
| Not documented. |
proc ::alited::printer::FocusIn {wtree} { # Handles focusing the tree. set itemID [$wtree focus] if {$itemID eq {}} { FocusID1 $wtree } else { FocusID $wtree $itemID } }
Handles unfocusing the tree.
| Not documented. |
proc ::alited::printer::FocusOut {wtree} { # Handles unfocusing the tree. catch {$wtree selection remove [$wtree focus]} }
Gets a contents branch link for index.html.
| link address |
| link title |
proc ::alited::printer::GetBranchLink {link title} { # Gets a contents branch link for index.html. # link - link address # title - link title return "<li><b><a href=\"$link\">$title</a></b></li>" }
Create style.css.
proc ::alited::printer::GetCss {} { # Create style.css. fetchVars set cssdir_to [file join $dir $CSS] catch {file mkdir $cssdir_to} set tipw [expr {$cwidth*20}] set csscont [string map [list $wcwidth $cwidth $wctipw $tipw $wcfg $ttlfg $wcbg $ttlbg] $csscont] set css_to [file join $cssdir_to $cssname] writeTextFile $css_to ::alited::printer::csscont 1 }
Gets a dir link for index.html.
| directory name |
proc ::alited::printer::GetDirLink {dir} { # Gets a dir link for index.html. # dir - directory name namespace upvar ::alited al al set dirtail [::apave::FileTail $al(prjroot) $dir] if {$dirtail eq {}} {set branch <hr>} {set branch $dirtail} list $dirtail [GetBranchLink # $branch] }
Gets a file link for index.html.
| directory name |
| file name |
proc ::alited::printer::GetFileName {dir2 fname} { # Gets a file link for index.html. # dir2 - directory name # fname - file name namespace upvar ::alited al al set ftail [file tail $fname] return [file join $dir2 $ftail] }
Gets a contents leaf link for index.html.
| link address |
| link title |
| tooltip's text; optional, default "" |
| base path for file links; optional, default "" |
proc ::alited::printer::GetLeafLink {link title {tip {}} {basepath {}}} { # Gets a contents leaf link for index.html. # link - link address # title - link title # tip - tooltip's text # basepath - base path for file links if {$basepath ne {}} { set link [::apave::FileTail $basepath $link] } set title [lindex [split $title :] end] if {$tip eq {}} { return "<ul class=toc><li><a href='$link'>$title</a></li></ul>" } return "<ul class=toc><li><div class=tooltip><a href=\"$link\">$title</a><span class=tooltiptext>$tip</span></div></li></ul>" }
Create html version of readme.md.
| directory name where to get the source readme.md |
proc ::alited::printer::GetReadme {dirfrom} { # Create html version of readme.md. # dirfrom - directory name where to get the source readme.md fetchVars if {$mdproc eq {}} {return {}} if {[set fname [glob -nocomplain [file join $dirfrom README*]]] eq {}} { if {[set fname [glob -nocomplain [file join $dirfrom ReadMe*]]] eq {}} { if {[set fname [glob -nocomplain [file join $dirfrom Readme*]]] eq {}} { if {[set fname [glob -nocomplain [file join $dirfrom readme*]]] eq {}} { return {} } } } } set fname [lindex $fname 0] Message $fname 3 set tmpname [alited::TmpFile PRINTER~.html] if {$lastreadme ne $fname} { set lastreadme $fname set com {} if {$mdproc eq {pandoc}} { set com [list [apave::autoexec $mdproc] -o $tmpname $fname] } elseif {$mdproc eq {alited}} { MdProc $fname $tmpname } else { set com [string map [list %i $fname %o $tmpname] $mdproc] } if {$com ne {}} {exec -- {*}$com} } set cont {} set iscode no set lsp1 0 set lpr1 [string length $paragr] set lpr2 [expr {$lpr1+1}] # wrap the code snippets with <pre code ... /pre> foreach line [split [readTextFile $tmpname {} 1] \n] { set line [string trimright $line] set lsp [$obDl2 leadingSpaces $line] if {$lsp>3} { set line [Off_Html_tags $line] if {!$iscode} {set lsp1 $lsp} set line [string range $line $lsp1 end] if {!$iscode} { if {[string range $cont end-$lpr1 end] eq "$paragr\n"} { set cont [string range $cont 0 end-$lpr2] } set line "$prebeg$line" } set iscode yes } elseif {$iscode && $line ne {}} { if {$line eq $paragr} { append cont \n continue } set cont [string trimright $cont] set line "$preend$line" set iscode no } append cont $line \n } list $cont $fname }
Handles "Help" button.
proc ::alited::printer::Help {} { # Handles "Help" button. fetchVars alited::Help $win }
Highlights Tcl code in html file
| file name |
proc ::alited::printer::Hl_html {fname} { # Highlights Tcl code in html file # fname - file name fetchVars set cset cs= foreach val $colors {append cset $val,} set hl_tcl [file join $::alited::LIBDIR hl_tcl tcl_html.tcl] set com [list [alited::Tclexe] $hl_tcl $cset $fname] exec -- {*}$com }
Makes a html file or a copy of file from a source file.
| source file's name |
| resulting file |
proc ::alited::printer::MakeFile {fname fname2} { # Makes a html file or a copy of file from a source file. # fname - source file's name # fname2 - resulting file fetchVars set ftail [file tail $fname2] Message $ftail 3 update if {![alited::file::IsTcl $fname2]} { file copy $fname $fname2 return $fname2 } set cont [readTextFile $fname] set TID [alited::bar::FileTID $fname] set wtxt [alited::main::GetWTXT $TID] if {$TID ne {} && $wtxt ne {}} { alited::InitUnitTree $TID } else { set TID TMP set wtxt [$obDl2 TexTmp] $wtxt replace 1.0 end $cont ;# imitate tab of bar alited::unit::RecreateUnits $TID $wtxt ;# to get unit tree } if {[llength $al(_unittree,$TID)]<2} { set tpl [readTextFile $indextpl2] ;# no units } else { set tpl [readTextFile $indextpl] set tpl [string map [list $wctoc $ftail] $tpl] set contlist [split $cont \n] if {$dosort} { set items [lsort -command alited::printer::CompareUnits $al(_unittree,$TID)] } else { set items $al(_unittree,$TID) } foreach item $items { if {[llength $item]<3} continue lassign $item lev leaf fl1 title l1 l2 set title [::apave::NormalizeName $title] if {$title eq {}} { set title $ftail set leaf 0 } set ttl [string map {" " _} $title] if {$leaf} { set tip " $title[UnitTooltip $wtxt $l1 $l2]" set link [GetLeafLink #$ttl $title $tip] } else { if {$dosort} { set title [string trimleft $title] } else { set title [string repeat { } [expr {$lev*2}]]$title } set link [GetBranchLink #$ttl $title] } append link \n$wclink set tpl [string map [list $wclink $link] $tpl] set l1 [expr {max(0,$l1-2)}] set line [lindex $contlist $l1] set contlist [lreplace $contlist $l1 $l1 "$line${wclt}a id=$ttl${wcgt}${wclt}/a${wcgt}"] } set cont {} foreach line $contlist {append cont $line\n} } lassign [GetReadme [file dirname $fname]] readme rmname if {$readme eq {}} { set bttl {} set rmttl $leafttl } else { set bttl $leafttl set rmttl [string map [list $wctitle [file tail $rmname]] $leafttl] } set rootpath [file dirname [::apave::FileRelativeTail $dir $fname2]] set csspath [file join $rootpath $CSS $cssname] set tpl [string map [list $wclink {} $wcrmcon $readme $wcrmttl $rmttl $wcbttl $bttl] $tpl] set tpl [string map [list $wcleaft $leafttl] $tpl] set tpl [string map [list $wctitle $ftail $wcstyle $csspath] $tpl] set tpl [string map [list $wcfg $leaffg $wcbg $leafbg] $tpl] set tpl [string map [list $wcback [file join $rootpath $indexname]] $tpl] set cont [Off_Html_tags $cont] set tmpC "$prebeg$cont$preend" set tmpC [string map [list $wcbody $tmpC] $tpl] set fname2 [file rootname $fname2].html writeTextFile $fname2 ::alited::printer::tmpC Hl_html $fname2 set tmpC [readTextFile $fname2] set tmpC [string map [list ${wclt} < ${wcgt} >] $tmpC] append tmpC \n$copyright writeTextFile $fname2 ::alited::printer::tmpC return $fname2 }
Mark/unmark tree items.
| tree's path |
| item's ID |
| yes if the item is marked |
proc ::alited::printer::Mark {wtree itemID ismarked} { # Mark/unmark tree items. # wtree - tree's path # itemID - item's ID # ismarked - yes if the item is marked set treecont [alited::tree::GetTree {} {} $wtree] set iit [lsearch -exact -index {4 3} $treecont $itemID] lassign [lindex $treecont $iit] lev lassign [lindex $treecont $iit 4] - fname leaf MarkFile $wtree $itemID $ismarked set wasmarkeddir no if {![string is true -strict $leaf]} { # for directory: mark/unmark its files foreach item [lrange $treecont [incr iit] end] { lassign [lindex $item] lev2 lassign [lindex $item 4] - fname leaf itID if {$lev2<=$lev} break MarkFile $wtree $itID $ismarked set wasmarkeddir yes } } return $wasmarkeddir }
Mark/unmark tree item of file, with a key.
| tree's path |
proc ::alited::printer::Mark1 {wtree} { # Mark/unmark tree item of file, with a key. # wtree - tree's path set wd [MarkUnmarkFile] if {!$wd} { event generate $wtree <Down> } }
Mark/unmark tree item of file.
| tree's path |
| item's ID |
| yes if the item is marked |
proc ::alited::printer::MarkFile {wtree itemID ismarked} { # Mark/unmark tree item of file. # wtree - tree's path # itemID - item's ID # ismarked - yes if the item is marked variable markedIDs set i [lsearch $markedIDs $itemID] set markedIDs [lreplace $markedIDs $i $i] if {$ismarked} { $wtree tag add tagSel $itemID lappend markedIDs $itemID } else { $wtree tag remove tagSel $itemID } }
Show a number of marked items.
proc ::alited::printer::MarkTotal {} { # Show a number of marked items. fetchVars [$obDl2 Labstat2] configure -text [llength $markedIDs] }
Marks/unmarks and item in file tree.
proc ::alited::printer::MarkUnmarkFile {} { # Marks/unmarks and item in file tree. fetchVars set wtree [$obDl2 Tree] set itemID [$wtree focus] if {$itemID eq {}} { focus $wtree FocusID1 $wtree return 0 } if {[set i [lsearch $markedIDs $itemID]]>=0} { set markedIDs [lreplace $markedIDs $i $i] set wasmarkeddir [Mark $wtree $itemID no] } else { lappend markedIDs $itemID set wasmarkeddir [Mark $wtree $itemID yes] } if {$wasmarkeddir} { ExpandMarked after idle "alited::printer::FocusID $wtree $itemID" } MarkTotal return $wasmarkeddir }
Initializes a text widget for md syntax.
proc ::alited::printer::MdInit {} { # Initializes a text widget for md syntax. fetchVars set wtxt [$obDl2 TexTmp2] set plcom [alited::HighlightAddon $wtxt .md $colors] ::hl_tcl::hl_init $wtxt -plaincom $plcom }
Puts out the .html made from .md (in a text buffer): final processings.
| text's path |
| output file name |
proc ::alited::printer::MdOutput {wtxt fout} { # Puts out the .html made from .md (in a text buffer): final processings. # wtxt - text's path # fout - output file name fetchVars set tmpC {} set par 1 set code 0 foreach line [split [$wtxt get 1.0 end] \n] { set line [string trimright $line] if {[regexp "^\\s{0,3}>{1}" $line]} { set line <blockquote>[string trimleft $line { >}]</blockquote> } if {$line eq {```}} { # code snippet's start-end if {[set code [expr {!$code}]]} { set line {<pre class="code">} } else { set line </pre> } } elseif {$line eq {}} { # paragraph's start-end if {!$par} {append line $paragr} incr par } elseif {$par} { set par 0 } append tmpC $line \n } # paragraph's end append tmpC </p> writeTextFile $fout ::alited::printer::tmpC }
Makes .html version of .md file.
| input .md file name |
| output .html file name |
First, puts the .md file to a text widget and highlights it. Then scans the text for highlighting tags to make their html counterparts.
proc ::alited::printer::MdProc {fin fout} { # Makes .html version of .md file. # fin - input .md file name # fout - output .html file name # First, puts the .md file to a text widget and highlights it. # Then scans the text for highlighting tags to make their html counterparts. # See also: hl_md::init fetchVars set wtxt [$obDl2 TexTmp2] set cont [readTextFile $fin {} 1] $wtxt replace 1.0 end $cont ::hl_tcl::hl_text $wtxt lassign $colors clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT foreach tag [$wtxt tag names] { if {![string match md* $tag]} continue set parts [lsort -dictionary -decreasing -stride 2 [$wtxt tag ranges $tag]] foreach {p1 p2} $parts { switch -exact $tag { mdCMNT { ;# comment tag for "invisible" parts $wtxt replace $p1 $p2 {} } mdAPOS { ;# apostrophe is for <code> tag set cont [$wtxt get $p1 $p2] set cont2 [Off_Html_tags $cont] $wtxt replace $p1 $p2 $cont2 set addch [expr {[string length $cont2]-[string length $cont]}] set p2 [$wtxt index "$p2 +$addch char"] $wtxt insert $p2 </code> $wtxt insert $p1 "<code>" } mdBOIT { ;# bold italic $wtxt insert $p2 </font></i></b> $wtxt insert $p1 "<b><i><font color=$clrVAR>" } mdITAL { ;# italic $wtxt insert $p2 </font></i> $wtxt insert $p1 "<i><font color=$clrVAR>" } mdBOLD { ;# bold $wtxt insert $p2 </font></b> $wtxt insert $p1 "<b><font color=$clrVAR>" } mdLIST { ;# list set link [$wtxt get $p1 $p2] if {[set lre [lindex [regexp -inline {^\s*(\d+).\s} $link] 0]] ne {}} { # numbered list $wtxt replace $p1 $p2 "<ol start=\"$lre\"><li>" set endtag </li></ol> } else { # usual list $wtxt replace $p1 $p2 <li> set endtag </li> } $wtxt insert [expr {int($p2)}].end $endtag } mdLINK { ;# link set tag1 {<a href=} set tag2 </a> set tag3 > set link [$wtxt get $p1 $p2] lassign [split $link \[\]()] a1 a2 a3 a4 if {$a1 eq {!}} { # set tag1 "<img alt=\"$a2\" src=" set tag2 {} set tag3 " />" set a1 [set a2 {}] } if {$a1 ne {}} { set link "$tag1\"$link\">$link" } else { set link "$tag1\"$a4\"$tag3$a2" } $wtxt replace $p1 $p2 $link$tag2 } mdHEAD1 - mdHEAD2 - mdHEAD3 - mdHEAD4 - mdHEAD5 - mdHEAD6 { ;# headers set h h[string index $tag end] $wtxt insert $p2 </font></$h> $wtxt insert $p1 "<$h><font color=$clrPROC>" } } } } MdOutput $wtxt $fout }
Displays a message in statusbar of the dialogue.
| message |
| mode of Message; optional, default 2 |
proc ::alited::printer::Message {msg {mode 2}} { # Displays a message in statusbar of the dialogue. # msg - message # mode - mode of Message namespace upvar ::alited obDl2 obDl2 alited::Message $msg $mode [$obDl2 Labstat1] }
Disables html tags in a code snippet.
| the code snippet |
proc ::alited::printer::Ok {} { fetchVars set wtree [$obDl2 Tree] set geometry [wm geometry $win] set width1 [$wtree column #0 -width] set width2 [$wtree column #1 -width] SaveIni if {[Process $wtree]} {$obDl2 res $win 1} }
Processes files to make the resulting .html.
| tree's path |
proc ::alited::printer::Process {wtree} { # Processes files to make the resulting .html. # wtree - tree's path fetchVars set colors [::hl_tcl::hl_colors $cs 0] if {$mdproc eq {alited}} MdInit set index_to [file join $dir $indexname] set filesdir [file join $dir $FILES] if {![file exists $index_to]} { # make empty index.html, to get rid of possible error messages set readmecont $copyleft writeTextFile $index_to ::alited::printer::readmecont } if {![CheckData]} {return no} if {![CheckDir]} {return no} if {![CheckTemplates]} {return no} lassign [GetReadme $al(prjroot)] readmecont rmname set indexcont [readTextFile $indextpl] set indexcont [string map [list $wcrmcon $readmecont $wcbody {}] $indexcont] GetCss set curdir {} set fcnt [set dcnt 0] foreach itemID [lsort -dictionary $markedIDs] { lassign [$wtree item $itemID -values] -> fname isfile if {!$isfile} { incr dcnt continue } set cdir [file dirname $fname] set dodir no if {$curdir ne $cdir} { set dodir yes set curdir $cdir lassign [GetDirLink $cdir] cdir2 link append link \n$wclink set indexcont [string map [list $wclink $link] $indexcont] Message $cdir 3 update } set fname2 [GetFileName $cdir2 $fname] set fname2 [file join $filesdir $fname2] if {$dodir} { catch {file mkdir [file dirname $fname2]} } set fname [MakeFile $fname $fname2] set link [GetLeafLink $fname [file tail $fname2] {} $dir] append link \n$wclink set indexcont [string map [list $wclink $link] $indexcont] incr fcnt } if {$rmname eq {}} { set rmttl $leafttl } else { set rmttl [string map [list $wctitle [file tail $rmname]] $leafttl] } set csspath [file join $CSS $cssname] set indexcont [string map [list $wcleaft $leafttl $wcrmttl $leafttl] $indexcont] set ttl ":: $al(prjname) ::" set indexcont [string map [list $wctitle $ttl $wctoc $ttl] $indexcont] set indexcont [string map [list $wclink {} $wcback {} $wcstyle $csspath] $indexcont] set indexcont [string map [list $wcfg $ttlfg $wcbg $ttlbg $wcbttl {}] $indexcont] append indexcont \n$copyright writeTextFile $index_to ::alited::printer::indexcont 1 Hl_html $index_to set msg [msgcat::mc {Processed: %d directories, %f files}] set msg [string map [list %d $dcnt %f $fcnt] $msg] Message $msg bell return [RunFinal] }
Handles clicking on message label.
proc ::alited::printer::ProcMessage {} { # Handles clicking on message label. namespace upvar ::alited obDl2 obDl2 set msg [baltip cget [$obDl2 Labstat1] -text] Message $msg 3 }
Reads ini data.
proc ::alited::printer::ReadIni {} { # Reads ini data. fetchVars set cont [readTextFile $inifile] append cont \n [readTextFile $iniprjfile] set markedfiles [list] foreach line [split $cont \n] { set line [string trim $line] if {[set val [alited::edit::IniParameter file $line]] ne {}} { lappend markedfiles $val } else { foreach opt {geometry width1 width2 dir mdproc mdprocs ttlfg ttlbg leaffg leafbg cwidth cs final dosort} { if {[set val [alited::edit::IniParameter $opt $line]] ne {}} { set $opt $val } } } } if {$width1 eq {}} {set width1 $al(TREE,cw0)} if {$width2 eq {}} {set width2 $al(TREE,cw1)} }
Runs final processor.
| if yes, beeps at empty final processor; optional, default no |
proc ::alited::printer::RunFinal {{check no}} { # Runs final processor. # check - if yes, beeps at empty final processor. fetchVars if {$final ne {}} { set fname [file join $dir $indexname] if {$final eq {%D} || $final eq {"%D"}} { openDoc $fname } elseif {$final eq {%e}} { alited::file::OpenFile $fname return yes } else { set com [string map [list %D $dir] $final] if {[string first e_menu.tcl $com]>0 && [string first m=%M $com]>0} { # e_menu items require project name & Linux/Windows terminals append com " PN=$al(prjname) \"tt=$al(EM,tt=)\" \"wt=$al(EM,wt=)\"" } set com [alited::MapWildCards $com] exec -- {*}$com & } } elseif {$check} { set final {"%D"} focusByForce [$obDl2 chooserPath Fil] bell } return no }
Saves ini data.
proc ::alited::printer::SaveIni {} { # Saves ini data. fetchVars set wtree [$obDl2 Tree] set tmpC {} append tmpC "geometry=$geometry" \n append tmpC "width1=$width1" \n append tmpC "width2=$width2" \n append tmpC "mdproc=$mdproc" \n append tmpC "ttlfg=$ttlfg" \n append tmpC "ttlbg=$ttlbg" \n append tmpC "leaffg=$leaffg" \n append tmpC "leafbg=$leafbg" \n append tmpC "cwidth=$cwidth" \n append tmpC "cs=$cs" \n writeTextFile $inifile ::alited::printer::tmpC set tmpC {} append tmpC "dir=$dir" \n append tmpC "final=$final" \n append tmpC "dosort=$dosort" \n foreach item [alited::tree::GetTree {} {} $wtree] { lassign [lindex $item 4] - fname leaf itemID if {$itemID in $markedIDs} { append tmpC \nfile=$fname } } writeTextFile $iniprjfile ::alited::printer::tmpC }
Sets standard colors.
| 1st color field (and color field to focus) |
| 1st color variable name |
| 2nd color field |
| 2nd color variable name |
proc ::alited::printer::StdClr {fld1 var1 fld2 var2} { # Sets standard colors. # fld1 - 1st color field (and color field to focus) # var1 - 1st color variable name # fld2 - 2nd color field # var2 - 2nd color variable name fetchVars set $var1 [set ::alited::printer::STD$var1] set $var2 [set ::alited::printer::STD$var2] set lab1 [$obDl2 chooserPath $fld1 lab]; $lab1 configure -background [set $var1] set lab2 [$obDl2 chooserPath $fld2 lab]; $lab2 configure -background [set $var2] focus [$obDl2 chooserPath $fld1] }
Tries focusing the focused item of the tree.
| tree's path |
proc ::alited::printer::TryFocusTree {wtree} { # Tries focusing the focused item of the tree. # wtree - tree's path set itemID [$wtree focus] if {$itemID ne {}} { focus $wtree FocusID $wtree $itemID } }
Gets unit's tooltip.
| text's path |
| 1st line's number |
| last line's number |
proc ::alited::printer::UnitTooltip {wtxt l1 l2} { # Gets unit's tooltip. # wtxt - text's path # l1 - 1st line's number # l2 - last line's number set tip {} for {incr l1} {$l1<=$l2} {incr l1} { set line [string trimleft [$wtxt get $l1.0 $l1.end]] if {[string match #* $line]} { append tip [string trimleft $line {#! }] \n } elseif {$line ne {}} { break } } set tip [string trimright $tip] if {$tip ne {}} {set tip " : $tip"} return $tip }
Creates and opens Projects dialogue.
proc ::alited::project::_create {} { # Creates and opens Projects dialogue. namespace upvar ::alited al al variable obPrj variable win variable geo variable prjlist variable oldTab variable ilast variable curinfo set curinfo(_NO2ENT) 0 set tipson [baltip::cget -on] baltip::configure -on $al(TIPS,Projects) ::apave::APave create $obPrj $win $obPrj makeWindow $win.fra "$al(MC,projects) :: $::alited::PRJDIR" set nbk $win.fra.fraR.nbk $obPrj paveWindow $win.fra [MainFrame] $nbk.f1 [Tab1] $nbk.f2 [Tab2] $nbk.f3 [Tab3] $nbk.f4 [Tab4] $nbk.f5 [Tab5] set tree [$obPrj TreePrj] $tree heading C1 -text $al(MC,projects) if {$oldTab ne {}} {$nbk select $oldTab} UpdateTree ::apave::bindToEvent $tree <<TreeviewSelect>> alited::project::Select bind $win <$al(acc_2)> "alited::ini::ToolByKey $nbk ToolPrjEM" bind $win <$al(acc_3)> "alited::ini::ToolByKey $nbk ToolPrjRun" bind $tree <Delete> alited::project::Delete bind $tree <Double-Button-1> alited::project::ProjectEnter bind $tree <Return> alited::project::ProjectEnter foreach ev {KeyPress ButtonPress} { bind $tree <$ev> {+ alited::project::KeyOnTree %K} } bind $win <F1> "[$obPrj ButHelp] invoke" bind [$obPrj LabMess] <Button-1> alited::project::ProcMessage set lbx [$obPrj LbxFlist] foreach a {a A} { bind $lbx <Control-$a> alited::project::SelectAllFiles } bind $lbx <Double-Button-1> {alited::project::OpenFile %y} ::baltip tip $lbx {alited::project::TipOnFile %i} -shiftX 10 after 500 alited::project::HelpMe ;# show an introduction after a short pause set prjtex [$obPrj TexPrj] bind $prjtex <FocusOut> alited::project::SaveNotes if {$ilast>-1} {Select $ilast} $obPrj displayText [$obPrj TexTemplate] $al(PTP,text) alited::ini::HighlightFileText $prjtex .md 0 -cmdpos ::apave::None set res [$obPrj showModal $win -geometry $geo -minsize {600 400} -resizable 1 -onclose alited::project::Cancel -focus [$obPrj TreePrj]] set oldTab [$nbk select] set al(PTP,text) [string trimright [[$obPrj TexTemplate] get 1.0 end]] if {[llength $res] < 2} {set res ""} # save the new geometry of the dialogue set geo [wm geometry $win] alited::main::ShowHeader yes baltip::configure {*}$tipson ::klnd::clearup array unset curinfo * catch {destroy $win} $obPrj destroy return $res }
Runs Projects dialogue.
| if yes, checks for outdated TODOs; optional, default yes |
proc ::alited::project::_run {{checktodo yes}} { # Runs Projects dialogue. # checktodo - if yes, checks for outdated TODOs namespace upvar ::alited al al variable win variable msgtodo variable updateGUI variable saveini if {[winfo exists $win]} return set updateGUI [set saveini no] set msgtodo {} update ;# if run from menu: there may be unupdated space under it (in some DE) SaveSettings GetProjects if {$checktodo && ![IsOutdated $al(prjname)]} { after 200 { if {[set prj [alited::project::CheckOutdated]] ne {}} { alited::project::Select $::alited::project::prjinfo($prj,ID) } } } after 200 alited::project::OnProjectEnter set res [_create] if {$updateGUI} alited::main::UpdateAll ;# settings may be changed as for GUI if {$saveini} alited::ini::SaveIni }
"Add project" button's handler.
| if yes, shows total number of files; optional, default yes |
Returns yes, if the project is successfully added.
proc ::alited::project::Add {{showtotals yes}} { # "Add project" button's handler. # showtotals - if yes, shows total number of files # Returns yes, if the project is successfully added. namespace upvar ::alited al al OPTS OPTS variable prjlist variable prjinfo SaveNotes if {![ValidProject] || [ExistingProject yes] ne {}} {return no} set al(tablist) [list] TabFileInfo set pname $al(prjname) set proot $al(prjroot) set al(prjfile) [ProjectFileName $pname] set al(prjbeforerun) {} if {$al(PRJDEFAULT)} { # use project defaults from "Setup/Common/Projects", except for prjname & prjroot foreach opt $OPTS { catch {set al($opt) $al(DEFAULT,$opt)} } set al(prjname) $pname set al(prjroot) $proot } alited::ini::SaveIni yes ;# to initialize ini-file foreach opt $OPTS { set prjinfo($pname,$opt) $al($opt) } set prjinfo($pname,prjrem) {} ;# reminders PutProjectOpts $al(prjfile) $al(prjfile) no GetProjects UpdateTree Select $prjinfo($pname,ID) UpdateMsg [string map [list %n $pname] $al(MC,prjnew)] $showtotals return yes }
Actions after opening/closing files.
proc ::alited::project::afterOpenCloseFiles {} { # Actions after opening/closing files. variable obPrj set flist [$obPrj LbxFlist] set fsels [$flist curselection] set item [Selected index] GetProjects UpdateTree Select $item focusTree foreach fsel $fsels { after 300 $flist selection set $fsel $fsel } }
'Cancel' button handler.
| possible arguments |
proc ::alited::project::Cancel {args} { # 'Cancel' button handler. # args - possible arguments variable obPrj variable win alited::CloseDlg SaveData SaveNotes RestoreSettings $obPrj res $win 0 }
"Change project" button's handler.
proc ::alited::project::Change {} { # "Change project" button's handler. namespace upvar ::alited al al variable obPrj variable curinfo variable prjlist variable prjinfo variable updateGUI SaveNotes if {[set isel [Selected index]] eq {}} return if {![ValidProject]} return for {set i 0} {$i<[llength $prjlist]} {incr i} { if {$i!=$isel && [lindex $prjlist $i] eq $al(prjname)} { set msg [string map [list %n $al(prjname)] $al(MC,prjexists)] Message $msg 4 return } } set oldprj [lindex $prjlist $isel] set newprj $al(prjname) set prjinfo($newprj,tablist) $prjinfo($oldprj,tablist) catch {unset prjinfo($oldprj,tablist)} set oldname [ProjectFileName $oldprj] set prjlist [lreplace $prjlist $isel $isel $newprj] set fname [ProjectFileName $newprj] if {$newprj eq $curinfo(prjname)} SaveSettings if {$oldprj eq $curinfo(prjname)} { set curinfo(prjname) $newprj set curinfo(prjfile) $fname } set prjinfo($newprj,prjrem) $prjinfo($oldprj,prjrem) ;# reminders PutProjectOpts $fname $oldname yes GetProjects UpdateTree Select $prjinfo($newprj,ID) set updateGUI yes UpdateMsg [string map [list %n [lindex $prjlist $isel]] $al(MC,prjupd)] }
Checks if the root directory exists. If no, tries to create it.
Returns yes, if all is OK.
proc ::alited::project::CheckNewDir {} { # Checks if the root directory exists. If no, tries to create it. # Returns yes, if all is OK. namespace upvar ::alited al al variable obPrj variable win if {![file exists $al(prjroot)]} { FocusInTab f1 [$obPrj chooserPath Dir] set msg [string map [list %d $al(prjroot)] [msgcat::mc "Directory \"%d\"\ndoesn't exist.\n\nCreate it?"]] if {![alited::msg yesno ques $msg YES -geometry root=$win]} { return no } if {[catch {file mkdir $al(prjroot)} err]} { set msg [msgcat::mc {Error at creating the directory.}] alited::msg ok err [append msg \n\n $err] -geometry root=$win return no } } return yes }
Checks for outdated TODOs of all projects except for the current. Return {} or a name of project with outdated TODOs.
proc ::alited::project::CheckOutdated {} { # Checks for outdated TODOs of all projects except for the current. # Return {} or a name of project with outdated TODOs. variable prjlist foreach prj $prjlist { if {$prj ne $::alited::al(prjname)} { if {[IsOutdated $prj]} {return $prj} } } return {} }
Checks "Regexp of a leaf" field.
proc ::alited::project::CheckPrjLeaf {} { # Checks "Regexp of a leaf" field. namespace upvar ::alited al al if {$al(prjleafRE) eq {}} { set al(prjleafRE) [string trimright $al(RE,leaf)] } }
Enables/disables the "Regexp of a leaf" field.
proc ::alited::project::CheckPrjUseLeaf {} { # Enables/disables the "Regexp of a leaf" field. namespace upvar ::alited al al variable obPrj CheckPrjLeaf set al(prjuseleafRE) [string is true -strict $al(prjuseleafRE)] if {$al(prjuseleafRE)} {set _ normal} {set _ disabled} [$obPrj EntLf] configure -state $_ }
Removes spec.characters from a project name (sort of normalizing it).
Returns yes, if the name is "correct" (no char replacements made).
proc ::alited::project::CheckProjectName {} { # Removes spec.characters from a project name (sort of normalizing it). # Returns yes, if the name is "correct" (no char replacements made). namespace upvar ::alited al al set oldname $al(prjname) set al(prjname) [::apave::NormalizeFileName $al(prjname)] return [expr {$oldname eq $al(prjname)}] }
Sets checks of "Commands / Run for all".
proc ::alited::project::ChecksCom {} { # Sets checks of "Commands / Run for all". namespace upvar ::alited al al for {set i 1} {$i<=$al(cmdNum)} {incr i} { set al(PTP,comch$i) $al(PTP,chbClearCom) } }
Sets checks of "Commands / Run for project".
proc ::alited::project::ChecksRun {} { # Sets checks of "Commands / Run for project". namespace upvar ::alited al al for {set i 1} {$i<=$al(cmdNum)} {incr i} { set al(PTP,runch$i) $al(PTP,chbClearRun) } }
Formats date in seconds.
| date in seconds |
proc ::alited::project::ClockFormat {secs} { # Formats date in seconds. # secs - date in seconds variable klnddata return [clock format $secs -format $klnddata(dateformat)] }
Scans date to get date in seconds.
| date |
proc ::alited::project::ClockScan {d} { # Scans date to get date in seconds. # d - date variable klnddata return [clock scan $d -format $klnddata(dateformat)] }
Extracts year, month, day from date.
| date |
proc ::alited::project::ClockYMD {d} { # Extracts year, month, day from date. # d - date return [split [ClockFormat $d] /] }
Closes selected files of listbox. Files are closed in a currently open project.
proc ::alited::project::CloseSelFiles {} { # Closes selected files of listbox. # Files are closed in a currently open project. namespace upvar ::alited al al variable prjinfo variable curinfo if {[set pname [ExistingProject no]] eq {}} return set prj $al(prjname) set cprj $curinfo(prjname) lassign [SelFiles] lbx selidx if {$lbx ne {}} { set closecurr no set fnamecurr [alited::bar::FileName] foreach idx $selidx { set fname [$lbx get $idx] if {[alited::file::IsNoName $fname]} continue if {[set TID [alited::bar::FileTID $fname]] ne {}} { if {$fname eq $fnamecurr} { set closecurr yes } else { alited::bar::BAR $TID close no } } if {$prj eq $cprj && [set i [lsearch -index 0 -exact $prjinfo($cprj,tablist) $fname]]>=0} { set prjinfo($cprj,tablist) [lreplace $prjinfo($cprj,tablist) $i $i] } } set al(prjname) $cprj if {$closecurr && [set TID [alited::bar::FileTID $fnamecurr]] ne {}} { alited::bar::BAR $TID close ;# this should be last to check for "No name" tab } alited::bar::BAR draw if {$prj eq $cprj} { set al(tablist) $prjinfo($cprj,tablist) TabFileInfo } set al(prjname) $prj afterOpenCloseFiles } }
Gets a current file of file listbox.
Returns file name of first selected file or 1st in the list, if no selection.
proc ::alited::project::CurrentFile {} { # Gets a current file of file listbox. # Returns file name of first selected file or 1st in the list, if no selection. variable obPrj set lbx [$obPrj LbxFlist] if {[catch { if {[llength [set selidx [$lbx curselection]]]} { set idx [lindex $selidx 0] } else { set idx 0 } set res [$lbx get $idx] }]} { set res {} } return $res }
Gets a current project name, from a current item of project list.
proc ::alited::project::CurrProject {} { # Gets a current project name, from a current item of project list. variable obPrj variable prjlist set prj {} catch { set tree [$obPrj TreePrj] set item [Selected item no] set isel [$tree index $item] set prj [lindex $prjlist $isel] } return $prj }
"Delete project" button's handler.
proc ::alited::project::Delete {} { # "Delete project" button's handler. namespace upvar ::alited al al variable prjlist variable prjinfo variable win variable curinfo if {[set isel [Selected index]] eq {}} return set geo "-centerme $win" set nametodel [lindex $prjlist $isel] if {$nametodel eq $curinfo(prjname)} { Message $al(MC,prjcantdel) 4 return } set msg [string map [list %n $nametodel] $al(MC,prjdelq)] if {![alited::msg yesno ques $msg NO {*}$geo]} { return } if {[catch {file delete [ProjectFileName $nametodel]} err]} { alited::msg ok err $err {*}$geo return } catch {file delete [NotesFile $nametodel]} catch {file delete [RemsFile $nametodel]} if {[set llen [llength $prjlist]] && $isel>=$llen} { set isel [incr llen -1] } GetProjects UpdateTree Select $isel Message [string map [list %n $nametodel] $al(MC,prjdel2)] 3 }
Deletes a template name from the list of project templates.
proc ::alited::project::DeleteFromTplList {} { # Deletes a template name from the list of project templates. variable obPrj set cbx [$obPrj CbxTpl] RemoveFromTplList [string trim [$cbx get]] $cbx configure -values $::alited::al(PTP,names) $cbx set {} }
Detaches selected files.
proc ::alited::project::DetachSelFiles {} { # Detaches selected files. lassign [SelFiles] lbx selidx set fnames [list] if {$lbx ne {}} { foreach idx $selidx {lappend fnames [$lbx get $idx]} } alited::file::Detach $fnames }
Checks if a project (of entry field) exists.
| yes, if message on existing, else on non-existing project |
Returns a project name if it exists or {} otherwise.
proc ::alited::project::ExistingProject {msgOnExist} { # Checks if a project (of entry field) exists. # msgOnExist - yes, if message on existing, else on non-existing project # Returns a project name if it exists or {} otherwise. namespace upvar ::alited al al variable obPrj variable prjlist set pname $al(prjname) if {[lsearch -exact $prjlist $pname]>-1} { if {$msgOnExist} { FocusInTab f1 [$obPrj EntName] set msg [string map [list %n $pname] $al(MC,prjexists)] Message $msg 4 } } else { if {!$msgOnExist} { FocusInTab f1 [$obPrj EntName] set msg [msgcat::mc "A project \"%n\" doesn't exists. Hit \[+\] button to create it."] set msg [string map [list %n $pname] $msg] Message $msg 4 } set pname {} } return $pname }
Focuses on a widget in a tab.
| the tab's path |
| the widget's path |
proc ::alited::project::FocusInTab {tab wid} { # Focuses on a widget in a tab. # tab - the tab's path # wid - the widget's path variable win $win.fra.fraR.nbk select $win.fra.fraR.nbk.$tab focus $wid }
Sets focus on the treeview.
proc ::alited::project::focusTree {} { # Sets focus on the treeview. variable win variable obPrj focus $win focus [$obPrj TreePrj] }
Gets a name and a value from a line of form "name=value".
| the line |
proc ::alited::project::GetOptVal {line} { # Gets a name and a value from a line of form "name=value". # line - the line if {[set i [string first = $line]]>-1} { return [list [string range $line 0 $i-1] [string range $line $i+1 end]] } return [list] }
Reads a project's settings from a project settings file.
| the project settings file's name |
proc ::alited::project::GetProjectOpts {fname} { # Reads a project's settings from a project settings file. # fname - the project settings file's name namespace upvar ::alited al al OPTS OPTS DIR DIR variable prjlist variable prjinfo variable curinfo set pname [ProjectName $fname] # save project names to 'prjlist' variable to display it by treeview widget lappend prjlist $pname # save project files' settings in prjinfo array set filecont [readTextFile $fname] foreach opt $OPTS { catch {set prjinfo($pname,$opt) $prjinfo(*DEFAULT*,$opt)} ;# defaults } set prjinfo($pname,tablist) [list] if {[set currentprj [expr {$curinfo(prjname) eq $pname}]]} { foreach tab [alited::bar::BAR listTab] { set tid [lindex $tab 0] if {[set val [alited::bar::FileName $tid]] ne {}} { lappend prjinfo($pname,tablist) $val } } } set prjinfo($pname,prjroot) $DIR foreach line [textsplit $filecont] { lassign [GetOptVal $line] opt val if {[lsearch $OPTS $opt]>-1} { set prjinfo($pname,$opt) [alited::ProcEOL $val in] } elseif {$opt eq {tab} && !$currentprj && $val ne {}} { lappend prjinfo($pname,tablist) $val } } set prjinfo($pname,prjfile) $fname set prjinfo($pname,prjname) $pname set al(tablist) $prjinfo($pname,tablist) return $pname }
Reads settings of all projects.
proc ::alited::project::GetProjects {} { # Reads settings of all projects. namespace upvar ::alited al al PRJEXT PRJEXT variable prjlist variable ilast set prjlist [list] set i [set ilast 0] alited::tree::PrepareDirectoryContents foreach finfo [alited::tree::GetDirectoryContents $::alited::PRJDIR] { set fname [lindex $finfo 2] if {[file extension $fname] eq $PRJEXT} { if {[GetProjectOpts $fname] eq $al(prjname)} { set ilast $i } incr i } } }
'Help' button handler.
proc ::alited::project::Help {} { # 'Help' button handler. variable win set th {} set ts [string range [$win.fra.fraR.nbk select] end-1 end] switch $ts { f2 - f3 - f4 - f5 {set th [string index $ts end]} } alited::Help $win $th }
'Help' for start.
proc ::alited::project::HelpMe {} { # 'Help' for start. variable win alited::HelpMe $win }
Checks for outdated TODOs of a project.
| project's name |
| if yes, gets also date and todo; optional, default no |
Returns 0, if no todo for the project, 1 otherwise; if todo=yes, adds also date and todo outdated (if there is).
proc ::alited::project::IsOutdated {prj {todo no}} { # Checks for outdated TODOs of a project. # prj - project's name # todo - if yes, gets also date and todo # Returns 0, if no todo for the project, 1 otherwise; if todo=yes, adds also date and todo outdated (if there is). set rems [SortRems [ReadRems $prj]] set res [lindex $rems 2] if {$todo} { lappend res {*}[lindex $rems 1 0] } return $res }
Handles key press on the tree.
| key |
proc ::alited::project::KeyOnTree {K} { # Handles key press on the tree. # K - key variable prjlist Message {} set icur [Selected index no] if {![string is integer -strict $icur]} return foreach i [list [incr icur] 0] { foreach pr [lrange $prjlist $i end] { if {![string compare -nocase $K [string index $pr 0]]} { Select $i return } incr i } } }
Fire an event handler (paste/undo/redo) on a reminder.
| event to fire |
Clears a reminder.
proc ::alited::project::Klnd_delete {} { # Clears a reminder. variable obPrj [$obPrj TexKlnd] replace 1.0 end {} }
Moves current TODO to a new date.
| text widget of TODO |
| text of TODO |
| new date (in seconds) |
proc ::alited::project::Klnd_moveTODO {wrem todo date} { # Moves current TODO to a new date. # wrem - text widget of TODO # todo - text of TODO # date - new date (in seconds) variable klnddata # get TODO of new date lassign [ClockYMD $date] y m d KlndClick $y $m $d set todonew [string trimright [$wrem get 1.0 end]] if {$todonew ne {}} {append todonew \n} # add the moved TODO to the new TODO append todonew $todo # select the new date set klnddata(SAVEDATE) [ClockFormat $date] KlndDay $date no # update the new TODO $wrem replace 1.0 end $todonew }
Moves a reminder to days.
| days to move to; optional, default 1 |
proc ::alited::project::Klnd_next {{days 1}} { # Moves a reminder to *days*. # days - days to move to variable obPrj variable klnddata set wrem [$obPrj TexKlnd] set todo [string trimright [$wrem get 1.0 end]] if {$todo eq {}} { bell FocusInTab f1 $wrem return } Klnd_delete set date [ClockScan $klnddata(SAVEDATE)] set date [clock add $date $days days] after 100 [list alited::project::Klnd_moveTODO $wrem $todo $date] }
Moves a reminder to 7 days.
proc ::alited::project::Klnd_next2 {} { # Moves a reminder to 7 days. Klnd_next 7 }
Pastes a text to a reminder.
proc ::alited::project::Klnd_paste {} { # Pastes a text to a reminder. Klnd_button <<Paste>> }
Moves a reminder back to 1 day.
proc ::alited::project::Klnd_previous {} { # Moves a reminder back to 1 day. Klnd_next -1 }
Moves a reminder back to 7 days.
proc ::alited::project::Klnd_previous2 {} { # Moves a reminder back to 7 days. Klnd_next -7 }
Redoes changes of a reminder.
proc ::alited::project::Klnd_redo {} { # Redoes changes of a reminder. Klnd_button <<Redo>> }
Saves a reminder on a date.
proc ::alited::project::Klnd_save {} { # Saves a reminder on a date. variable obPrj variable prjinfo variable klnddata set wtxt [$obPrj TexKlnd] if {[set prjname $klnddata(SAVEPRJ)] eq {}} return set text [string trim [$wtxt get 1.0 end]] set date $klnddata(SAVEDATE) set info [list $date $text "TODO opt."] ;# + possible options for future set i [KlndSearch $date $prjname] if {$text eq {}} { if {$i>-1} { set prjinfo($prjname,prjrem) [lreplace $prjinfo($prjname,prjrem) $i $i] } KlndBorderText } elseif {$i>-1} { set prjinfo($prjname,prjrem) [lreplace $prjinfo($prjname,prjrem) $i $i $info] } else { lappend prjinfo($prjname,prjrem) $info } ::klnd::update {} {} {} $prjinfo($prjname,prjrem) set fcont $prjinfo($prjname,prjrem) writeTextFile [RemsFile $prjname] fcont 0 0 }
Undoes changes of a reminder.
proc ::alited::project::Klnd_undo {} { # Undoes changes of a reminder. Klnd_button <<Undo>> }
Highlights/unhighlights a reminder's border.
| color of border; optional, default "" |
proc ::alited::project::KlndBorderText {{clr {}}} { # Highlights/unhighlights a reminder's border. # clr - color of border variable obPrj if {$clr eq {}} {set clr [lindex [obj csGet] 8]} [$obPrj TexKlnd] configure -highlightbackground $clr }
Processes a click on a calendar day.
| year |
| month |
| day |
proc ::alited::project::KlndClick {y m d} { # Processes a click on a calendar day. # y - year # m - month # d - day variable obPrj variable klnddata set klnddata(date) [KlndOutDate $y $m $d] # first, save a previous reminder at need set klnddata(SAVEDATE) $klnddata(date) set klnddata(SAVEPRJ) [CurrProject] # then display a new reminder's text set klndtex [$obPrj TexKlnd] $obPrj displayText $klndtex [KlndText $klnddata(date)] alited::ini::HighlightFileText $klndtex .md 0 -cmdpos ::apave::None -cmd alited::project::KlndTextModified [$obPrj LabKlndDate] configure -text [KlndDate $klnddata(date)] }
Formats a calendar date by alited's format (Preferences/Templates).
| the date to be formatted |
proc ::alited::project::KlndDate {date} { # Formats a calendar date by alited's format (Preferences/Templates). # date - the date to be formatted set seconds [ClockScan $date] return [alited::tool::FormatDate $seconds] }
Selects a date of reminder.
| date in seconds to select |
| if yes, make the month blink; optional, default yes |
proc ::alited::project::KlndDay {dsec {doblink yes}} { # Selects a date of reminder. # dsec - date in seconds to select # doblink - if yes, make the month blink lassign [ClockYMD $dsec] y m d set m [string trimleft $m { 0}] set d [string trimleft $d { 0}] ::klnd::selectedDay {} $y $m $d $doblink }
Selects a date of reminder before a current one.
| date in seconds to select |
proc ::alited::project::KlndDayRem {dmin} { # Selects a date of reminder before a current one. # dmin - date in seconds to select KlndDay $dmin after idle {::alited::project::KlndBorderText red} }
Gets a date in seconds.
| year; optional, default "" |
| month; optional, default "" |
| day; optional, default "" |
If y is omitted or y/m/d not valid, gets a current date in seconds.
proc ::alited::project::KlndInDate {{y {}} {m {}} {d {}}} { # Gets a date in seconds. # y - year # m - month # d - day # If *y* is omitted or y/m/d not valid, gets a current date in seconds. if {$y ne {}} { if {[catch {set date [ClockScan $y/$m/$d]}]} { set y {} } } if {$y eq {}} {set date [clock seconds]} return $date }
Gets a date formatted.
| year; optional, default "" |
| month; optional, default "" |
| day; optional, default "" |
If y is omitted or y/m/d not valid, gets a current date formatted.
proc ::alited::project::KlndOutDate {{y {}} {m {}} {d {}}} { # Gets a date formatted. # y - year # m - month # d - day # If *y* is omitted or y/m/d not valid, gets a current date formatted. return [ClockFormat [KlndInDate $y $m $d]] }
Handles a popup menu for the calendar.
| day widget clicked |
| year |
| month |
| day |
| X-coordinate of pointer |
| Y-coordinate of pointer |
proc ::alited::project::KlndPopup {w y m d X Y} { # Handles a popup menu for the calendar. # w - day widget clicked # y - year # m - month # d - day # X - X-coordinate of pointer # Y - Y-coordinate of pointer variable obPrj KlndClick $y $m $d ::klnd::selectedDay {} $y $m $d no set popm $w.popup catch {destroy $popm} menu $popm -tearoff 0 foreach img {delete - previous2 previous - next next2} { if {$img eq {-}} { $popm add separator } else { $popm add command -image alimg_$img -compound left -label $::alited::al(MC,prjT$img) -command alited::project::Klnd_$img } } $obPrj themePopup $popm tk_popup $popm $X $Y KlndUpdate }
Search a date in calendar data.
| Not documented. |
| Not documented. |
Returns index of found item or -1 if not found.
proc ::alited::project::KlndSearch {date prjname} { # Search a date in calendar data. # Returns index of found item or -1 if not found. variable prjinfo variable klnddata set res -1 catch { set res [lsearch -index 0 -exact $prjinfo($prjname,prjrem) $date] } return $res }
Gets a reminder text for a date.
| date |
proc ::alited::project::KlndText {dt} { # Gets a reminder text for a date. # dt - date namespace upvar ::alited al al variable prjinfo if {[set i [KlndSearch $dt $al(prjname)]]>-1} { return [lindex $prjinfo($al(prjname),prjrem) $i 1] } return {} }
Processes modifications of calendar text.
| text's path |
| not used arguments |
proc ::alited::project::KlndTextModified {wtxt args} { # Processes modifications of calendar text. # wtxt - text's path # args - not used arguments namespace upvar ::alited al al set aft _KLND_TextModified catch {after cancel $al($aft)} set al($aft) [after idle alited::project::Klnd_save] }
Updates calendar data.
proc ::alited::project::KlndUpdate {} { # Updates calendar data. namespace upvar ::alited al al variable prjinfo if {![info exists prjinfo($al(prjname),prjrem)]} { set prjinfo($al(prjname),prjrem) {} } ::klnd::update {} {} {} $prjinfo($al(prjname),prjrem) lassign [::klnd::selectedDay] y m d KlndClick $y $m $d }
Runs a popup menu on the project files listbox.
| x-coordinate of mouse pointer |
| y-coordinate of mouse pointer |
proc ::alited::project::LbxPopup {X Y} { # Runs a popup menu on the project files listbox. # X - x-coordinate of mouse pointer # Y - y-coordinate of mouse pointer variable obPrj variable filefilter set popm [$obPrj LbxFlist].popup catch {destroy $popm} lassign [SelFiles] lbx selidx if {$filefilter eq {}} {set state normal} {set state disabled} if {[llength $selidx]} {set stateS normal} {set stateS [set state disabled]} menu $popm -tearoff 0 $popm add command -label $::alited::al(MC,openselfile) -command alited::project::OpenSelFiles -state $stateS $popm add command -label [msgcat::mc {Close Selected Files}] -command alited::project::CloseSelFiles -state $state $popm add separator $popm add command -label $::alited::al(MC,detachsel) -command alited::project::DetachSelFiles -state $stateS $popm add separator $popm add command -label [msgcat::mc {Select All}] -command alited::project::SelectAllFiles -accelerator Ctrl+A baltip::sleep 1000 $obPrj themePopup $popm tk_popup $popm $X $Y }
Creates a main frame of "Project" dialogue.
proc ::alited::project::MainFrame {} { # Creates a main frame of "Project" dialogue. return { {fraTreePrj - - 10 1 {-st nswe -pady 4 -rw 1}} {.TreePrj - - - - {pack -side left -expand 1 -fill both} {-h 16 -show headings -columns {C1} -displaycolumns {C1} -popup {alited::project::PopupMenu %x %y %X %Y}}} {.sbvPrjs + L - - {pack -side left -fill both}} {fraR fraTreePrj L 10 1 {-st nsew -cw 1 -pady 4}} {fraR.nbk - - - - {pack -side top -expand 1 -fill both} { f1 {-text {$al(MC,info)}} f2 {-text {$al(MC,prjOptions)}} f3 {-text Templates} f4 {-text Commands} f5 {-text Files} -traverse yes -select f1 }} {fraB1 fraTreePrj T 1 1 {-st nsew}} {.btTad - - - - {pack -side left -anchor n} {-com alited::project::Add -tip {$::alited::al(MC,prjadd)} -image alimg_add-big}} {.btTch - - - - {pack -side left} {-com alited::project::Change -tip {$::alited::al(MC,prjchg)} -image alimg_change-big}} {.btTdel - - - - {pack -side left} {-com alited::project::Delete -tip {$::alited::al(MC,prjdel1)} -image alimg_delete-big}} {.h_ - - - - {pack -side left -expand 1}} {.btTtpl - - - - {pack -side left} {-com alited::project::Template -tip {$::alited::al(MC,CrTemplPrj)} -image alimg_plus-big}} {.btTtview - - - - {pack -side left -padx 4} {-image alimg_folder-big -com alited::project::ViewDir -tip {$::alited::al(MC,ViewDir)}}} {LabMess fraB1 L 1 1 {-st nsew -pady 0 -padx 3} {-style TLabelFS}} {seh fraB1 T 1 2 {-st nsew -pady 2}} {fraB2 + T 1 2 {-st nsew} {-padding {2 2}}} {.ButHelp - - - - {pack -side left -anchor s -padx 2} {-t {$::alited::al(MC,help)} -tip F1 -com alited::project::Help}} {.h_ - - - - {pack -side left -expand 1 -fill both -padx 8} {-w 50}} {.ButOK - - - - {pack -side left -anchor s -padx 2} {-t {$::alited::al(MC,select)} -com alited::project::Ok}} {.butCancel - - - - {pack -side left -anchor s} {-t Cancel -com alited::project::Cancel}} } }
Displays a message in statusbar of projects dialogue.
| message |
| mode of Message; optional, default 2 |
proc ::alited::project::Message {msg {mode 2}} { # Displays a message in statusbar of projects dialogue. # msg - message # mode - mode of Message variable obPrj alited::Message $msg $mode [$obPrj LabMess] }
Gets a file name of notes.
| project's name |
proc ::alited::project::NotesFile {prj} { # Gets a file name of notes. # prj - project's name return [file join $::alited::PRJDIR $prj-notes.txt] }
'OK' button handler.
| possible arguments |
proc ::alited::project::Ok {args} { # 'OK' button handler. # args - possible arguments namespace upvar ::alited al al obPav obPav _dirtree _dirtree variable obPrj variable win variable prjlist variable prjinfo variable curinfo variable updateGUI alited::CloseDlg if {$curinfo(_NO2ENT)} { # disables entering twice (at multiple double-clicks) return } if {[set isel [Selected index]] eq {} || ![ValidProject]} { focusTree return } if {![ValidProject]} return if {[set pname [ExistingProject no]] eq {}} return if {[set N [llength [alited::bar::BAR listFlag m]]]} { set msg [msgcat::mc "All modified files (%n) will be saved.\n\nDo you agree?"] set msg [string map [list %n $N] $msg] if {![alited::msg yesno ques $msg YES -centerme $win]} return } if {![alited::file::SaveAll]} { $obPrj res $win 0 return } if {[set N [llength [alited::bar::BAR cget -select]]]} { set msg [msgcat::mc "All selected files (%n) will remain open\nin the project you are switching to.\n\nDo you agree?"] set msg [string map [list %n $N] $msg] if {![alited::msg yesno ques $msg YES -centerme $win]} return } ::apave::withdraw $win set curinfo(_NO2ENT) 1 set fname [ProjectFileName $pname] catch {alited::run::Cancel} ;# possibly open Run dialogue: discard its settings RestoreSettings alited::ini::SaveIni # setting al(project::Ok) to skip "No name" & SaveCurrentIni at closing all if {[set al(project::Ok) 1]} { set tabs [alited::bar::BAR listTab] alited::file::CloseAll 1 -skipsel ;# the selected tabs aren't closed set selfiles [list] ;# -> get their file names to reopen afterwards foreach tid [alited::bar::BAR listFlag s] { lappend selfiles [alited::bar::FileName $tid] } alited::file::CloseAll 1 ;# close all tabs set comms [info commands] foreach tab $tabs { set tab [lindex $tab 0] foreach c $comms { if {[regexp "\[._\]$tab\(\[.\]internal\$|\$\)" $c]} { catch {destroy $c} catch {rename $c {}} } } } $obPav untouchWidgets clear *btsBar* ;# remove bartabs references to the untouched set al(prjname) $pname set al(prjfile) $fname alited::ini::ReadIni $fname alited::bar::FillBar [$obPav BtsBar] set fnames [list] for {set i [llength $selfiles]} {$i} {} { ;# reopen selected files of previous project incr i -1 set fname [lindex $selfiles $i] if {[alited::bar::FileTID $fname] eq {}} { lappend fnames $fname } } set TID [lindex [alited::bar::BAR listTab] $al(curtab) 0] catch {alited::bar::BAR $TID show no no} if {[llength $fnames]} {alited::file::OpenFile $fnames yes yes} alited::main::UpdateProjectInfo alited::ini::GetUserDirs alited::file::MakeThemHighlighted alited::favor::ShowFavVisit [$obPav Tree] selection set {} ;# new project - no group selected update } unset al(project::Ok) alited::file::CheckForNew yes after 200 {after idle alited::main::FocusText} set _dirtree [list] ;# free its memory if {!$al(TREE,isunits)} { after 200 {after idle {alited::tree::RecreateTree; alited::tree::SeeTreeItem}} } set updateGUI no ;# GUI will be updating anyway $obPrj res $win 1 }
Actions on entering a project.
proc ::alited::project::OnProjectEnter {} { # Actions on entering a project. variable win variable prjinfo variable msgtodo variable itemtodo lassign [SortRems $prjinfo($::alited::al(prjname),prjrem)] dmin - outdated if {$outdated} { set tab1 $win.fra.fraR.nbk.f1 if {[$win.fra.fraR.nbk select] ne $tab1} { $win.fra.fraR.nbk select $tab1 } KlndDayRem $dmin set msgtodo [msgcat::mc {TODO reminders for the past: %d.}] set dmin [ClockFormat $dmin] set msgtodo [string map [list %d $dmin] $msgtodo] Message $msgtodo 6 set itemtodo [Selected item no] } }
Opens a file of listbox after double clicking.
| y-coordinate of clicking |
proc ::alited::project::OpenFile {y} { # Opens a file of listbox after double clicking. # y - y-coordinate of clicking variable obPrj set lbx [$obPrj LbxFlist] set selid [$lbx nearest $y] if {$selid != -1} { $lbx selection clear 0 end $lbx selection set $selid OpenSelFiles no } }
Opens selected files of listbox.
| if yes, shows a message; optional, default yes |
Files are open in a currently open project.
proc ::alited::project::OpenSelFiles {{showmsg yes}} { # Opens selected files of listbox. # showmsg - if yes, shows a message # Files are open in a currently open project. namespace upvar ::alited al al variable prjinfo variable curinfo set prj $al(prjname) set cprj $curinfo(prjname) set al(prjname) $curinfo(prjname) lassign [SelFiles] lbx selidx if {$lbx ne {}} { update set fnames [list] set balloon {} foreach idx [lreverse $selidx] { set fn [$lbx get $idx] if {[file exists $fn]} { lappend fnames $fn if {[lsearch -index 0 -exact $prjinfo($cprj,tablist) $fn]<0} { set prjinfo($cprj,tablist) [linsert $prjinfo($cprj,tablist) 0 $fn] } } else { set balloon $fn } } set llen [llength $fnames] if {$showmsg} { set msg [string map [list %n $llen] [msgcat::mc {Open files: %n}]] Message $msg 3 } if {$llen} { alited::file::OpenFile $fnames yes yes alited::info::Put } if {$balloon ne {}} { after idle alited::Balloon1 $balloon } } set al(prjname) $prj afterOpenCloseFiles }
Opens a popup menu in the project list.
| x-coordinate to identify an item |
| y-coordinate to identify an item |
| x-coordinate of the click |
| x-coordinate of the click |
proc ::alited::project::PopupMenu {x y X Y} { # Opens a popup menu in the project list. # x - x-coordinate to identify an item # y - y-coordinate to identify an item # X - x-coordinate of the click # Y - x-coordinate of the click namespace upvar ::alited al al variable obPrj variable win set popm $win.popupmenu catch {destroy $popm} menu $popm -tearoff 0 $popm add command -label $al(MC,prjadd) -command alited::project::Add {*}[$obPrj iconA add] $popm add command -label $al(MC,prjchg) -command alited::project::Change {*}[$obPrj iconA change] $popm add command -label $al(MC,prjdel1) -command alited::project::Delete {*}[$obPrj iconA delete] $popm add separator $popm add command -label $al(MC,CrTemplPrj) -command alited::project::Template {*}[$obPrj iconA plus] $popm add command -label $al(MC,ViewDir) -command alited::project::ViewDir {*}[$obPrj iconA OpenFile] $obPrj themePopup $popm tk_popup $popm $X $Y }
Postvalidates the file filter change.
proc ::alited::project::postValidateFilter {} { # Postvalidates the file filter change. variable filefilter variable casefilter variable savedfilefilter variable savedcasefilter if {$savedfilefilter ne $filefilter || $savedcasefilter ne $casefilter} { if {$filefilter eq {}} { TabFileInfo } else { TabFileFilter } set savedfilefilter $filefilter set savedcasefilter $casefilter } }
Prevalidates the file filter change.
proc ::alited::project::preValidateFilter {} { # Prevalidates the file filter change. after idle alited::project::postValidateFilter return 1 }
Handles clicking on message label. Shows the message and if it is about TODO, selects the corresponding project.
proc ::alited::project::ProcMessage {} { # Handles clicking on message label. # Shows the message and if it is about TODO, selects the corresponding project. variable obPrj variable msgtodo variable itemtodo set msg [baltip cget [$obPrj LabMess] -text] if {$msgtodo eq $msg} { Message $msg 6 Select $itemtodo } else { Message $msg 3 } }
Processes double-clicking and pressing Enter on the project list. Cancels selecting projects if there are old reminders.
proc ::alited::project::ProjectEnter {} { # Processes double-clicking and pressing Enter on the project list. # Cancels selecting projects if there are old reminders. OnProjectEnter Ok }
Gets a project file name from a project's name.
| Not documented. |
proc ::alited::project::ProjectFileName {name} { # Gets a project file name from a project's name. namespace upvar ::alited PRJDIR PRJDIR PRJEXT PRJEXT set name [ProjectName [string trim $name]] return [file normalize [file join $PRJDIR "$name$PRJEXT"]] }
Gets a project name from its file name.
| Not documented. |
proc ::alited::project::ProjectName {fname} { # Gets a project name from its file name. namespace upvar ::alited PRJEXT PRJEXT set fname [file tail $fname] if {[string match -nocase *$PRJEXT $fname]} { set fname [file rootname $fname] } return $fname }
Writes a project's settings to a project settings file.
| the project settings file's name |
| old name of the project file |
| yes, if rename of old -notes/-rems |
proc ::alited::project::PutProjectOpts {fname oldname dorename} { # Writes a project's settings to a project settings file. # fname - the project settings file's name # oldname - old name of the project file # dorename - yes, if rename of old -notes/-rems namespace upvar ::alited al al OPTS OPTS variable prjinfo set filecont [readTextFile $oldname] if {$filecont eq {}} { alited::ini::SaveIniPrj set filecont [readTextFile $oldname] } set newcont {} foreach line [textsplit $filecont] { lassign [GetOptVal $line] opt val if {$line eq {[Tabs]}} { foreach tab $al(tablist) { append line \n "tab=$tab" } } elseif {$opt in [list tab rem tablist {*}$OPTS]} { continue } elseif {$opt in {curtab}} { # } elseif {$line eq {[Options]}} { foreach opt $OPTS { if {$opt ni {prjname tablist}} { set val [set al($opt)] append line \n $opt= $val set prjinfo($al(prjname),$opt) [alited::ProcEOL $val in] } } } append newcont $line \n } writeTextFile $fname newcont if {$oldname ne $fname} { catch {file delete $oldname} if {$dorename} { foreach ftyp {notes rems} { set oldtyp [file rootname $oldname]-$ftyp.txt set newtyp [file rootname $fname]-$ftyp.txt catch {file rename $oldtyp $newtyp} } } } }
Reads notes of a project and commands for Commands tab.
| project's name |
proc ::alited::project::ReadNotes {prj} { # Reads notes of a project and commands for Commands tab. # prj - project's name namespace upvar ::alited al al variable obPrj variable COMSEP for {set i 1} {$i<=$al(cmdNum)} {incr i} { set al(PTP,run$i) [set al(PTP,com$i) {}] set al(PTP,runch$i) [set al(PTP,comch$i) 0] } set al(PTP,chbClearRun) 0 set al(PTP,chbClearCom) 0 set irun [set icom 0] set wtxt [$obPrj TexPrj] $wtxt delete 1.0 end set fnotes [NotesFile $prj] if {[file exists $fnotes]} { set cont [readTextFile $fnotes] if {[set ir [string first run1$COMSEP $cont]]>-1} { # get commands for Commands tab (project's and common) foreach com [split [string range $cont $i end] \n] { lassign [split $com $COMSEP] run ch com1 com2 set ch [string is true -strict $ch] if {$com1 ne {}} { set al(PTP,run[incr irun]) $com1 if {$ch} {set al(PTP,runch$irun) [set al(PTP,chbClearRun) 1]} } elseif {$com2 ne {}} { set al(PTP,com[incr icom]) $com2 if {$ch} {set al(PTP,comch$icom) [set al(PTP,chbClearCom) 1]} } } set cont [string range $cont 0 $ir-1] } set cont [string trim $cont] if {$cont ne {}} {$wtxt insert end $cont} } $wtxt edit reset; $wtxt edit modified no }
Reads a file of reminders.
| Not documented. |
proc ::alited::project::ReadRems {prj} { # Reads a file of reminders. variable klnddata set frems [RemsFile $prj] if {[file exists $frems]} { set res [readTextFile $frems] } else { set res [list] } return $res }
Removes a template name from the lists of template data.
| name of template to be removed |
proc ::alited::project::RemoveFromTplList {val} { # Removes a template name from the lists of template data. # val - name of template to be removed namespace upvar ::alited al al if {$val eq {}} return # remove from list of template names if {[set i [lsearch -exact $al(PTP,names) $val]]>-1} { set al(PTP,names) [lreplace $al(PTP,names) $i $i] } # remove from list of template pairs "name contents" if {[set i [lsearch -exact $al(PTP,list) $val]]>-1} { set al(PTP,list) [lreplace $al(PTP,list) $i $i+1] } }
Gets a file name of reminders.
| Not documented. |
proc ::alited::project::RemsFile {prj} { # Gets a file name of reminders. return [file join $::alited::PRJDIR $prj-rems.txt] }
Restores project settings from curinfo array.
proc ::alited::project::RestoreSettings {} { # Restores project settings from curinfo array. namespace upvar ::alited al al OPTS OPTS variable curinfo foreach v $OPTS { set al($v) $curinfo($v) } set al(prjfile) $curinfo(prjfile) TabFileInfo }
Handles running commands of Commands tab.
proc ::alited::project::RunComs {} { # Handles running commands of Commands tab. namespace upvar ::alited al al variable obPrj variable win variable prjlist variable prjinfo SaveNotes [CurrProject] set comtorun {} set comcnt 0 # collect commands executed on the current project if {[info exists prjinfo($al(prjname),prjroot)]} { set dir $prjinfo($al(prjname),prjroot) for {set i 1} {$i<=$al(cmdNum)} {incr i} { if {$al(PTP,runch$i) && $al(PTP,run$i) ne {}} { if {!$comcnt} { append comtorun "cd $dir\n" } append comtorun "$al(PTP,run$i)\n" incr comcnt } } } # collect general commands executed per project foreach prj $prjlist { set dir $prjinfo($prj,prjroot) set com {} for {set i 1} {$i<=$al(cmdNum)} {incr i} { if {$al(PTP,comch$i) && $al(PTP,com$i) ne {}} { if {$com eq {}} { append com "cd $dir\n" } append com "$al(PTP,com$i)\n" incr comcnt } } append comtorun $com } if {$comtorun eq {}} { focus [$obPrj Entrun1] bell } else { set msg [msgcat::mc {%n commands will be executed!}] set msg [string map [list %n $comcnt] $msg] if {[alited::msg yesno ques $msg YES -centerme $win]} { alited::tool::Run_in_e_menu $comtorun } } }
Saves some data.
proc ::alited::project::SaveData {} { # Saves some data. variable ilast set ilast [Selected index no] }
For a current item of project list, saves a file of notes and Commands tab's commands.
| project's name; optional, default "" |
proc ::alited::project::SaveNotes {{prj {}}} { # For a current item of project list, saves a file of notes and Commands tab's commands. # prj - project's name namespace upvar ::alited al al variable obPrj variable klnddata variable COMSEP if {$prj eq {}} {set prj $klnddata(SAVEPRJ)} if {$prj ne {}} { set fnotes [NotesFile $prj] set fcont [string trimright [[$obPrj TexPrj] get 1.0 end]] if {[catch {set indent [string repeat { } $::alited::al(prjindent)]}]} {set indent { }} set fcont [string map [list $COMSEP $indent] $fcont] set fcontOrig $fcont for {set i 1} {$i<=$al(cmdNum)} {incr i} { set com [string trim $al(PTP,run$i)] set al(PTP,run$i) {} if {$com ne {}} { incr irun ;# starting commands from #1 append fcont \nrun$irun$COMSEP$al(PTP,runch$i)$COMSEP$com set al(PTP,run$i) $com } } for {set i 1} {$i<=$al(cmdNum)} {incr i} { set com [string trim $al(PTP,com$i)] set al(PTP,com$i) {} if {$com ne {}} { incr irun ;# starting commands from #1 append fcont \nrun$irun$COMSEP$al(PTP,comch$i)$COMSEP$COMSEP$com set al(PTP,com$i) $com } } if {$fcontOrig eq {} && $fcont ne {}} { set fcont __$al(MC,coms)__$fcont } writeTextFile $fnotes fcont 0 0 } }
Saves project settings to curinfo array.
proc ::alited::project::SaveSettings {} { # Saves project settings to curinfo array. namespace upvar ::alited al al OPTS OPTS variable curinfo foreach v $OPTS { set curinfo($v) $al($v) } set curinfo(prjfile) $al(prjfile) }
Handles a selection in a list of projects.
| Not documented; optional, default "" |
proc ::alited::project::Select {{item {}}} { # Handles a selection in a list of projects. namespace upvar ::alited al al OPTS OPTS variable obPrj variable prjinfo variable klnddata if {$item eq {}} {set item [Selected item no]} if {$item ne {}} { lassign [SelectedPrj $item] tree item prj if {$prj eq {}} return ReadNotes $prj lassign [SortRems [ReadRems $prj]] dmin prjinfo($prj,prjrem) foreach opt $OPTS { if {[catch {set al($opt) $prjinfo($prj,$opt)} e]} { Message $e return } } set al(tablist) $prjinfo($prj,tablist) TabFileInfo if {[$tree selection] ne $item} { $tree selection set $item } if {$dmin>0} { KlndDayRem $dmin } else { KlndDay [clock seconds] no KlndBorderText } ::klnd::blinking no set klnddata(SAVEDATE) {} catch {after cancel $klnddata(AFTERKLND)} set klnddata(AFTERKLND) [after 200 alited::project::KlndUpdate] [$obPrj Labprj] configure -text [msgcat::mc {For project}]\ $al(prjname) set tip [string map [list %f "$al(MC,prjName) $al(prjname)"] $al(MC,alloffile)] ::baltip tip [$obPrj ChbClearRun] $tip after 200 "$tree see $item; $tree focus $item" CheckPrjUseLeaf } }
Selects all files of listbox.
proc ::alited::project::SelectAllFiles {} { # Selects all files of listbox. variable obPrj [$obPrj LbxFlist] selection set 0 end }
Gets a currently selected project's index.
| if "index", selected item's index is returned |
| if "no", no message displayed if there is no selected project; optional, default yes |
proc ::alited::project::Selected {what {domsg yes}} { # Gets a currently selected project's index. # what - if "index", selected item's index is returned # domsg - if "no", no message displayed if there is no selected project variable obPrj variable prjlist set tree [$obPrj TreePrj] if {[set isel [$tree selection]] eq {} && [set isel [$tree focus]] eq {} && $domsg} { Message $::alited::al(MC,prjsel) 4 } if {$isel ne {} && $what eq {index}} { set isel [$tree index $isel] } return $isel }
Gets a project name of selected item.
| selected item |
proc ::alited::project::SelectedPrj {item} { # Gets a project name of selected item. # item - selected item variable obPrj variable prjlist variable prjinfo set tree [$obPrj TreePrj] if {[string is digit $item]} { ;# the item is an index if {$item<0 || $item>=[llength $prjlist]} {return {}} set prj [lindex $prjlist $item] set item $prjinfo($prj,ID) } elseif {![$tree exists $item]} { return {} } set isel [$tree index $item] if {$isel<0 || $isel>=[llength $prjlist]} {return {}} list $tree $item [lindex $prjlist $isel] }
Checks for a selection of file listbox. Returns: list of listbox's path and the selection or {}.
proc ::alited::project::SelFiles {} { # Checks for a selection of file listbox. # Returns: list of listbox's path and the selection or {}. variable obPrj set lbx [$obPrj LbxFlist] if {![llength [set selidx [$lbx curselection]]]} { Message [msgcat::mc {No selected files}] 4 return {} } list $lbx $selidx }
Sorts reminders by date.
| list of reminders |
Returns a list of reminder date before current date, sorted list, flag of outdated reminder.
proc ::alited::project::SortRems {rems} { # Sorts reminders by date. # rems - list of reminders # Returns a list of reminder date before current date, sorted list, flag of outdated reminder. set tmp [list] set dmin [set outdated 0] set dcur [clock add [KlndInDate] $::alited::al(todoahead) day] foreach it $rems { lassign $it d text lassign [split $d /] y m d if {[catch {set d [KlndInDate $y $m $d]}]} { set d [clock seconds] } if {$d<=$dcur && ($dmin==0 || $d<$dmin)} { set dmin $d } lappend tmp [list $d $text] } set rems [list] foreach it [lsort -index 0 $tmp] { lassign $it d text lappend rems [list [ClockFormat $d] $text] } if {$dmin} { if {$dmin<[clock seconds]} { set outdated 1 ;# current day reached } elseif {$dmin<$dcur} { set outdated 2 ;# "ahead" day reached } } list $dmin $rems $outdated }
Sets standard RE for leaf unit.
proc ::alited::project::StdLeafRE {} { # Sets standard RE for leaf unit. namespace upvar ::alited al al set al(prjleafRE) $al(RE,leafDEF) }
Creates a main tab of "Project".
proc ::alited::project::Tab1 {} { # Creates a main tab of "Project". namespace upvar ::alited al al variable klnddata set klnddata(SAVEDATE) [set klnddata(SAVEPRJ) {}] set monofont "[font actual apaveFontMono] -size $al(FONTSIZE,small)" set klnddata(toobar) "LabKlndDate {{} {} {-font {$monofont}}} sev 6" foreach img {delete paste undo redo - previous2 previous next next2} { # -method option for possible disable/enable BuT_alimg_delete etc. if {$img eq {-}} { append klnddata(toobar) " sev 4" continue } append klnddata(toobar) " alimg_$img \{{} -tip {-BALTIP {$al(MC,prjT$img)} -MAXEXP 2@@ -under 4} -com alited::project::Klnd_$img -method yes \}" } set klnddata(vsbltext) yes set klnddata(date) [KlndOutDate] after idle alited::project::KlndUpdate return { {v_ - - 1 1} {fra1 v_ T 1 2 {-st nsew -cw 1}} {.labName - - 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,prjName)} -foreground $al(FG,DEFopts) -font {$::apave::FONTMAINBOLD}}} {.EntName + L 1 1 {-st sw -pady 5} {-tvar ::alited::al(prjname) -w 50}} {.labDir .labName T 1 1 {-st e -pady 8 -padx 3} {-t "Root directory:"}} {.Dir + L 1 9 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(prjroot) -w 50 -validate focus -validatecommand alited::project::ValidateDir}} {lab fra1 T 1 1 {-st w -pady 4 -padx 3} {-t "Notes:"}} {fra2 + T 2 1 {-st nsew -rw 1 -cw 99}} {.TexPrj - - - - {pack -side left -expand 1 -fill both -padx 3} {-h 20 -w 40 -wrap word -tabnext *.spx -tip {-BALTIP {$al(MC,notes)} -MAXEXP 1}}} {.sbv + L - - {pack -side left}} {frasp lab L 1 1 {-st nsew}} {.lab - - - - {pack -side left} {-t {TODO days ahead:}}} {.spx - - - - {pack -side left -padx 8} {-tvar ::alited::al(todoahead) -from 0 -to 365 -w 5 -justify center -com alited::project::Select -validate all -validatecommand {alited::project::ValidateIni %V}}} {fra3 fra2 L 2 1 {-st nsew} {-relief groove -borderwidth 2}} {.seh - - - - {pack -fill x}} {.daT - - - - {pack -fill both} {-tvar ::alited::project::klnddata(date) -com {alited::project::KlndUpdate; alited::project::KlndBorderText} -dateformat "$::alited::al(TPL,%d)" -tip {alited::project::KlndText %D} -weeks $::alited::al(klndweeks) -popup {alited::project::KlndPopup %W %y %m %d %X %Y} -width 3}} {fra3.fra - - - - {pack -fill both -expand 1}} {.seh2 - - - - {pack -side top -fill x}} {.too - - - - {pack -side top} {-relief flat -borderwidth 0 -array {$::alited::project::klnddata(toobar)}}} {.TexKlnd - - - - {pack -side left -fill both -expand 1} {-wrap word -tabnext {alited::Tnext *.texPrj} -w 4 -h 8 -tip {-BALTIP {$al(MC,prjTtext)} -MAXEXP 1}}} } }
Creates Options tab of "Project".
proc ::alited::project::Tab2 {} { # Creates Options tab of "Project". namespace upvar ::alited al al lassign [alited::FgFgBold] fg al(FG,DEFopts) if {!$al(PRJDEFAULT)} { set al(FG,DEFopts) "$fg -afteridle {grid forget %w}" ;# no heading message } return { {v_ - - 1 10} {lab1 + T 1 2 {-st nsew -pady 1 -padx 3} {-t {$al(MC,DEFopts)} -foreground $al(FG,DEFopts) -font {$::apave::FONTMAINBOLD}}} {fra2 + T 1 2 {-st nsew -cw 1}} {.labIgn - - 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,Ign:)}}} {.entIgn + L 1 8 {-st sw -pady 5 -padx 3} {-tvar ::alited::al(prjdirign) -w 50}} {.labEOL .labIgn T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,EOL:)}}} {.cbxEOL + L 1 1 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(prjEOL) -values {{} LF CR CRLF} -w 9 -state readonly}} {.labIndent .labEOL T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,indent:)}}} {.spxIndent + L 1 1 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(prjindent) -from 0 -to 8 -com {::alited::pref::CheckIndent ""}}} {.chbIndAuto + L 1 1 {-st sw -pady 3 -padx 3} {-var ::alited::al(prjindentAuto) -t {$al(MC,indentAuto)}}} {.labRedunit .labIndent T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,redunit)}}} {.spxRedunit + L 1 1 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(prjredunit) -from $al(minredunit) -to 100}} {.labmaxcom .labRedunit T 1 1 {-st e -pady 1 -padx 3} {-t {Maximum Run commands}}} {.spxMaxcom + L 1 1 {-st sw -pady 3 -padx 3} {-tvar ::alited::al(prjmaxcoms) -from 4 -to 99 -tabnext alited::Tnext}} {.labMult .labmaxcom T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,multiline)} -tip {$al(MC,notrecomm)}}} {.swiMult + L 1 1 {-st sw -pady 3 -padx 3} {-var ::alited::al(prjmultiline) -tip {$al(MC,notrecomm)}}} {.labTrWs .labMult T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,trailwhite)}}} {.swiTrWs + L 1 1 {-st sw -pady 1} {-var ::alited::al(prjtrailwhite)}} {.seh .labTrWs T 1 9} {.labUself + T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,useleafRE)}}} {.swiUself + L 1 1 {-st sw -pady 1} {-var ::alited::al(prjuseleafRE) -com alited::project::CheckPrjUseLeaf}} {.butStd + L 1 7 {-st e} {-t Standard -com alited::project::StdLeafRE}} {.labLf .labUself T 1 1 {-st e -pady 1 -padx 3} {-t {$al(MC,leafRE)}}} {.EntLf + L 1 8 {-st sew -pady 1} {-tvar ::alited::al(prjleafRE)}} } }
Creates Templates tab of "Project".
proc ::alited::project::Tab3 {} { # Creates Templates tab of "Project". return { {v_ - - 1 9} {lab1 + T 1 9 {-st nsew -pady 1 -padx 3} {-t {$al(MC,TemplPrj)}}} {lab2 + T 1 1 {-st ew -pady 5 -padx 3} {-t Template: -foreground $al(FG,DEFopts) -font {$::apave::FONTMAINBOLD}}} {CbxTpl + L 1 3 {-st ew -pady 5} {-w 40 -h 12 -cbxsel {$al(PTP,name)} -tvar ::alited::al(PTP,name) -values {$al(PTP,names)} -clearcom alited::project::DeleteFromTplList -selcombobox alited::project::UpdateTplText}} {fraTlist + T 1 8 {-st nswe -padx 3 -cw 1 -rw 1}} {.TexTemplate - - - - {pack -side left -fill both -expand 1} {-h 20 -w 40 -tabnext "*.butTplDef *.cbxTpl" -wrap none}} {.sbv + L - - {pack -side left}} {butTplDef fraTlist T 1 1 {-st w -padx 4 -pady 4} {-t Standard -com alited::project::TplDefault -tabnext alited::Tnext}} } }
Creates Commands tab of "Project".
proc ::alited::project::Tab4 {} { # Creates Commands tab of "Project". namespace upvar ::alited al al set al(PTP,chbClearRun) 0 set al(PTP,chbClearCom) 0 set al(PTP,chbClearTip) [string map [list %f [msgcat::mc General]] $al(MC,alloffile)] return { {v_ - - 1 3} {Labprj + T 1 2 {} {-foreground $al(FG,DEFopts) -font {$::apave::FONTMAINBOLD}}} {ChbClearRun labprj L 1 1 {-st w} {-var ::alited::al(PTP,chbClearRun) -com alited::project::ChecksRun -takefocus 0}} {tcl { set prt labprj set ent Entrun for {set i 1} {$i<=$::alited::al(cmdNum)} {incr i} { set lwid "lab$i $prt T 1 1 {-st nse} {-t {$::alited::al(MC,com) $i:}}" %C $lwid set lwid "$ent$i lab$i L 1 1 {-cw 1 -st ew} {-tvar ::alited::al(PTP,run$i)}" %C $lwid set lwid "chb$i $ent$i L 1 1 {} {-t {Run it} -var ::alited::al(PTP,runch$i) -takefocus 0}" %C $lwid set prt lab$i set ent ent } set lwid {seh1 lab6 T 1 3} %C $lwid set lwid {labcom seh1 T 1 2 {} {-t General -foreground $::alited::al(FG,DEFopts) -font {$::apave::FONTMAINBOLD}}} %C $lwid set lwid {chbClearCom labcom L 1 1 {-st w} {-var ::alited::al(PTP,chbClearCom) -com alited::project::ChecksCom -takefocus 0 -tip {$al(PTP,chbClearTip)}}} %C $lwid set prt labcom for {set i 1} {$i<=$::alited::al(cmdNum)} {incr i} { set lwid "labc$i $prt T 1 1 {-st nse} {-t {$::alited::al(MC,com) $i:}}" %C $lwid set lwid "entc$i labc$i L 1 1 {-cw 1 -st ew} {-tvar ::alited::al(PTP,com$i)}" %C $lwid set lwid "chbc$i entc$i L 1 1 {} {-t {Run it} -var ::alited::al(PTP,comch$i) -takefocus 0}" %C $lwid set prt labc$i } } } {seh2 labc6 T 1 3} {h_ seh2 T 1 1} {butRun h_ L 1 2 {-st ew} {-t Run -com alited::project::RunComs -tip {$al(MC,saving) & $al(MC,run)} -tabnext alited::Tnext}} } }
Creates Files tab of "Project".
proc ::alited::project::Tab5 {} { # Creates Files tab of "Project". alited::ini::ProjectsToolbar return { {frat - - 1 9 {-st ew}} {frat.ToolTop + T - - pack {-array {$::alited::al(atools)} -relief groove -borderwidth 1}} {labFilter frat T 1 1 {-st se -padx 1} {-t {All files filter:}}} {EntFilter + L 1 1 {-st swe -padx 1 -cw 1} {-tvar ::alited::project::filefilter -validate all -validatecommand alited::project::preValidateFilter}} {ChbFilter + L 1 1 {-st sw -padx 1} {-var ::alited::project::casefilter -t {Match case} -com alited::project::postValidateFilter}} {seh_ labFilter T 1 3} {LabFlist + T 1 3 {-pady 3 -padx 3} {-foreground $al(FG,DEFopts) -font {$::apave::FONTMAINBOLD}}} {fraFlist + T 1 3 {-st nswe -padx 3 -rw 1}} {.LbxFlist - - - - {pack -side left -fill both -expand 1} {-takefocus 0 -selectmode multiple -popup {::alited::project::LbxPopup %X %Y}}} {.sbvFlist + L - - {pack -side left}} } }
Fills a listbox of files.
| file list |
proc ::alited::project::TabFileFill {flist} { # Fills a listbox of files. # flist - file list variable obPrj set lbx [$obPrj LbxFlist] $lbx delete 0 end set savfname {} foreach tab [lsort -index 0 -dictionary $flist] { set fname [lindex [split $tab \t] 0] if {$savfname ne $fname} { ;# no duplicates $lbx insert end $fname set savfname $fname } } }
Fills a listbox with a list of filtered files of all projects.
proc ::alited::project::TabFileFilter {} { # Fills a listbox with a list of filtered files of all projects. variable filefilter variable casefilter variable prjlist variable prjinfo if {$filefilter eq {}} { TabFileInfo return } set alltablist [list] if {$casefilter} {set nocase {}} {set nocase -nocase} foreach prj $prjlist { foreach tab $prjinfo($prj,tablist) { set fname [lindex [split $tab \t] 0] if {[string match {*}$nocase *$filefilter* $fname]} { lappend alltablist $tab } } } TabFileFill $alltablist TabFileHeading }
Show Files tab's heading.
proc ::alited::project::TabFileHeading {} { # Show Files tab's heading. variable obPrj set lbx [$obPrj LbxFlist] set txt [msgcat::mc {List of files (%n):}] set txt [string map [list %n [$lbx index end]] $txt] [$obPrj LabFlist] configure -text $txt }
Fills a listbox with a list of project files.
proc ::alited::project::TabFileInfo {} { # Fills a listbox with a list of project files. variable filefilter if {$filefilter ne {}} { TabFileFilter return } TabFileFill $::alited::al(tablist) TabFileHeading }
Creates a project by template as set in Template tab. The template can contain directories or files (indented for subdirectories). The files satisfy glob-patterns: changelog, license, licence, readme.
proc ::alited::project::Template {} { # Creates a project by template as set in Template tab. # The template can contain directories or files (indented for subdirectories). # The files satisfy glob-patterns: changelog*, license*, licence*, readme*. # See also: TplDefault namespace upvar ::alited al al variable obPrj variable curinfo # first, update the template list independently on errors UpdateTplLists # then check the template for correctness set wtpl [$obPrj TexTemplate] set namelist [set errmess {}] set margin [set indent [set spprev -1]] foreach name [split [$wtpl get 1.0 end] \n] { if {[set name [string trimright $name]] eq {}} continue if {[string trim $name] ne [::apave::NormalizeFileName $name]} { set errmess [string map [list %n $name] $al(MC,incorrname)] break } set sporig [$obPrj leadingSpaces $name] if {$margin<0} {set margin $sporig} set sp [$obPrj leadingSpaces [string range $name $margin end]] set name [string trimleft $name] set lastname {} ;# root of project dir if {$sp || $margin>$sporig} { if {$indent<0} {set indent $sp} if {$margin>$sporig || $sp % $indent || $sp>($spprev+$indent)} { set errmess [string map [list %n $name] [msgcat::mc {Incorrect indentation in Project template: %n}]] break } for {set i [llength $namelist]} {$i} {} { incr i -1 lassign [lindex $namelist $i] n1 s1 if {$s1<$sp} { set lastname $n1/ break } } } lappend namelist [list [file nativename $lastname$name] $sp] set spprev $sp } if {"$errmess$namelist" eq {}} { set errmess {The project template is empty!} } elseif {[ExistingProject yes] ne {}} { return } elseif {[file exists $al(prjroot)]} { set errmess {The project directory already exists! It isn't created with templates.} FocusInTab f1 [$obPrj chooserPath Dir] Message [msgcat::mc $errmess] 4 return } if {$errmess ne {}} { set namelist {} ;# skip the following foreach } elseif {![Add no]} { return } # the template is OK -> create its dir/file tree foreach fn $namelist { set fn [lindex $fn 0] set fname [file join $al(prjroot) $fn] switch -glob -nocase -- [file tail $fn] { README* - CHANGELOG* { set err [catch {writeTextFile $fname {} 1} errmess] } LICENCE* - LICENSE* { set fname0 [file join $curinfo(prjroot) $fn] if {[file exists $fname0]} { set err [catch {file copy $fname0 $fname} errmess] } else { set err [catch {writeTextFile $fname {} 1} errmess] } } default { set err [catch {file mkdir $fname} errmess] } } if {$err} break set errmess {} } if {$errmess ne {}} { FocusInTab f3 $wtpl Message [msgcat::mc $errmess] 4 } }
Shows info on a file in the file list as a tooltip.
| item index |
proc ::alited::project::TipOnFile {idx} { # Shows info on a file in the file list as a tooltip. # idx - item index variable obPrj set lbx [$obPrj LbxFlist] set item [$lbx get $idx] return [alited::file::FileStat $item] }
Sets default contents of project template.
proc ::alited::project::TplDefault {} { # Sets default contents of project template. variable obPrj set cbx [$obPrj CbxTpl] $cbx set Default $cbx selection clear $obPrj displayText [$obPrj TexTemplate] [TplDefaultText] }
Gets default contents of project template.
proc ::alited::project::TplDefaultText {} { # Gets default contents of project template. return {doc data hlp img msg lib theme utils tkcon src CHANGELOG.md LICENSE README.md} }
Displays a message on project updating.
| message of action (add/change) |
| if yes, shows total number of files; optional, default yes |
proc ::alited::project::UpdateMsg {msg {showtotals yes}} { # Displays a message on project updating. # msg - message of action (add/change) # showtotals - if yes, shows total number of files variable totalfiles if {$showtotals} {append msg " ($::alited::al(MC,files) : $totalfiles) "} Message $msg 3 }
Updates lists of template data, setting the current template on the top.
proc ::alited::project::UpdateTplLists {} { # Updates lists of template data, setting the current template on the top. namespace upvar ::alited al al variable obPrj set wtpl [$obPrj TexTemplate] set cbx [$obPrj CbxTpl] set al(PTP,name) [string trim [$cbx get]] RemoveFromTplList $al(PTP,name) if {$al(PTP,name) eq {}} { set al(PTP,name) Template\ #[llength $al(PTP,names)] } set tpltext [string trimright [$wtpl get 1.0 end]] set al(PTP,names) [linsert $al(PTP,names) 0 $al(PTP,name)] set al(PTP,list) [linsert $al(PTP,list) 0 $al(PTP,name) $tpltext] set maxlen 16 catch {set al(PTP,names) [lreplace $al(PTP,names) $maxlen end]} catch {set al(PTP,list) [lreplace $al(PTP,list) $maxlen+$maxlen end]} set ltmp [list] foreach {n c} $al(PTP,list) { set t {} foreach l [lrange [split $c \n] 0 200] {append t [string trimright $l] \n} lappend ltmp $n [string trimright $t] } set al(PTP,list) $ltmp $cbx set $al(PTP,name) $cbx configure -values $al(PTP,names) }
Updates the template text.
proc ::alited::project::UpdateTplText {} { # Updates the template text. namespace upvar ::alited al al variable obPrj set i [lsearch -exact $al(PTP,list) $al(PTP,name)] $obPrj displayText [$obPrj TexTemplate] [lindex $al(PTP,list) $i+1] UpdateTplLists }
Fills a list of projects.
proc ::alited::project::UpdateTree {} { # Fills a list of projects. variable obPrj variable prjlist variable prjinfo set tree [$obPrj TreePrj] $tree delete [$tree children {}] foreach prj $prjlist { set prjinfo($prj,ID) [$tree insert {} end -values [list $prj]] } }
Tries to get a project name at choosing root dir.
proc ::alited::project::ValidateDir {} { # Tries to get a project name at choosing root dir. namespace upvar ::alited al al update idletasks ;# update ;# a bug of ttk? if {$al(prjname) eq {}} { set al(prjname) [file tail $al(prjroot)] } return yes }
Validates values of alited.ini.
| %V wildcard of -validatecommand |
proc ::alited::project::ValidateIni {V} { # Validates values of alited.ini. # V - %V wildcard of -validatecommand variable saveini set saveini yes if {$V eq {focusout}} { alited::ini::SaveIni set saveini no } return 1 }
Checks if a project's options are valid.
proc ::alited::project::ValidProject {} { # Checks if a project's options are valid. namespace upvar ::alited al al variable obPrj variable totalfiles set al(prjname) [string trim $al(prjname)] if {$al(prjname) eq {} || ![CheckProjectName]} { bell FocusInTab f1 [$obPrj EntName] return no } if {$al(prjroot) eq {}} { bell FocusInTab f1 [$obPrj chooserPath Dir] return no } if {$al(prjuseleafRE) && $al(prjleafRE) eq {}} { bell FocusInTab f2 [$obPrj EntLf] return no } set al(prjroot) [file nativename $al(prjroot)] if {![CheckNewDir]} {return no} if {$al(prjindent)<0 || $al(prjindent)>8} {set al(prjindent) 2} if {$al(prjredunit)<$al(minredunit) || $al(prjredunit)>100} {set al(prjredunit) 20} set msg [string map [list %d $al(prjroot)] [msgcat::mc {Checking %d. Wait a little...}]] Message $msg 5 alited::tree::PrepareDirectoryContents set totalfiles [llength [alited::tree::GetDirectoryContents $al(prjroot)]] if {$totalfiles >= $al(MAXFILES)} { set msg [string map [list %n $al(MAXFILES)] [msgcat::mc {Too big directory for a project: %n files or more.}]] Message $msg 4 set res no } else { Message {} set res yes } return $res }
Shows file chooser just to view the project's dir
proc ::alited::project::ViewDir {} { # Shows file chooser just to view the project's dir alited::tool::e_menu EX=4 d=$::alited::al(prjroot) }
Dialogue to define a command for "Tools/Run".
proc ::alited::run::_create {} { # Dialogue to define a command for "Tools/Run". namespace upvar ::alited al al obRun obRun variable win alited::SaveRunOptions set al(_startRunDialogue) yes if {[catch { if {[lindex $al(comForceLs) 0] eq {-}} { set al(comForceLs) [lreplace $al(comForceLs) 0 0] ;# legacy } if {[lindex $al(comForceLs) 0] ne {}} { set i [lsearch $al(comForceLs) {}] set al(comForceLs) [lreplace $al(comForceLs) $i $i] set al(comForceLs) [linsert $al(comForceLs) 0 {}] ;# to allow blank value } }]} { set al(comForceLs) [list] } set fname [alited::bar::FileName] if {![llength $al(comForceLs)] && $fname ne $al(MC,nofile)} { set al(comForceLs) [list {} $fname] } GetRUNFEXEC set run [::alited::ProcEOL $al(prjbeforerun) in] $obRun makeWindow $win.fra $al(MC,run) $obRun paveWindow $win.fra { {h_ - - 1 5} {lab T + 1 1 {-st e -pady 5 -padx 8} {-t Run:}} {fraIn + L 1 4 {-st ew}} {.Rad1 - - 1 1 {pack -side left} {-tvar ::alited::al(MC,inconsole) -value 1 -var ::alited::al(prjincons)}} {.rad0 + L 1 1 {pack -side left -expand 1} {-tvar ::alited::al(MC,intkcon) -value 0 -var ::alited::al(prjincons)}} {.Rad2 + L 1 1 {pack -side left} {-tvar ::alited::al(MC,asis) -value 2 -var ::alited::al(prjincons)}} {.h_ - - 1 1 {pack -side left -expand 1}} {seh1 lab T 1 5 {-pady 5}} {rad3 + T 1 1 {-st w -padx 8} {-t {By #RUNF: / #EXEC:} -value 0 -var ::alited::al(comForceCh) -com alited::run::ChbForced}} {Ent + L 1 4 {-st ew -pady 5} {-state disabled -tip {-BALTIP ! -COMMAND {[$::alited::obRun Ent] get} -UNDER 2 -PER10 0} -tvar ::alited::run::vent}} {rad4 rad3 T 1 1 {-st w -padx 8} {-t {By command:} -value 1 -var ::alited::al(comForceCh) -com alited::run::ChbForced}} {fiL + L 1 4 {-st ew} {-h 12 -cbxsel "$al(comForce)" -clearcom alited::run::DeleteForcedRun -values "$al(comForceLs)" -validate focus -validatecommand alited::run::ValidatePath}} {fra1 rad4 T 1 5 {-st nsew -cw 1 -rw 1}} {.Tex1 - - - - {pack -side left -fill both -expand 1} {-w 50 -h 9 -afteridle alited::run::FillTex1 -tabnext *tex2}} {.sbv + L - - {pack -side left}} {seh3 fra1 T 1 5 {-pady 5}} {lab2 + T 1 5 {} {-t { OS or Tcl commands to be run before running a current file:}}} {fra2 + T 1 5 {-st nsew}} {.Tex2 - - - - {pack -side left -fill both -expand 1} {-w 50 -h 4 -afteridle alited::run::FillTex2 -tabnext *butRun}} {.sbv + L - - {pack -side left}} {seh2 fra2 T 1 5 {-pady 5}} {butHelp + T 1 1 {-st w -padx 2} {-t Help -com alited::run::Help}} {h_2 + L 1 2 {-st ew}} {fra3 + L 1 2 {-st e}} {.butRun - - 1 1 {-padx 2} {-t Run -com alited::run::Run}} {.butSave + L 1 1 {} {-t Save -com alited::run::Save}} {.butCancel + L 1 1 {-padx 2} {-t Cancel -com alited::run::Cancel}} } ValidatePath bind $win <F1> alited::run::Help bind $win <F5> alited::run::Run set geo $al(runGeometry) if {$geo ne {}} {set geo "-geometry $geo"} $obRun showModal $win -modal no -waitvar yes -onclose alited::run::Cancel -resizable 1 -focus [$obRun Rad1] -decor 1 -minsize {400 300} {*}$geo -ontop 0 catch {destroy $win} ::apave::deiconify $al(WIN) }
proc ::alited::run::_run {} { variable win if {[winfo exists $win]} { ::apave::withdraw $win ::apave::deiconify $win } else { _create } }
Handles hitting "Cancel" button.
| Optional arguments. |
proc ::alited::run::Cancel {args} { # Handles hitting "Cancel" button. namespace upvar ::alited al al obRun obRun variable win alited::RestoreRunOptions catch { set al(runGeometry) [wm geometry $win] $obRun res $win 0 } }
Checks states & values of widgets.
proc ::alited::run::ChbForced {} { # Checks states & values of widgets. namespace upvar ::alited al al obRun obRun set cbx [$obRun CbxfiL] set but [string map {.cbx .btT} $cbx] ;# path to combobox' button set tex [$obRun Tex1] $obRun readonlyWidget $tex no GetRUNFEXEC FillTex1 ValidatePath if {$al(comForceCh)} { set state normal } else { $obRun readonlyWidget $tex yes set state disabled } $cbx configure -state $state $but configure -state $state }
Clears current combobox' value.
proc ::alited::run::DeleteForcedRun {} { # Clears current combobox' value. namespace upvar ::alited al al obRun obRun set cbx [$obRun CbxfiL] if {[set val [string trim [$cbx get]]] eq {}} return set values [$cbx cget -values] if {[set i [lsearch -exact $values $val]]>-1} { set al(comForceLs) [lreplace $values $i $i] $cbx configure -values $al(comForceLs) } $cbx set {} }
Fill the command combobox.
| Optional arguments. |
proc ::alited::run::FillCbx {args} { # Fill the command combobox. namespace upvar ::alited al al obRun obRun if {!$al(comForceCh)} return set tex1 [$::alited::obRun Tex1] if {!$al(comForceCh) || [focus] ne $tex1} return set cbx [$obRun CbxfiL] set lst [list] set curline {} set l1 [expr {int([$tex1 index insert])}] foreach line [split [$tex1 get 1.0 end] \n] { incr l if {$l==1 || [set line [string trim $line]] ne {}} { lappend lst $line } if {$l==$l1} { set curline $line } } set llen [llength $lst] if {$llen<$al(prjmaxcoms)} { alited::Message {} } else { if {[info exists al(run_checkmaxcomms)] && $al(run_checkmaxcomms)} { set mm 4 ;# bell + red message } else { set mm 6 ;# only red message } set al(run_checkmaxcomms) 0 set msg [msgcat::mc {Maximum commands reached: %n, current: %i (see Project/Options)}] alited::Message [string map [list %i $llen %n $al(prjmaxcoms)] $msg] $mm } if {[lindex $lst 0] ne {}} {set lst [linsert $lst 0 {}]} $cbx configure -values $lst set curline [string trim $curline] if {$curline ne {}} { $cbx set $curline selection clear -displayof $cbx $cbx selection range 0 end } RunOptions ValidatePath }
Fills command content text.
| Optional arguments. |
proc ::alited::run::FillTex1 {args} { # Fills command content text. namespace upvar ::alited al al obRun obRun set tex1 [$::alited::obRun Tex1] set tex2 [$::alited::obRun Tex2] set cbx [$obRun CbxfiL] if {$al(_startRunDialogue)} { set al(_startRunDialogue) no InitTex12 $tex1 $tex2 $cbx } if {!$al(comForceCh)} { $obRun displayText $tex1 [[$::alited::obRun Ent] get] return } if {[focus] eq $tex1} return set com [$cbx get] set coms {} set l1 0 foreach c [$cbx cget -values] { incr l set c [string trim $c] if {$c eq $com && !$l1} {set l1 $l} if {$c ne {}} { append coms $c\n\n } } if {$l1} { catch {::tk::TextSetCursor $tex1 $l1.0} } else { set coms $com\n\n$coms } $obRun displayText $tex1 $coms }
Fills "commands before running" text.
| Optional arguments. |
proc ::alited::run::FillTex2 {args} { # Fills "commands before running" text. namespace upvar ::alited al al obRun obRun set tex2 [$::alited::obRun Tex2] $obRun displayText $tex2 [::alited::ProcEOL [string trim $al(prjbeforerun)] in] }
Gets value of RUNF/EXEC entry.
proc ::alited::run::GetRUNFEXEC {} { # Gets value of RUNF/EXEC entry. variable vent lassign [alited::tool::RunArgs] ar rf ex set vent "$ar$rf$ex" }
Shows Run's help.
proc ::alited::run::Help {} { # Shows Run's help. variable win alited::Help $win }
Initializes texts & combobox (colors, events, highlighting etc.).
| 1st text's path |
| 2nd text's path |
| compobox's path |
proc ::alited::run::InitTex12 {tex1 tex2 cbx} { # Initializes texts & combobox (colors, events, highlighting etc.). # tex1 - 1st text's path # tex2 - 2nd text's path # cbx - compobox's path namespace upvar ::alited al al obRun obRun ::hl_tcl::hl_init $tex1 -dark [$obRun csDark] -plaintext 1 -cmd ::alited::run::FillCbx -cmdpos ::alited::run::FillCbx -font $al(FONT) ::hl_tcl::hl_text $tex1 ::hl_tcl::hl_init $tex2 -dark [$obRun csDark] -plaintext 1 -font $al(FONT) -cmdpos ::apave::None ::hl_tcl::hl_text $tex2 bind $tex1 <FocusIn> {set ::alited::al(run_checkmaxcomms) 1} bind $cbx <FocusOut> alited::run::FillTex1 bind $cbx <<ComboboxSelected>> alited::run::FillTex1 ChbForced }
Runs a command of "Run..." dialogue.
proc ::alited::run::Run {} { # Runs a command of "Run..." dialogue. namespace upvar ::alited al al variable win wm attributes $win -topmost 0 ;# let Run dialogue be hidden RunOptions if {![alited::file::IsTcl [alited::bar::FileName]]} { set in {} } elseif {$al(prjincons)==1} { set in terminal } elseif {$al(prjincons)==2} { set in {as is} } else { set in tkcon } alited::tool::_run {} $in -doit yes }
Sets options of "Run..." dialogue.
| Optional arguments. |
proc ::alited::run::RunOptions {args} { # Sets options of "Run..." dialogue. namespace upvar ::alited al al obRun obRun set cbx [$obRun CbxfiL] set com [string trim [$cbx get]] set al(comForce) $com set al(comForceLs) [$cbx cget -values] set befrun [[$obRun Tex2] get 1.0 end] if {$com ne {}} { set i [lsearch -exact $al(comForceLs) $com] set al(comForceLs) [lreplace $al(comForceLs) $i $i] } if {[llength $al(comForceLs)]<2} {set al(comForceLs) [list {}]} if {$com ne {}} { set al(comForceLs) [linsert $al(comForceLs) 1 $com] } for {set i [llength $al(comForceLs)]} {$i>1} {} { incr i -1 if {[string trim [lindex $al(comForceLs) $i]] eq {}} { set al(comForceLs) [lreplace $al(comForceLs) $i $i] } } set al(comForceLs) [lrange $al(comForceLs) 0 $al(prjmaxcoms)] set al(prjbeforerun) [::alited::ProcEOL [string trim $befrun] out] }
Saves settings of "Run..." dialogue.
proc ::alited::run::Save {} { # Saves settings of "Run..." dialogue. namespace upvar ::alited al al obRun obRun variable win set al(runGeometry) [wm geometry $win] RunOptions alited::SaveRunOptions alited::ini::SaveIniPrj alited::main::UpdateProjectInfo catch {$obRun res $win 1} }
Validates a path chosen from the file picker.
proc ::alited::run::ValidatePath {} { # Validates a path chosen from the file picker. namespace upvar ::alited al al obRun obRun set cbx [$obRun CbxfiL] set com [string trim [$cbx get]] if {[file exists $com]} { if {[llength [split $com]]>1} { set com "\"$com\"" } $cbx set [file nativename $com] } return 1 }
Closes e_menu (being an internal procedure) by force.
| Not documented; optional, default "" |
proc ::alited::tool::_close {{fname {}}} { # Closes e_menu (being an internal procedure) by force. catch {destroy .em} }
Runs e_menu's item of menu.em.
| the item (by default, "Run me"); optional, default "" |
| mode of running (in console or in tkcon); optional, default "" |
| additional options |
proc ::alited::tool::_run {{what {}} {runmode {}} args} { # Runs e_menu's item of menu.em. # what - the item (by default, "Run me") # runmode - mode of running (in console or in tkcon) # args - additional options namespace upvar ::alited al al if {[is_emenu]} return set opts "EX=$what" if {$what eq {}} { set doit [::apave::extractOptions args -doit 0] if {!$::alited::DEBUG} { if {$al(EM,exec)} { set fpid [alited::TmpFile .pid~] set pid [readTextFile $fpid] } else { ::alited::Source_e_menu ;# e_menu is "internal" set pid [::em::pID] ::em::pID 0 } catch { if {$pid>0} {exec kill -s SIGINT $pid} } catch { if {$::alited::pID>0} {exec kill -s SIGINT $::alited::pID} } set ::alited::pID 0 } set fnameCur [alited::bar::FileName] set com [PrepareRunCommand $al(prjbeforerun) $fnameCur] Runs {} $com if {$al(prjincons)==2} { ;# run "as is" EM_SaveFiles if {[ComForced]} { set com $al(comForce) } else { lassign [alited::tool::RunArgs] ar rf ex set com $ar$rf$ex } set com [PrepareRunCommand $com $fnameCur] if {[string trim $com] ne {}} { if {[string index $com end] ne {&}} {append com { &}} exec -- {*}$com return } } if {[alited::file::IsTcl $fnameCur]} CheckTcl if {[ComForced]} { set com [PrepareRunCommand $al(comForce) $fnameCur] Run_in_e_menu $com $fnameCur return } if {[RunTcl $runmode]} return set opts "EX=1 PI=1 [SHarg]" } e_menu {*}$opts tc=[alited::Tclexe] {*}$args }
Addition to Run's tooltip.
proc ::alited::tool::AddTooltipRun {} { # Addition to Run's tooltip. return "\n\nCtrl+click = $::alited::al(acc_22) = $::alited::al(acc_2) + F4" }
Runs commands after starting alited.
proc ::alited::tool::AfterStart {} { # Runs commands after starting alited. namespace upvar ::alited al al Runs "$al(MC,afterstart) :" $al(afterstart) }
Dialogue "Setup/For Start".
proc ::alited::tool::AfterStartDlg {} { # Dialogue "Setup/For Start". namespace upvar ::alited al al obDl2 obDl2 set lab [msgcat::mc " Enter commands to be run after starting alited.\n They can be Tcl or executables:"] set run [::alited::ProcEOL $al(afterstart) in] lassign [$obDl2 input {} $al(MC,afterstart) [list lab [list {} {-pady 8} [list -t $lab]] {} tex "{} {} {-w 80 -h 16 -tabnext {butOK butCANCEL} -afteridle {alited::tool::AfterStartSyntax %w}}" "$run" ] -help alited::tool::HelpContext] res run if {$res} { set al(afterstart) [::alited::ProcEOL [string trim $run] out] alited::ini::SaveIni } }
Highlight "Setup/For Start" text's syntax, at least Tcl part of it.
| the text's path |
proc ::alited::tool::AfterStartSyntax {w} { # Highlight "Setup/For Start" text's syntax, at least Tcl part of it. # w - the text's path alited::SyntaxHighlight tcl $w [alited::SyntaxColors] }
Gets aloupe ini file's path.
proc ::alited::tool::aloupePath {} { # Gets aloupe ini file's path. namespace upvar ::alited USERDIR USERDIR return [file join $USERDIR aloupe.conf] }
Check a current unit for errors, before running Tcl file.
proc ::alited::tool::CheckTcl {} { # Check a current unit for errors, before running Tcl file. alited::main::UpdateUnitTree lassign [alited::tree::CurrentItemByLine {} 1] - - leaf - name l1 l2 if {[string is true -strict $leaf] && $name ne {}} { alited::CheckSource alited::info::ClearRed set wtxt [alited::main::CurrentWTXT] set TID [alited::bar::CurrentTabID] set err [alited::check::CheckUnit $wtxt $l1.0 $l2.end $TID $name yes yes] if {$err} { set msg [msgcat::mc {Errors found in unit:}]\ $name alited::Message $msg 4 } } }
Calls a color picker passing to it and getting from it a color.
proc ::alited::tool::ColorPicker {} { # Calls a color picker passing to it and getting from it a color. namespace upvar ::alited al al PAVEDIR PAVEDIR lassign [alited::find::GetWordOfText 2] color pos1 pos2 if {$color ne {}} { set al(chosencolor) $color } if {[info commands ::aloupe::run] eq {}} { catch {source [SrcPath [file join $PAVEDIR pickers color aloupe aloupe.tcl]]} } if {![string is boolean -strict $al(moveall)]} {set al(moveall) 0} lassign [LineCoordinates] X Y set res [obj chooser colorChooser ::alited::al(chosencolor) -moveall $al(moveall) -parent $al(WIN) -geometry +$X+$Y -inifile [aloupePath] -ontop [::asKDE]] catch {lassign [::tk::dialog::color::GetOptions] al(moveall)} if {$res ne {}} { set al(chosencolor) $res InsertInText $res $pos1 $pos2 } alited::FocusText }
Checks whether a forced command is set.
proc ::alited::tool::ComForced {} { # Checks whether a forced command is set. return [expr {$::alited::al(comForceCh) && [string trim $::alited::al(comForce)] ni {- {}}}] }
Calls a calendar to pick a date.
proc ::alited::tool::DatePicker {} { # Calls a calendar to pick a date. namespace upvar ::alited al al lassign [alited::find::GetWordOfText 2] date pos1 pos2 if {$date ne {} && ![catch {clock scan $date -format $al(TPL,%d)}]} { set al(klnddate) $date } elseif {![info exists al(klnddate)]} { set al(klnddate) [FormatDate] } lassign [LineCoordinates] X Y set res [obj chooser dateChooser ::alited::al(klnddate) -parent $al(WIN) -geometry +$X+$Y -dateformat $al(TPL,%d) -weeks $al(klndweeks)] if {$res ne {}} { set al(klnddate) $res InsertInText $res } alited::FocusText }
Runs e_menu.
| arguments of e_menu |
The e_menu is run as an external application or an internal procedure, depending on e_menu's preferences.
Runs e_menu.
| options of e_menu |
The e_menu is run as an external application.
Runs e_menu.
| options of e_menu |
The e_menu is run as an internal procedure.
Prepares TF= argument for e_menu and runs e_menu's main menu.
Gets all items of all menus.
| a root menu's file name |
proc ::alited::tool::EM_AllStructure {mnu} { # Gets all items of all menus. # mnu - a root menu's file name set ::alited::al(EM_STRUCTURE) [list] EM_AllStructure1 $mnu 0 return $::alited::al(EM_STRUCTURE) }
Gets recursively all items of all menus.
| a current menu's file name |
| a current level of menu |
proc ::alited::tool::EM_AllStructure1 {mnu lev} { # Gets recursively all items of all menus. # mnu - a current menu's file name # lev - a current level of menu foreach mit [EM_Structure $mnu] { incr i lassign $mit mnu item if {[string match {M-*} $item]} { if {[lsearch -exact -index end $::alited::al(EM_STRUCTURE) $item]>-1} { continue ;# to avoid infinite cycle } lassign [split $item \n] item set lev [EM_AllStructure1 [string range $item 2 end] [incr lev]] } else { lappend ::alited::al(EM_STRUCTURE) [list $lev $mnu [EM_HotKey $i] $item] } } return [incr lev -1] }
Gets e_menu command.
| index of the command in em_inf array |
proc ::alited::tool::EM_command {im} { # Gets e_menu command. # im - index of the command in em_inf array namespace upvar ::alited::pref em_inf em_inf if {[catch { lassign $em_inf($im) mnu idx item if {$idx eq {-} || [regexp {^[^[:blank:].]+[.](mnu|em): } $item]} { # open a menu set mnu [string range $item 0 [string first : $item]-1] set ex {ex= o=-1} } else { # call a command set ex "ex=[alited::tool::EM_HotKey $idx] SH=1" } set res "alited::tool::e_menu \"m=$mnu\" $ex" } err]} then { puts stderr "\nalited error: $err" set res {} } return $res }
Returns a directory of e_menu's menus.
Returns a directory of e_menu's menus.
proc ::alited::tool::EM_dir {} { # Returns a directory of e_menu's menus. namespace upvar ::alited al al if {$al(EM,mnudir) eq {}} { return [file join $::e_menu_dir menus] } return $al(EM,mnudir) }
Returns e_menu's hotkeys which numerate menu items.
| item's index |
Returns e_menu's hotkeys which numerate menu items.
proc ::alited::tool::EM_HotKey {idx} { # Returns e_menu's hotkeys which numerate menu items. # idx - item's index set hk {0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ,./} return [string index $hk $idx] }
Checks if m=$mnu
is present in e_menu's arguments.
| menu name |
| e_menu's arguments |
Returns e_menu's general options.
| Not documented. |
Returns e_menu's general options.
proc ::alited::tool::EM_Options {opts} { # Returns e_menu's general options. namespace upvar ::alited al al SCRIPTNORMAL SCRIPTNORMAL CONFIGDIR CONFIGDIR set sel [string trim [alited::find::GetWordOfText]] set sel [lindex [split $sel \n] 0] ;# only 1st line for "selection" set sel [string map [list \" {} \{ {} \} {} \[ {} \] {} \\ {} \$ {}] $sel] set f [alited::bar::FileName] set d [file dirname $f] # get a list of selected tabs (i.e. their file names): # it's used as %ls wildcard in grep.em ("SEARCH EXACT LS=") set tabs [alited::bar::BAR listFlag s] if {[llength $tabs]>1} { foreach tab $tabs { append ls [alited::bar::FileName $tab] { } } set ls "\"ls=$ls\"" } else { set ls "ls=" } # get file names of left & right tabs (used in utils.em by diff items) set z6 {} set z7 {} set tabs [alited::bar::BAR listTab] set TID [alited::bar::CurrentTabID] set i [lsearch -index 0 $tabs $TID] if {$i>=0} { if {$i} { append z6 z6=[alited::bar::FileName [lindex $tabs $i-1 0]] } append z7 z7=[alited::bar::FileName [lindex $tabs $i+1 0]] } if {$al(EM,DiffTool) ne {}} {set df DF=$al(EM,DiffTool)} {set df {}} set l [[alited::main::CurrentWTXT] index insert] set l [expr {int($l)}] set dirvar [set filvar [set tdir {}]] if {$al(EM,exec)} { lassign [::apave::getProperty DirFilGeoVars] dirvar filvar if {$dirvar ne {} && [set dirvar [set $dirvar]] ne {}} { set dirvar "\"g1=$dirvar\"" } if {$filvar ne {} && [set filvar [set $filvar]] ne {}} { set filvar "\"g2=$filvar\"" } set tdir $::alited::LIBDIR } if {$al(EM,geometry) eq {}} { # at 1st exposition, center e_menu approximately lassign [split [wm geometry $al(WIN)] x+] w h x y set al(EM,geometry) [obj EXPORT CenteredXY $w $h $x $y 300 [expr {$h/2}]] } lassign [split $al(EM,tt)] tt if {[::isunix] && [auto_execok $tt] eq {}} { alited::Balloon [msgcat::mc {Set a Linux terminal in Preferences/Tools}] yes } set ed [info nameofexecutable]\ $SCRIPTNORMAL\ $CONFIGDIR set R [list md=$al(EM,mnudir) m=$al(EM,mnu) f=$f d=$d l=$l PD=$al(EM,PD=) pd=$al(prjroot) h=$al(EM,h=) tt=$al(EM,tt) s=$sel o=-1 om=0 {*}g=$al(EM,geometry) $z6 $z7 {*}$ls $df {*}$opts {*}$dirvar {*}$filvar td=$tdir ed=$ed wt=$al(EM,wt=) mp=1] if {[lsearch -glob $R th=*]<0} {lappend R th=$al(THEME)} set res {} foreach r $R {append res \"$r\" { }} return [string trim $res] }
Prepares TF= option for e_menu.
| options of e_menu |
TF= is a name of file that contains a current text's selection. If there is no selection, TF= option is a current file's name.
proc ::alited::tool::EM_optionTF {args} { # Prepares TF= option for e_menu. # args - options of e_menu # TF= is a name of file that contains a current text's selection. # If there is no selection, TF= option is a current file's name. if {[lsearch -glob $args TF=*]>-1} { return {} } set sels [alited::edit::SelectedLines {} yes] set wtxt [lindex $sels 0] set sel {} foreach {l1 l2} [lrange $sels 1 end] { append sel [$wtxt get $l1.0 $l2.end] \n } if {[string length [string trimright $sel]]<2 || (![is_mainmenu $args yes] && ![EM_menuhere tests $args])} { set tmpname [alited::bar::FileName] } else { set tmpname [alited::TmpFile SELECTION~] writeTextFile $tmpname sel } return TF=$tmpname }
Saves all files before running e_menu, if this mode is set in "Preferences".
proc ::alited::tool::EM_SaveFiles {} { # Saves all files before running e_menu, if this mode is set in "Preferences". namespace upvar ::alited al al if {$al(EM,save)==1} { alited::file::SaveAll } elseif {$al(EM,save)==2} { if {[alited::file::IsModified]} { alited::file::SaveFile } } }
Gets a menu's items.
| the menu's file name |
proc ::alited::tool::EM_Structure {mnu} { # Gets a menu's items. # mnu - the menu's file name namespace upvar ::alited al al set mnu [string trim $mnu "\" "] set fname [file join [EM_dir] [file tail $mnu]] if {[catch {set fcont [readTextFile $fname {} 1]}]} { return [list] } set res [list] set prname {} set mmarks [list S: R: M: S/ R/ M/ SE: RE: ME: SE/ RE/ ME/ SW: RW: MW: SW/ RW/ MW/ I:] set ismenu yes set isitem no foreach line [textsplit $fcont] { set line [string trimleft $line] switch $line { {[MENU]} { set ismenu yes set isitem no continue } {[HIDDEN]} - {[OPTIONS]} - {[DATA]} { set ismenu [set isitem no] continue } } if {!$ismenu} continue if {[regexp {^\s*SEP\s*=\s*} $line]} { set isitem no continue } if {[regexp {^\s*ITEM\s*=\s*} $line]} { set isitem yes set itemname [string range $line [string first = $line] end] set itemname [string trim $itemname { =}] continue } if {!$isitem} continue set origname $itemname foreach mark $mmarks { if {[regexp "^\s*$mark" $line]} { set typ [string index $mark 0] if {$typ eq {M}} { lassign [regexp -inline {.+m=([^[:blank:]]+)} $line] -> itemname if {$itemname ne {} && [file extension $itemname] ne {.em}} { set itemname [file rootname $itemname].em ;# normalized menu filename } } if {$itemname ni {{} -} && $itemname ne $prname} { set prname $itemname lappend res [list $mnu "$typ-$itemname\n$origname"] } break } } } return $res }
Formats a date.
| date to be formatted (a current date if omitted); optional, default "" |
proc ::alited::tool::FormatDate {{date {}}} { # Formats a date. # date - date to be formatted (a current date if omitted) namespace upvar ::alited al al if {$date eq {}} {set date [clock seconds]} return [clock format $date -format $al(TPL,%d) -locale $::alited::al(LOCAL)] }
Calls a help on alited.
proc ::alited::tool::Help {} { # Calls a help on alited. _run Help }
Handles hitting "Help" button.
proc ::alited::tool::HelpContext {} { # Handles hitting "Help" button. alited::Help $::alited::al(WIN) }
Insert a string into a text possibly instead of its selection.
| the string |
| starting position in a current line; optional, default "" |
| ending position in a current line; optional, default "" |
proc ::alited::tool::InsertInText {str {pos1 {}} {pos2 {}}} { # Insert a string into a text possibly instead of its selection. # str - the string # pos1 - starting position in a current line # pos2 - ending position in a current line set wtxt [alited::main::CurrentWTXT] if {$pos1 eq {}} { lassign [$wtxt tag ranges sel] pos1 pos2 } else { set line [expr {int([$wtxt index insert])}] set prevch [$wtxt get $line.[expr {$pos1-1}] $line.$pos1] if {$prevch eq [string index $str 0]} { incr pos1 -1 } set pos1 $line.$pos1 set pos2 $line.[incr pos2] } if {$pos1 ne {}} { $wtxt delete $pos1 $pos2 } $wtxt insert [$wtxt index insert] $str }
Check for e_menu's existence.
Checks if e_menu's arguments are for the main menu (run by F4).
| e_menu's arguments |
| yes, if checking together with TF= argument; optional, default no |
The e_menu's arguments contain ex= or EX= for bar-menu tools only.
Gets X, Y screen coordinates of current line.
proc ::alited::tool::LineCoordinates {} { # Gets X, Y screen coordinates of current line. lassign [alited::complete::CursorCoordsChar {} linestart] X Y if {[::iswindows]} {incr Y 50} {incr Y 10} list $X $Y }
Calls a screen loupe.
proc ::alited::tool::Loupe {} { # Calls a screen loupe. namespace upvar ::alited al al LIBDIR LIBDIR PAVEDIR PAVEDIR if {$al(IsWindows)} {set le aloupe.exe} {set le aloupe} set loupe [file join $LIBDIR util $le] if {[file exists $loupe]} { # try to run the loupe executable from lib/util if {![catch {exec $loupe}]} return } set loupe [SrcPath [file join $PAVEDIR pickers color aloupe aloupe.tcl]] alited::Runtime $loupe -locale $::alited::al(LOCAL) -apavedir $PAVEDIR -cs $al(INI,CS) -fcgeom $::alited::FilGeometry -inifile [aloupePath] }
Opens a popup menu in the tool bar, to enter e_menu's preferences.
| x-coordinate of clicking on the tool bar |
| y-coordinate of clicking on the tool bar |
proc ::alited::tool::PopupBar {X Y} { # Opens a popup menu in the tool bar, to enter e_menu's preferences. # X - x-coordinate of clicking on the tool bar # Y - y-coordinate of clicking on the tool bar namespace upvar ::alited al al obPav obPav set popm $al(WIN).popupBar catch {destroy $popm} menu $popm -tearoff 0 $popm add command -label [msgcat::mc {Open bar-menu settings}] -command {alited::pref::_run Emenu_Tab} $obPav themePopup $popm tk_popup $popm $X $Y }
Prepares a command to run. The command can include wildcards.
| command |
| current file name |
proc ::alited::tool::PrepareRunCommand {com fname} { # Prepares a command to run. The command can include wildcards. # com - command # fname - current file name namespace upvar ::alited al al set sel [alited::find::GetWordOfText select] alited::Map {} $com $::alited::EOL \n %s $sel %f $fname %d [file dirname $fname] %pd $al(prjroot) %H [::apave::HomeDir] }
Redoes a change.
proc ::alited::tool::Redo {} { # Redoes a change. catch {event generate [alited::main::CurrentWTXT] <<Redo>>} }
Redoes all changes.
proc ::alited::tool::redoAll {} { # Redoes all changes. set wtxt [alited::main::CurrentWTXT] set plaintext [SetPlainText $wtxt yes] while {[$wtxt edit canredo]} { if {[Redo]} break } SetPlainText $wtxt $plaintext }
Runs a command with e_menu application
| the command |
| currently edited file; optional, default "" |
Gets ARGS/RUNF/EXEC arguments (similar to ::em::get_AR of e_menu.tcl).
Returns a list of ARGS and RUNF arguments found in the current file.
proc ::alited::tool::RunArgs {} { # Gets ARGS/RUNF/EXEC arguments (similar to ::em::get_AR of e_menu.tcl). # Returns a list of ARGS and RUNF arguments found in the current file. set res {} set ar {^[[:space:]#/*]*#[ ]?ARGS[0-9]?:[ ]*(.*)} set rf {^[[:space:]#/*]*#[ ]?RUNF[0-9]?:[ ]*(.*)} set ex {^[[:space:]#/*]*#[ ]?EXEC[0-9]?:[ ]*(.*)} set AR [set RF [set EX {}]] set filecontent [split [[alited::main::CurrentWTXT] get 1.0 end] \n] foreach st $filecontent { if {[regexp $ar $st] && $AR eq {}} { lassign [regexp -inline $ar $st] => AR } elseif {[regexp $rf $st] && $RF eq {}} { lassign [regexp -inline $rf $st] => RF } elseif {[regexp $ex $st] && $EX eq {}} { lassign [regexp -inline $ex $st] => EX } if {"$AR$RF$EX" ne {}} { if {"$AR$RF$EX" ne {OFF}} { set res [list $AR $RF $EX] } break } } return $res }
Runs a current file as is (by associated app).
proc ::alited::tool::RunFile {} { # Runs a current file as is (by associated app). alited::Message $::alited::al(MC,run):\ [alited::bar::FileName] 3 alited::tool::_run 1 {} -doit yes }
Runs Tcl source file with choosing the mode - in console or in tkcon.
proc ::alited::tool::RunMode {} { # Runs Tcl source file with choosing the mode - in console or in tkcon. if {![namespace exists ::alited::run]} { namespace eval ::alited { source [file join $::alited::SRCDIR run.tcl] } } alited::run::_run }
Runs a list of Tcl/ext commands.
| message for infobar |
| list of commands |
proc ::alited::tool::Runs {mc runs} { # Runs a list of Tcl/ext commands. # mc - message for infobar # runs - list of commands set runs [::alited::ProcEOL $runs in] foreach run [split $runs \n] { if {[set run [string trim $run]] ne {} && [string first # $run]!=0} { if {[catch {eval $run} e]} { catch {exec -- {*}$run} e2 if {$e2 ne {}} {set e $e2} {append e " / OS ?"} } alited::info::Put "$mc\"$run\" -> $e" update } } }
Try to run tcl source file by means of tkcon utility.
| mode of running (in console or in tkcon); optional, default "" |
Returns yes if a tcl file was started.
proc ::alited::tool::RunTcl {{runmode {}}} { # Try to run tcl source file by means of tkcon utility. # runmode - mode of running (in console or in tkcon) # Returns yes if a tcl file was started. if {($runmode eq {} && !$::alited::al(prjincons)) || $runmode eq {tkcon}} { lassign [RunArgs] ar rf set tclfile {} if {[catch { ;# ar & rf can be badly formed => catch set fnameCur [alited::bar::FileName] if {[llength $ar] || (![llength $rf] && [alited::file::IsTcl $fnameCur])} { set rf "\"$fnameCur\"" append rf { } $ar } set fname [lindex $rf 0] set fname [PrepareRunCommand $fname $fnameCur] if {[set tclfile $fname] ne {}} { cd [file dirname $fnameCur] set tclfile [file normalize $tclfile] set rf [lreplace $rf 0 0] } } err]} { alited::Message $err 4 } if {$tclfile ne {} && [file exists $tclfile]} { # run tkcon with file.tcl & argv EM_SaveFiles tkcon $tclfile -apl-topmost 0 -argv {*}$rf return yes } } return no }
Set the flag "plain text".
| text path |
| value of the flag |
Returns old value of the flag.
proc ::alited::tool::SetPlainText {wtxt val} { # Set the flag "plain text". # wtxt - text path # val - value of the flag # Returns old value of the flag. if {[alited::file::IsClang [alited::bar::FileName]]} { set oldval [::hl_c::cget $wtxt -plaintext] ::hl_c::configure $wtxt -plaintext $val } else { set oldval [::hl_tcl::cget $wtxt -plaintext] ::hl_tcl::configure $wtxt -plaintext $val } return $oldval }
Gets SH= argument of e_menu (main window's geometry).
proc ::alited::tool::SHarg {} { # Gets SH= argument of e_menu (main window's geometry). namespace upvar ::alited al al if {[winfo exists $al(WIN)] && [winfo ismapped $al(WIN)]} { return SH=[wm geometry $al(WIN)] } return {} }
Gets a path to an external tool. This may be useful at calling alited by tclkit: tkcon, aloupe etc. may be located in "src" subdirectory of alited.
| Not documented. |
proc ::alited::tool::SrcPath {toolpath} { # Gets a path to an external tool. # This may be useful at calling alited by tclkit: # tkcon, aloupe etc. may be located in "src" subdirectory of alited. set srcpath [file join $::alited::FILEDIR src [file tail $toolpath]] if {[file exists $srcpath]} {set toolpath $srcpath} catch {cd [file dirname $toolpath]} return $toolpath }
Calls Tkcon application.
| additional arguments for tkcon |
proc ::alited::tool::tkcon {args} { # Calls Tkcon application. # args - additional arguments for tkcon set pid [alited::Run [tkconPath] {*}[tkconOptions] {*}$args] if {[llength $args]} {set ::alited::pID $pid} }
Gets options of tkcon.tcl.
proc ::alited::tool::tkconOptions {} { # Gets options of tkcon.tcl. namespace upvar ::alited al al foreach opt [array names al tkcon,clr*] { lappend opts -color-[string range $opt 9 end] [string trimleft $al($opt) #] } foreach {opt val} $al(tkcon,options) { if {[string trim $val] ne {}} { lappend opts -apl$opt $val } } return $opts }
Gets the path to tkcon.tcl.
proc ::alited::tool::tkconPath {} { # Gets the path to tkcon.tcl. return [SrcPath [file join $::alited::LIBDIR util tkcon.tcl]] }
Helper procedure to get a name of toolbar button.
| name of icon |
proc ::alited::tool::ToolButName {img} { # Helper procedure to get a name of toolbar button. # img - name of icon namespace upvar ::alited obPav obPav return [$obPav ToolTop].buT_alimg_$img-big }
Gets a tip for "Run" tool.
proc ::alited::tool::TooltipRun {} { # Gets a tip for "Run" tool. namespace upvar ::alited al al set res $al(MC,icorun) if {[ComForced]} { set res $al(comForce)\n[lindex [split $res \n] 1] } append res [AddTooltipRun] }
Undoes a change.
proc ::alited::tool::Undo {} { # Undoes a change. catch {event generate [alited::main::CurrentWTXT] <<Undo>>} }
Undoes all changes.
proc ::alited::tool::undoAll {} { # Undoes all changes. set wtxt [alited::main::CurrentWTXT] set plaintext [SetPlainText $wtxt yes] while {[$wtxt edit canundo]} { if {[Undo]} break } SetPlainText $wtxt $plaintext }
Adds a new item to the tree.
| an item's ID where the new item will be added (for the file tree); optional, default "" |
proc ::alited::tree::AddItem {{ID {}}} { # Adds a new item to the tree. # ID - an item's ID where the new item will be added (for the file tree). namespace upvar ::alited al al if {$al(TREE,isunits)} { alited::unit::Add } else { alited::file::Add $ID } }
Creates tags for the tree.
| the tree's path |
proc ::alited::tree::AddTags {wtree} { # Creates tags for the tree. # wtree - the tree's path namespace upvar ::alited al al lassign [alited::FgAdditional] fgbr fgred fgtodo append fontN "-font $::alited::al(FONT,defsmall)" append fontS $fontN " -foreground $fgred" $wtree tag configure tagNorm {*}$fontN $wtree tag configure tagSel {*}$fontS $wtree tag configure tagBold -foreground magenta $wtree tag configure tagTODO -foreground $fgtodo $wtree tag configure tagBranch -foreground $fgbr }
Adds tagSel tag to the unit tree's item.
| the tree's path |
| the item's ID |
proc ::alited::tree::AddTagSel {wtree ID} { # Adds tagSel tag to the unit tree's item. # wtree - the tree's path # ID - the item's ID set leaf [lindex [$wtree item $ID -values] 5] if {[string is true -strict $leaf] && ![$wtree tag has tagTODO $ID]} { $wtree tag add tagSel $ID } }
Adds an item to a list of directory's contents.
| level in the directory hierarchy |
| a flag "file" (if yes) or "directory" (if no) |
| a file name to be added |
| index of the directory's parent or -1 |
proc ::alited::tree::AddToDirContents {lev isfile fname iroot} { # Adds an item to a list of directory's contents. # lev - level in the directory hierarchy # isfile - a flag "file" (if yes) or "directory" (if no) # fname - a file name to be added # iroot - index of the directory's parent or -1 namespace upvar ::alited al al _dirtree _dirtree set dllen [llength $_dirtree] if {$dllen < $al(MAXFILES)} { lappend _dirtree [list $lev $isfile $fname 0 $iroot] if {$iroot>-1} { lassign [lindex $_dirtree $iroot] lev isfile fname fcount sroot set _dirtree [lreplace $_dirtree $iroot $iroot [list $lev $isfile $fname [incr fcount] $sroot]] } } return $dllen }
Fixes a problem with the tree scrollbar's width at resizing the panes. The problem occurs if Frame's width is less than Tree's + Scrollbar's, as then the scrollbar is squeezed. Thus the Tree's width should be adjusted. The restart of alited will fully repair this.
proc ::alited::tree::AdjustWidth {} { # Fixes a problem with the tree scrollbar's width at resizing the panes. # The problem occurs if Frame's width is less than Tree's + Scrollbar's, as # then the scrollbar is squeezed. Thus the Tree's width should be adjusted. # The restart of alited will fully repair this. namespace upvar ::alited al al obPav obPav set wpf [winfo width [$obPav FraTree]] set ws1 [winfo width [$obPav SbvTree]] set ws2 [winfo width [$obPav SbvFavor]] set w2 [[$obPav Tree] column #1 -width] [$obPav Tree] column #0 -width [expr {$wpf-$w2-$ws2-4}] }
Starts moving an item of the tree.
| mouse button |
| state (ctrl/alt/shift) |
| x-coordinate to identify an item |
| y-coordinate to identify an item |
| x-coordinate of the click |
| x-coordinate of the click |
proc ::alited::tree::ButtonMotion {but s x y X Y} { # Starts moving an item of the tree. # but - mouse button # s - state (ctrl/alt/shift) # x - x-coordinate to identify an item # y - y-coordinate to identify an item # X - x-coordinate of the click # Y - x-coordinate of the click namespace upvar ::alited al al obPav obPav if {![info exists al(movWin)] || $al(movWin) eq {}} { return } if {$s & 0b111} { set al(movWin) {} return } set wtree [$obPav Tree] # dragging the tab if {![winfo exists $al(movWin)]} { # make the tab's replica to be dragged toplevel $al(movWin) if {$al(IsWindows)} { wm attributes $al(movWin) -alpha 0.0 } else { wm withdraw $al(movWin) } if {[tk windowingsystem] eq {aqua}} { ::tk::unsupported::MacWindowStyle style $al(movWin) help none } else { wm overrideredirect $al(movWin) 1 } set selection [$wtree selection] if {[set il [llength $selection]]>1} { set al(movID) $selection set text "$il items" } else { set text [$wtree item $al(movID) -text] } label $al(movWin).label -text $text -relief solid -foreground $al(MOVEFG) -background $al(MOVEBG) pack $al(movWin).label -expand 1 -fill both -ipadx 1 } set ID [$wtree identify item $x $y] wm geometry $al(movWin) +[expr {$X+10}]+[expr {$Y+10}] if {$al(IsWindows)} { if {[wm attributes $al(movWin) -alpha] < 0.1} {wm attributes $al(movWin) -alpha 1.0} } else { catch {wm deiconify $al(movWin) ; raise $al(movWin)} } }
Handles a mouse clicking the tree.
| mouse button |
| x-coordinate to identify an item |
| y-coordinate to identify an item |
| x-coordinate of the click |
| x-coordinate of the click |
proc ::alited::tree::ButtonPress {but x y X Y} { # Handles a mouse clicking the tree. # but - mouse button # x - x-coordinate to identify an item # y - y-coordinate to identify an item # X - x-coordinate of the click # Y - x-coordinate of the click namespace upvar ::alited al al obPav obPav set wtree [$obPav Tree] set ID [$wtree identify item $x $y] set region [$wtree identify region $x $y] set al(movID) [set al(movWin) {}] if {![$wtree exists $ID] || $region ni {tree cell}} { return ;# only tree items are processed } switch $but { {3} { if {[llength [$wtree selection]]<2} { $wtree selection set $ID } ShowPopupMenu $ID $X $Y } {1} { set al(movID) $ID set al(movWin) .tritem_move set msec [clock milliseconds] set doubleclick [expr {[info exists al(_MSEC)] && [expr {($msec-$al(_MSEC))<400}]}] set al(_MSEC) $msec if {$doubleclick} { ;# at double click: DestroyMoveWindow yes ;# disable any drag-drop } if {$al(TREE,isunits)} { NewSelection $ID alited::main::SaveVisitInfo } elseif {$doubleclick} { OpenFile $ID } } } }
Handles a mouse button releasing on the tree, at moving an item.
| mouse button |
| state (ctrl/alt/shift) |
| x-coordinate to identify an item |
| y-coordinate to identify an item |
| x-coordinate of the click |
| x-coordinate of the click |
proc ::alited::tree::ButtonRelease {but s x y X Y} { # Handles a mouse button releasing on the tree, at moving an item. # but - mouse button # s - state (ctrl/alt/shift) # x - x-coordinate to identify an item # y - y-coordinate to identify an item # X - x-coordinate of the click # Y - x-coordinate of the click namespace upvar ::alited al al obPav obPav set wtree [$obPav Tree] set ID [$wtree identify item $x $y] DestroyMoveWindow no set msec [clock milliseconds] set ctrl [expr {$s & 0b100}] if {([info exists al(_MSEC)] && [expr {($msec-$al(_MSEC))<400}]) || $ctrl} { SelectUnits $wtree $ctrl set al(movWin) {} return } if {[$wtree exists $ID] && [info exists al(movID)] && $al(movID) ne {} && $ID ne {} && $al(movID) ne $ID && [$wtree identify region $x $y] eq {tree}} { if {$al(TREE,isunits)} { alited::unit::MoveUnits $wtree move $al(movID) $ID } else { alited::file::MoveFiles $wtree move $al(movID) $ID } } DestroyMoveWindow yes }
Color units of the tree.
| a current tab's ID |
| text's path |
| tree's path |
| waiting mode: -1 no wait, >0 wait for highlighting done, 0 waiting done |
proc ::alited::tree::ColorUnitsTree {TID wtxt wtree wait} { # Color units of the tree. # TID - a current tab's ID # wtxt - text's path # wtree - tree's path # wait - waiting mode: -1 no wait, >0 wait for highlighting done, 0 waiting done namespace upvar ::alited al al if {$TID ne [alited::bar::CurrentTabID]} return # colorizing should wait for the highlighting done if {$wait>0} { if {[alited::file::IsClang [alited::bar::FileName $TID]]} { set dowait [expr {![::hl_c::isdone $wtxt]}] } else { set dowait [expr {![::hl_tcl::isdone $wtxt]}] } if {$dowait} { incr wait -1 after 100 [list alited::tree::ColorUnitsTree $TID $wtxt $wtree $wait] return } } set ctab [alited::bar::CurrentTabID] set todolist [list] foreach {tr1 tr2} [$wtxt tag ranges tagCMN2] { lappend todolist [expr {int($tr1)}] } $wtree tag remove tagTODO if {$wait==-1} { $wtree tag remove tagBranch $wtree tag remove tagSel } foreach item $al(_unittree,$TID) { if {[llength $item]<3} continue set itemID [alited::tree::NewItemID [incr iit]] lassign $item lev leaf fl1 title l1 l2 set tag tagNorm foreach tr $todolist { if {$tr>=$l1 && $tr<=$l2} { set tag tagTODO break } } catch { if {$leaf && [info exists al(CPOS,$ctab,[alited::unit::GetHeader $wtree $itemID])]} { if {$tag ne {tagTODO}} {set tag tagSel} } } if {!$leaf} { if {$tag ne {tagTODO}} {set tag tagBranch} } if {$tag ne {tagNorm} && ($wait==-1 && $tag ne {tagTODO} || $tag eq {tagTODO})} { if {[catch {$wtree tag add $tag $itemID}]} break } } }
Creates a tree of units/files, at need.
proc ::alited::tree::Create {} { # Creates a tree of units/files, at need. # See also: CreateFilesTree namespace upvar ::alited al al obPav obPav if {$al(TREE,isunits) && $al(TREE,units) || !$al(TREE,isunits) && $al(TREE,files)} return ;# no need set wtree [$obPav Tree] set branchexp [OldExpanded $wtree [GetTree]] if {$al(TREE,isunits)} { pack forget [$obPav BtTRenT] ;# hide file buttons for unit tree pack forget [$obPav BtTCloT] pack forget [$obPav BtTOpen] } else { pack [$obPav BtTRenT] -side left -after [$obPav BtTAddT] ;# show file buttons pack [$obPav BtTCloT] -side left -after [$obPav BtTDelT] pack [$obPav BtTOpen] -side left -after [$obPav BtTCloT] # get file tree's current "open branch" flags to check in CreateFilesTree } set TID [alited::bar::CurrentTabID] Delete $wtree {} $TID AddTags $wtree $wtree tag bind tagNorm <ButtonPress> {after idle {alited::tree::ButtonPress %b %x %y %X %Y}} $wtree tag bind tagNorm <ButtonRelease> {after idle {alited::tree::ButtonRelease %b %s %x %y %X %Y}} $wtree tag bind tagNorm <Motion> {after idle {alited::tree::ButtonMotion %b %s %x %y %X %Y}} bind $wtree <ButtonRelease> {alited::tree::DestroyMoveWindow no} bind $wtree <Leave> {alited::tree::DestroyMoveWindow yes} bind $wtree <F2> {alited::file::RenameFileInTree 0 -} bind $wtree <Insert> {alited::tree::AddItem} bind $wtree <Delete> {alited::tree::DelItem {} {}} if {$al(TREE,isunits)} { CreateUnitsTree $TID $wtree $branchexp } else { CreateFilesTree $wtree $branchexp } }
Creates a file tree.
| the tree's path |
| list of old expanded branches |
proc ::alited::tree::CreateFilesTree {wtree branchexp} { # Creates a file tree. # wtree - the tree's path # branchexp - list of old expanded branches namespace upvar ::alited al al obPav obPav set al(TREE,files) yes [$obPav BtTswitch] configure -image alimg_gulls baltip::tip [$obPav BtTswitch] $al(MC,swfiles) baltip::tip [$obPav BtTAddT] $al(MC,filesadd)\nInsert baltip::tip [$obPav BtTDelT] $al(MC,filesdel)\nDelete baltip::tip [$obPav BtTUp] $al(MC,moveupF) baltip::tip [$obPav BtTDown] $al(MC,movedownF) $wtree heading #0 -text ":: $al(prjname) ::" $wtree heading #1 -text $al(MC,files) bind $wtree <Return> {::alited::tree::OpenFile} if {[catch {set selfile [alited::bar::FileName]}]} { set selfile {} ;# at closing by Ctrl+W with file tree open: no current file } set filesTIDs [alited::bar::FilesTIDs] PrepareDirectoryContents foreach item [GetDirectoryContents $al(prjroot)] { set itemID [alited::tree::NewItemID [incr iit]] lassign $item lev isfile fname fcount iroot set title [file tail $fname] if {$iroot<0} { set parent {} } else { set parent [alited::tree::NewItemID [incr iroot]] } if {$isfile} { if {[alited::file::IsTcl $fname]} { set imgopt {-image alimg_tclfile} } else { set imgopt {-image alimg_file} } } else { set imgopt {-image alimg_folder} # get the directory's flag of expanded branch (in the file tree) } if {$fcount} {set fc $fcount} {set fc {}} set isopen [expr {$al(expandFT) || [IsOldExpanded $branchexp $isfile $title]}] $wtree insert $parent end -id $itemID -text "$title" -values [list $fc $fname $isfile $itemID] -open $isopen {*}$imgopt $wtree tag add tagNorm $itemID if {!$isfile} { $wtree tag add tagBranch $itemID } elseif {[alited::bar::FileTID $fname $filesTIDs] ne {}} { $wtree tag add tagSel $itemID } } }
Creates a unit tree for a tab.
| a current tab's ID |
| the tree's path |
| list of old expanded branches |
proc ::alited::tree::CreateUnitsTree {TID wtree branchexp} { # Creates a unit tree for a tab. # TID - a current tab's ID # wtree - the tree's path # branchexp - list of old expanded branches namespace upvar ::alited al al obPav obPav set al(TREE,units) yes [$obPav BtTswitch] configure -image alimg_folder baltip::tip [$obPav BtTswitch] $al(MC,swunits) baltip::tip [$obPav BtTAddT] $al(MC,tpl) baltip::tip [$obPav BtTDelT] $al(MC,unitsdel) baltip::tip [$obPav BtTUp] $al(MC,moveupU) baltip::tip [$obPav BtTDown] $al(MC,movedownU) $wtree heading #0 -text [alited::bar::CurrentTab 1] $wtree heading #1 -text [msgcat::mc Row] set parents [list {}] set parent {} set levprev -1 set wtxt [alited::main::GetWTXT $TID] foreach item $al(_unittree,$TID) { incr iiuni if {[llength $item]<3} continue set itemID [alited::tree::NewItemID [incr iit]] lassign $item lev leaf fl1 title l1 l2 set title [UnitTitle $title $l1 $l2] set lev [expr {min($lev,[llength $parents])}] set parent [lindex $parents [expr {$lev-1}]] if {$leaf} { set title " $title" set pr [expr {max(0,min(7,($l2-$l1-$::alited::al(minredunit))/$al(prjredunit)))}] set imgopt "-image alimg_pro$pr" set isopen no } else { set imgopt "-image alimg_gulls" set levtmp [expr ([lindex $al(_unittree,$TID) $iiuni 0]+0)] set isopen [expr {$levtmp>$lev && [IsExpandUT]}] } if {!$isopen && [IsOldExpanded $branchexp $leaf $title]} {set isopen yes} $wtree insert $parent end -id $itemID -text "$title" -values [list $l1 $l2 {} $itemID $lev $leaf $fl1] -open $isopen {*}$imgopt $wtree tag add tagNorm $itemID if {!$leaf} { set parent $itemID catch {set parents [lreplace $parents $lev end $parent]} } set levprev $lev } alited::tree::ColorUnitsTree $TID $wtxt $wtree -1 ;# color without todos, then with after idle [list after 10 [list alited::tree::ColorUnitsTree $TID $wtxt $wtree 50]] }
Gets ID of selected item of the tree.
| the tree widget's name; optional, default Tree |
| full path to the tree; optional, default "" |
proc ::alited::tree::CurrentItem {{Tree Tree} {wtree {}}} { # Gets ID of selected item of the tree. # Tree - the tree widget's name # wtree - full path to the tree namespace upvar ::alited obPav obPav if {$wtree eq {}} {set wtree [$obPav $Tree]} set it [$wtree focus] if {$it eq {}} {set it [lindex [$wtree selection] 0]} return $it }
Gets item ID of unit tree for a current text position.
| the current text position; optional, default "" |
| if yes, returns a full info for the found ID; optional, default no |
proc ::alited::tree::CurrentItemByLine {{pos {}} {fullinfo no}} { # Gets item ID of unit tree for a current text position. # pos - the current text position # fullinfo - if yes, returns a full info for the found ID. namespace upvar ::alited al al if {$pos eq {}} { set pos [[alited::main::CurrentWTXT] index insert] } set l [expr {int($pos)}] set TID [alited::bar::CurrentTabID] set L 0 set R [llength $al(_unittree,$TID)] while {$L<$R} { set m [expr {int(($L+$R)/2)}] lassign [lindex $al(_unittree,$TID) $m] lev leaf fl1 title l1 l2 ID if {$l2<$l} { set L [incr m] } elseif {$l1>$l} { set R $m } else { if {$fullinfo} { return [list $ID $lev $leaf $fl1 $title $l1 $l2] } return $ID } } return {} }
Removes recursively an item and its children from the tree.
| the tree widget's path |
| ID of the item to be deleted. |
| Not documented. |
proc ::alited::tree::Delete {wtree item TID} { # Removes recursively an item and its children from the tree. # wtree - the tree widget's path # item - ID of the item to be deleted. foreach child [$wtree children $item] { alited::tree::Delete $wtree $child $TID } if {$item ne {}} {$wtree delete $item} }
Removes an item from the tree.
| an item's ID to be deleted; optional, default "" |
| relative Y-coordinate for a query; optional, default 10 |
proc ::alited::tree::DelItem {{ID {}} {sy 10}} { # Removes an item from the tree. # ID - an item's ID to be deleted. # sy - relative Y-coordinate for a query namespace upvar ::alited al al obPav obPav if {$ID eq {} && [set ID [alited::tree::CurrentItem]] eq {}} { bell return } set wtree [$obPav Tree] set fname [alited::bar::FileName] if {$al(TREE,isunits)} { alited::unit::Delete $wtree $fname $sy } else { alited::file::Delete $ID $wtree $sy } }
Destroys an item moving window.
| if yes, clears also the related variables. |
proc ::alited::tree::DestroyMoveWindow {cancel} { # Destroys an item moving window. # cancel - if yes, clears also the related variables. namespace upvar ::alited al al catch {destroy $al(movWin)} if {$cancel} {lassign {} al(movWin) al(movID)} }
Reads a directory's contents.
| a dirtectory's name |
| level in the directory hierarchy; optional, default 0 |
| index of the directory's parent or -1; optional, default -1 |
| list of globs to filter files; optional, default * |
GetDirectoryContents, AddToDirContents
proc ::alited::tree::DirContents {dirname {lev 0} {iroot -1} {globs *}} { # Reads a directory's contents. # dirname - a dirtectory's name # lev - level in the directory hierarchy # iroot - index of the directory's parent or -1 # globs - list of globs to filter files. # See also: # GetDirectoryContents # AddToDirContents namespace upvar ::alited al al _dirtree _dirtree incr lev set tpl [file join $dirname *] if {[catch {set dcont [glob $tpl]}]} { set dcont [list] } catch { lappend dcont {*}[glob -type hidden $tpl] } set dcont [lsort -dictionary $dcont] # firstly directories: # 1. skip the ignored ones for {set i [llength $dcont]} {$i} {} { incr i -1 if {[IgnoredDir [lindex $dcont $i]]} { set dcont [lreplace $dcont $i $i] } } # 2. put the directories to the beginning of the file list set i 0 foreach fname $dcont { if {[file isdirectory $fname]} { set dcont [lreplace $dcont $i $i [list $fname "y"]] set nroot [AddToDirContents $lev 0 $fname $iroot] if {[llength $_dirtree] < $al(MAXFILES)} { DirContents $fname $lev $nroot $globs } else { break } } else { set dcont [lreplace $dcont $i $i [list $fname]] } incr i } # then files if {[llength $_dirtree] < $al(MAXFILES)} { foreach fname $dcont { lassign $fname fname d if {$d ne "y"} { foreach gl [split $globs ","] { if {[string match $gl $fname]} { AddToDirContents $lev 1 $fname $iroot break } } } } } }
Drops (moves) selected items to a current position.
| ID of an item to be clicked |
proc ::alited::tree::DropItems {ID} { # Drops (moves) selected items to a current position. # ID - ID of an item to be clicked namespace upvar ::alited al al obPav obPav set wtree [$obPav Tree] set selection [$wtree selection] if {[$wtree exists $ID] && $selection ne {} && $ID ne {} && $selection ne $ID} { if {$al(TREE,isunits)} { alited::unit::MoveUnits $wtree move $selection $ID } else { alited::file::MoveFiles $wtree move $selection $ID } } }
Expands or contracts the tree.
| the tree's name |
| yes, if to expand; no, if to contract; optional, default yes |
proc ::alited::tree::ExpandContractTree {Tree {isexp yes}} { # Expands or contracts the tree. # Tree - the tree's name # isexp - yes, if to expand; no, if to contract namespace upvar ::alited al al obPav obPav if {!$isexp && ![IsExpandedTree]} { # restore expanded mode without updating tree ExpandedTree yes IconContract return } set wtree [$obPav $Tree] if {$al(TREE,isunits)} { set pos [[alited::main::CurrentWTXT] index insert] lassign [CurrentItemByLine $pos 1] itemID } else { set itemID [CurrentItem] } ExpandedTree $isexp IconContract set branch [set selbranch {}] foreach item [GetTree {} $Tree] { lassign $item lev cnt ID if {[llength [$wtree children $ID]]} { set branch $ID $wtree item $ID -open $isexp } if {$ID eq $itemID} {set selbranch $branch} } if {$isexp} { if {$itemID ne {}} {$wtree selection set $itemID} SeeSelection } elseif {$selbranch ne {}} { $wtree selection set $selbranch SeeSelection } }
Sets expanded mode of tree.
| new mode |
proc ::alited::tree::ExpandedTree {isexp} { # Sets expanded mode of tree. # isexp - new mode namespace upvar ::alited al al if {$al(TREE,isunits)} { dict set al(expandUT) [alited::bar::FileName] $isexp } else { set al(expandFT) $isexp } }
Expands the tree selection, counting the tree expanded mode.
| ID of selection |
| tree's path; optional, default "" |
proc ::alited::tree::ExpandSelection {selID {wtree {}}} { # Expands the tree selection, counting the tree expanded mode. # selID - ID of selection # wtree - tree's path namespace upvar ::alited obPav obPav if {[IsExpandedTree]} { if {$wtree eq {}} {set wtree [$obPav Tree]} catch {$wtree see $selID} } }
Scans all items of the tree.
| the tree's path |
| a procedure to run at scanning |
| level of the tree; optional, default 0 |
| ID of the branch to be scanned; optional, default "" |
The 'aproc' argument can include wildcards to be replaced appropriate data:
%level | current tree level |
%children | children of a current item |
%item | ID of a current item |
%text | text of a current item |
%values | values of a current item |
proc ::alited::tree::ForEach {wtree aproc {lev 0} {branch {}}} { # Scans all items of the tree. # wtree - the tree's path # aproc - a procedure to run at scanning # lev - level of the tree # branch - ID of the branch to be scanned # The 'aproc' argument can include wildcards to be replaced # appropriate data: # %level - current tree level # %children - children of a current item # %item - ID of a current item # %text - text of a current item # %values - values of a current item set children [$wtree children $branch] if {$lev} { set proc [string map [list %level $lev %children [llength $children] %item $branch %text [$wtree item $branch -text] %values [$wtree item $branch -values]] $aproc] catch {uplevel [expr {$lev+1}] $proc} } incr lev foreach child $children { ForEach $wtree $aproc $lev $child } }
Gets a directory's contents.
| the directory's name |
Returns a list containing the directory's contents.
proc ::alited::tree::GetDirectoryContents {dirname} { # Gets a directory's contents. # dirname - the directory's name # Returns a list containing the directory's contents. # See also: DirContents namespace upvar ::alited _dirtree _dirtree DirContents $dirname return $_dirtree }
Gets a tip for unit / file tree's item.
| ID of treeview item |
| column of treeview item |
proc ::alited::tree::GetTooltip {ID NC} { # Gets a tip for unit / file tree's item. # ID - ID of treeview item # NC - column of treeview item namespace upvar ::alited al al obPav obPav if {[info exists al(movWin)] && $al(movWin) ne {} || ![::alited::IsTipable]} { return {} ;# no tips while drag-n-dropping or focusing somewhere else } set wtree [$obPav Tree] if {$al(TREE,isunits)} { # for units set tip [alited::unit::GetHeader $wtree $ID $NC] # try to read and add TODOs for this unit catch { lassign [$wtree item $ID -values] l1 l2 set wtxt [alited::main::CurrentWTXT] append tip [UnitTooltip $wtxt $l1 $l2] } if {!$al(TIPS,Tree) && ![info exists todo]} { # no tips while switched off (excepting for TODOs) return {} } } else { # for files lassign [$wtree item $ID -values] -> tip isfile if {$isfile} { if {$al(TREE,showinfo)} { set tip [alited::file::FileStat $tip] } else { set tip {} } } } return $tip }
Gets a tree or its branch.
| ID of the branch; optional, default "" |
| name of the tree widget; optional, default Tree |
| full path to the tree; optional, default "" |
proc ::alited::tree::GetTree {{parent {}} {Tree Tree} {wtree {}}} { # Gets a tree or its branch. # parent - ID of the branch # Tree - name of the tree widget # wtree - full path to the tree namespace upvar ::alited obPav obPav if {$wtree eq {}} {set wtree [$obPav $Tree]} set tree [list] set levp -1 ForEach $wtree { set item "%item" set lev %level if {$levp>-1 || $item eq $parent} { if {$lev<=$levp} {return -code break} ;# all of branch fetched if {$item eq $parent} {set levp $lev} } catch { if {$parent eq {} || $levp>-1} { lappend tree [list $lev %children $item {%text} {%values}] } } } return $tree }
Sets "Contract All" toolbar action's icon.
proc ::alited::tree::IconContract {} { # Sets "Contract All" toolbar action's icon. namespace upvar ::alited obPav obPav if {[IsExpandedTree]} { set ico alimg_minus } else { set ico alimg_actions } [$obPav PanL].fraBot.panBM.fraTree.fra1.btTCtr configure -image $ico }
Checks if a directory is in the list of the ignored ones.
| the directory's name |
proc ::alited::tree::IgnoredDir {dir} { # Checks if a directory is in the list of the ignored ones. # dir - the directory's name namespace upvar ::alited al al set dir [string toupper [file tail $dir]] return [expr {[lsearch -exact $al(_dirignore) $dir]>-1}] }
Gets a flag "the tree is in expanded mode".
proc ::alited::tree::IsExpandedTree {} { # Gets a flag "the tree is in expanded mode". namespace upvar ::alited al al expr {$al(TREE,isunits) && [IsExpandUT] || !$al(TREE,isunits) && $al(expandFT)} }
Gets a flag "expanding unit tree of text".
| file name; optional, default "" |
proc ::alited::tree::IsExpandUT {{fname {}}} { # Gets a flag "expanding unit tree of text". # fname - file name namespace upvar ::alited al al if {$fname eq {}} {set fname [alited::bar::FileName]} expr {![dict exists $al(expandUT) $fname] || [dict get $al(expandUT) $fname]} }
Checks if branch was expanded.
| list of old expanded branches |
| yes if it's leaf |
| item's title |
proc ::alited::tree::IsOldExpanded {branchexp leaf title} { # Checks if branch was expanded. # branchexp - list of old expanded branches # leaf - yes if it's leaf # title - item's title expr {!$leaf && [lsearch -exact $branchexp $title]>-1} }
Moves items of the tree (units or files)
| direction ("up" or "down") |
| true, if started by keypressing (false, if by mouse); optional, default no |
proc ::alited::tree::MoveItem {to {f1112 no}} { # Moves items of the tree (units or files) # to - direction ("up" or "down") # f1112 - true, if started by keypressing (false, if by mouse) namespace upvar ::alited al al obPav obPav if {!$al(TREE,isunits) && [alited::file::MoveExternal $f1112]} return set wtree [$obPav Tree] set itemID [$wtree selection] if {$itemID eq {}} { set itemID [$wtree focus] } if {$itemID eq {}} { if {$f1112} {set geo {}} {set geo {-geometry pointer+10+10}} alited::Message {No item selected.} 4 return } if {$al(TREE,isunits)} { alited::unit::MoveUnits $wtree $to $itemID $f1112 } else { alited::file::MoveFiles $wtree $to $itemID $f1112 } }
Gets a new ID for the tree item.
| index of the new item. |
proc ::alited::tree::NewItemID {iit} { # Gets a new ID for the tree item. # iit - index of the new item. return "al$iit" }
Selects a new item of the unit tree.
| ID of the new selected item; optional, default "" |
| a relative line number inside the item or an absolute position in the text; optional, default 0 |
| if yes, 'line' is an absolute position in the text; optional, default no |
Returns ID of the newly selected item.
proc ::alited::tree::NewSelection {{itnew {}} {line 0} {topos no}} { # Selects a new item of the unit tree. # itnew - ID of the new selected item # line - a relative line number inside the item or an absolute position in the text # topos - if yes, 'line' is an absolute position in the text # Returns ID of the newly selected item. namespace upvar ::alited al al obPav obPav variable doFocus set TID [alited::bar::CurrentTabID] set wtxt [alited::main::CurrentWTXT] set ctab [alited::bar::CurrentTabID] set wtree [$obPav Tree] # newly selected item if {$itnew eq {}} { if {$topos} { set itnew [CurrentItemByLine $line] } else { set itnew [CurrentItem] } } set header [alited::unit::GetHeader $wtree $itnew] lassign [$wtree item $itnew -values] l1 l2 AddTagSel $wtree $itnew # get saved pos if {[info exists al(CPOS,$ctab,$header)]} { set pos [::apave::p+ $l1 $al(CPOS,$ctab,$header)] } else { set pos [$wtxt index insert] } if {$topos} { set pos $line } elseif {[string is digit -strict $l1] && [string is digit -strict $l2]} { if {[string is double -strict $line] && $line != 0 && $l1<($l1+$line) && ($l1+$line)<($l2+1)} { # it's coming from a saved favorite item set pos [expr {$l1+$line}] } else { if {$pos<$l1 || $pos>=($l2+1)} { # if not saved, get it from 1st line set pos $l1.0 } } } # previously selected item lassign [alited::bar::BAR cget --currSelTab --currSelItem] otab itold if {$itold ne "" && ![catch {lassign [$wtree item $itold -values] o1 o2}]} { # if there was the previously selected item, save its cursor position catch { # -values at files' tree is invalid for this => 'catch' # (then pos=saved position for the whole file, got from --pos) set opos [$wtxt index insert] if {$o1<=$opos && $opos<($o2+1)} { set ohead [alited::unit::GetHeader $wtree $itold] set al(CPOS,$otab,$ohead) [::apave::p+ $opos -$o1] } } } alited::bar::BAR configure --currSelTab $ctab --currSelItem $itnew catch {set al(CPOS,$ctab,$header) [::apave::p+ $pos -$l1]} if {$doFocus} { alited::main::FocusText $TID $pos } if {$al(TREE,isunits) && $al(dolastvisited)} { alited::favor::LastVisited [$wtree item $itnew] $header } alited::main::UpdateGutter return $itnew }
Gets a list of old expanded branches.
| tree widget |
| tree contents as provided by GetTree |
proc ::alited::tree::OldExpanded {wtree tree} { # Gets a list of old expanded branches. # wtree - tree widget # tree - tree contents as provided by GetTree set res [list] foreach it $tree { lassign $it lev children item text if {$children} { catch { if {[$wtree item $item -open]} { lappend res $text } } } } return $res }
Opens file at clicking a file tree's item.
| ID of unit tree; optional, default "" |
proc ::alited::tree::OpenFile {{ID {}}} { # Opens file at clicking a file tree's item. # ID - ID of unit tree namespace upvar ::alited al al obPav obPav if {!$al(TREE,isunits)} { set wtree [$obPav Tree] if {$ID eq {}} { if {[set ID [$wtree selection]] eq {}} return } lassign [$wtree item $ID -values] -> fname isfile if {$isfile} { alited::file::OpenFile $fname after idle {alited::bar::BAR draw; alited::tree::UpdateFileTree} } } }
Prepares reading a directory's contents.
proc ::alited::tree::PrepareDirectoryContents {} { # Prepares reading a directory's contents. # See also: GetDirectoryContents namespace upvar ::alited al al _dirtree _dirtree set _dirtree [set al(_dirignore) [list]] catch { ;# there might be an incorrect list -> catch it foreach d $al(prjdirign) { lappend al(_dirignore) [string toupper [string trim $d \"]] } } lappend al(_dirignore) [string toupper [file tail [alited::Tclexe]]] . .. }
Recreates the tree and restores its selections.
| the tree's path; optional, default "" |
| a list of selected items; optional, default "" |
| if yes, clears tree's selection; optional, default no |
proc ::alited::tree::RecreateTree {{wtree {}} {headers {}} {clearsel no}} { # Recreates the tree and restores its selections. # wtree - the tree's path # headers - a list of selected items # clearsel - if yes, clears tree's selection namespace upvar ::alited al al obPav obPav if {$wtree eq {}} {set wtree [$obPav Tree]} if {$clearsel || [catch {set selection [$wtree selection]}]} { set selection [list] } if {$al(TREE,isunits)} { set al(TREE,units) no set TID [alited::bar::CurrentTabID] set wtxt [alited::main::CurrentWTXT] alited::unit::RecreateUnits $TID $wtxt } else { set al(TREE,files) no } Create # restore selections if {$headers eq {-}} return if {$headers ne {}} { set selection [list] foreach item [alited::tree::GetTree] { lassign $item lev cnt ID foreach hd $headers { if {[alited::unit::GetHeader $wtree $ID] eq $hd} { lappend selection $ID break } } } $wtree selection set $selection } else { # try to restore selections foreach item $selection { catch {$wtree selection add $item} } } catch {$wtree see [lindex $selection 0]} }
Saves current unit's cursor position.
proc ::alited::tree::SaveCursorPos {} { # Saves current unit's cursor position. # See also: favor::GoToUnit namespace upvar ::alited al al obPav obPav set TID [alited::bar::CurrentTabID] set wtxt [alited::main::CurrentWTXT] set pos [$wtxt index insert] # catch is needed at creating text, as the tree doesn't exist catch { set itnew [CurrentItemByLine $pos] set wtree [$obPav Tree] set header [alited::unit::GetHeader $wtree $itnew] # save the position to unit tree list, to restore it in favor::GoToUnit set it [lsearch -exact -index 6 $al(_unittree,$TID) $itnew] if {$it>-1} { set item [lindex $al(_unittree,$TID) $it] set item [lreplace $item 7 7 $pos] set al(_unittree,$TID) [lreplace $al(_unittree,$TID) $it $it $item] } } return $pos }
Sees file name in tree.
| file name |
proc ::alited::tree::SeeFile {fname} { # Sees file name in tree. # fname - file name namespace upvar ::alited obPav obPav set id [alited::file::SearchInFileTree $fname] if {$id ne {}} { set wtree [$obPav Tree] after idle [list after 100 "catch {$wtree selection set $id; $wtree see $id}"] } }
Sees (makes visible) a current selected item in the tree.
| tree's path; optional, default "" |
proc ::alited::tree::SeeSelection {{wtree {}}} { # Sees (makes visible) a current selected item in the tree. # wtree - tree's path namespace upvar ::alited al al obPav obPav if {$wtree eq {}} {set wtree [$obPav Tree]} set selection [$wtree selection] if {[llength $selection]==1} {ExpandSelection $selection $wtree} }
Sees item in tree.
proc ::alited::tree::SeeTreeItem {} { # Sees item in tree. after idle { after 200 { if {$::alited::al(TREE,isunits)} { alited::tree::SeeUnit } else { alited::tree::SeeFile [alited::bar::FileName] } } } }
Sees unit name in tree.
proc ::alited::tree::SeeUnit {} { # Sees unit name in tree. namespace upvar ::alited obPav obPav catch {[$obPav Tree] see [CurrentItemByLine]} }
Selects units at Ctrl/Shift clicking the unit tree.
| path to tree widget |
| 1 if pressed Ctrl/Shift key at clicking |
proc ::alited::tree::SelectUnits {wtree ctrl} { # Selects units at Ctrl/Shift clicking the unit tree. # wtree - path to tree widget # ctrl - 1 if pressed Ctrl/Shift key at clicking namespace upvar ::alited al al if {!$ctrl || !$al(TREE,isunits)} return set wtxt [alited::main::CurrentWTXT] $wtxt tag remove sel 1.0 end foreach ID [$wtree selection] { lassign [$wtree item $ID -values] l1 l2 $wtxt tag add sel $l1.0 [incr l2].0 } }
Creates and opens a popup menu at right clicking the tree.
| ID of clicked item |
| x-coordinate of the click |
| y-coordinate of the click |
proc ::alited::tree::ShowPopupMenu {ID X Y} { # Creates and opens a popup menu at right clicking the tree. # ID - ID of clicked item # X - x-coordinate of the click # Y - y-coordinate of the click namespace upvar ::alited al al obPav obPav ::baltip sleep 1000 set wtree [$obPav Tree] set popm $wtree.popup catch {destroy $popm} menu $popm -tearoff 0 set header [lindex [split [alited::unit::GetHeader $wtree $ID] \n] 0] set sname [$wtree item $ID -text] lassign [$wtree item $ID -values] -> fname isfile - - isunit if {$al(TREE,isunits)} { set img alimg_folder set m1 $al(MC,swunits) set m2 $al(MC,tpl) set m3 $al(MC,unitsdel) set moveup $al(MC,moveupU) set movedown $al(MC,movedownU) set dropitem [msgcat::mc {Drop Selected Units Here}] set accins {} set accdel {} } else { set img alimg_gulls set m1 $al(MC,swfiles) set m2 $al(MC,filesadd...) set m3 $al(MC,filesdel) set moveup $al(MC,moveupF) set movedown $al(MC,movedownF) set dropitem [msgcat::mc {Drop Selected Files Here}] set accins {-accelerator Insert} set accdel {-accelerator Delete} } if {[string length $sname]>25} {set sname "[string range $sname 0 21]..."} $popm add command {*}[$obPav iconA none] -label $m1 -command ::alited::tree::SwitchTree -image $img $popm add command {*}[$obPav iconA none] -label $al(MC,updtree) -command alited::tree::RecreateTree -image alimg_retry $popm add separator $popm add command {*}[$obPav iconA none] -label $moveup -command {::alited::tree::MoveItem up} -image alimg_up $popm add command {*}[$obPav iconA none] -label $movedown -command {::alited::tree::MoveItem down} -image alimg_down $popm add separator $popm add command {*}[$obPav iconA none] -label $m2 -command "::alited::tree::AddItem $ID" {*}$accins -image alimg_add if {!$al(TREE,isunits)} { $popm add command {*}[$obPav iconA change] -label $al(MC,renamefile...) -accelerator F2 -command {::alited::file::RenameFileInTree no} } $popm add command {*}[$obPav iconA none] -label $m3 -command "::alited::tree::DelItem $ID -100" {*}$accdel -image alimg_delete if {$al(TREE,isunits)} { if {$al(FAV,IsFavor)} { $popm add separator $popm add command {*}[$obPav iconA heart] -label $al(MC,favoradd) -command ::alited::favor::AddFromTree } if {$isunit} { $popm add separator $popm add command {*}[$obPav iconA none] -label $al(MC,copydecl) -command "clipboard clear ; clipboard append {$header}" } } else { $popm add command {*}[$obPav iconA copy] -label $al(MC,clonefile...) -command ::alited::file::CloneFile $popm add command {*}[$obPav iconA OpenFile] -label $al(MC,openwith) -command ::alited::file::OpenWith $popm add separator if {$isfile} {set fname [file dirname $fname]} set sname [file tail $fname] $popm add command {*}[$obPav iconA none] -label $al(MC,openselfile) -command ::alited::file::OpenFiles set msg [string map [list %n $sname] $al(MC,openofdir)] $popm add command {*}[$obPav iconA none] -label $msg -command "::alited::file::OpenOfDir {$fname}" $popm add separator $popm add command {*}[$obPav iconA none] -label $al(MC,detachsel) -command ::alited::file::DetachFromTree } set addsel {} if {[llength [$wtree selection]]>1} { $popm add separator $popm add command {*}[$obPav iconA none] -label $dropitem -command "::alited::tree::DropItems $ID" -image alimg_paste if {[$wtree tag has tagSel $ID]} { # the added tagSel tag should be overrided $wtree tag remove tagSel $ID set addsel "; $wtree tag add tagSel $ID" } } bind $popm <FocusIn> "$wtree tag add tagBold $ID" bind $popm <FocusOut> "catch {$wtree tag remove tagBold $ID; $addsel}" $obPav themePopup $popm tk_popup $popm $X $Y }
| units to files and vice versa. |
proc ::alited::tree::SwitchTree {} { # Switches trees - units to files and vice versa. namespace upvar ::alited al al obPav obPav if {[set al(TREE,isunits) [expr {!$al(TREE,isunits)}]]} { unset al(widthPanBM) ;# the variable used to save the panel's size [$obPav PanL] add [$obPav FraFV] RecreateTree SeeUnit } else { set al(widthPanBM) [winfo geometry [$::alited::obPav PanBM]] [$obPav PanL] forget [$obPav FraFV] set al(TREE,files) no Create SeeFile [alited::bar::FileName] } IconContract alited::main::FocusText update idletasks }
Gets -geometry option of dialogues.
| relative Y-coordinate of dialogue |
proc ::alited::tree::syOption {sy} { # Gets -geometry option of dialogues. # sy - relative Y-coordinate of dialogue # See also: unit::Delete, file::Delete if {$sy eq {}} { set opt {} } else { set opt [list -geometry pointer+10+$sy] } return $opt }
Gets a title of a unit (checking for empty string).
| original title |
| first line of the unit |
| latst line of the unit |
proc ::alited::tree::UnitTitle {title l1 l2} { # Gets a title of a unit (checking for empty string). # title - original title # l1 - first line of the unit # l2 - latst line of the unit if {$title eq {}} {set title "$::alited::al(MC,lines) $l1-$l2"} return $title }
Gets unit's tooltip.
| text's path |
| 1st line's number |
| last line's number |
proc ::alited::tree::UnitTooltip {wtxt l1 l2} { # Gets unit's tooltip. # wtxt - text's path # l1 - 1st line's number # l2 - last line's number set tip {} foreach {p1 p2} [$wtxt tag ranges tagCMN2] { if {[$wtxt compare $l1.0 <= $p1] && [$wtxt compare $p2 <= $l2.end]} { set todo [string trimleft [$wtxt get $p1 $p2] #!] switch [incr tiplines] { 1 {append tip \n_______________________\n} 13 {break} } append tip \n $todo } } return $tip }
Updates the file tree (colors of files).
| yes, if run after idle; optional, default no |
proc ::alited::tree::UpdateFileTree {{doit no}} { # Updates the file tree (colors of files). # doit - yes, if run after idle # See also: CreateFilesTree namespace upvar ::alited al al obPav obPav if {$al(TREE,isunits)} return ;# no need if {$doit} { set wtree [$obPav Tree] foreach item [GetTree] { lassign [lindex $item 4] - fname leaf itemID if {$leaf} { if {[alited::bar::FileTID $fname] ne {}} { $wtree tag add tagSel $itemID } else { $wtree tag remove tagSel $itemID } } } } else { catch {after cancel $al(_UPDATEFILETREE_)} set al(_UPDATEFILETREE_) [after idle {alited::tree::UpdateFileTree yes}] } }
Runs a dialog "Add Template" and adds a chosen template to a text.
proc ::alited::unit::Add {} { # Runs a dialog "Add Template" and adds a chosen template to a text. set res [Run_unit_tpl] if {$res ne {}} {InsertTemplate $res no} alited::keys::BindKeys [alited::main::CurrentWTXT] template }
Actions after inserting type template.
| text's path |
| insertion index |
| template's contents |
proc ::alited::unit::AfterInsertingTypeTemplate {wtxt idxl tpl} { # Actions after inserting type template. # wtxt - text's path # idxl - insertion index # tpl - template's contents if {[set i [string first `` $tpl]]>-1} { set idxl [$wtxt index "$idxl +$i c"] $wtxt replace $idxl [$wtxt index "$idxl +2 c"] {} ::tk::TextSetCursor $wtxt $idxl } undoOut $wtxt alited::main::UpdateAll }
Checks the type template's version. If it's obsolete, updates it from alited's source.
| type template file name |
proc ::alited::unit::CheckTypeTemplate {fname} { # Checks the type template's version. # If it's obsolete, updates it from alited's source. # fname - type template file name namespace upvar ::alited DATADIR DATADIR set fcont [textsplit [string trimleft [readTextFile $fname]]] set fverAle 1.1 set fverCur [string trim [lindex $fcont 0] { []}] set fnameAle [file join $DATADIR typetpl [file tail $fname]] if {$fverAle > $fverCur && [file exists $fnameAle]} { set fcont [textsplit [readTextFile $fnameAle]] if {[catch {file copy -force $fnameAle $fname} err]} { alited::Message $err 4 } } return $fcont }
Corrects an insert position, counting the insertion point's indentation.
| current text widget |
| template's text |
| relative position of cursor |
| position of insertion |
| cursor position |
proc ::alited::unit::CorrectPos {wtxt tex posc pos0 posi} { # Corrects an insert position, counting the insertion point's indentation. # wtxt - current text widget # tex - template's text # posc - relative position of cursor # pos0 - position of insertion # posi - cursor position namespace upvar ::alited al al variable REtodel set tlist [split $tex \n] set indent1 0 foreach t $tlist { if {[set t [string trim $t]] ne {}} { set indent1 [obj leadingSpaces $t] ;# indentation of the template break } } set pos1 [expr {int([$wtxt index $pos0])}] set line2 [$wtxt get $pos1.0 $pos1.end] if {$posi eq {}} { set indent2 [obj leadingSpaces $line2] ;# indentation of the insert point } else { set posi [expr {int($posi)}] set linei [string trimright [$wtxt get $posi.0 $posi.end]] set indent2 [obj leadingSpaces $linei] if {$linei eq {}} { foreach i {+0 +1 +2 -1 -2} { set i [expr $posi$i] set ind [obj leadingSpaces [$wtxt get $i.0 $i.end]=] if {$ind} { set indent2 $ind break } } } } lassign [split $posc .] pl pc # If 1st line of the template is underlined, we place it under a previous # unit's closing brace. But if the insertion point is already underlined # or is a branch, we move 1st line of the template to its end. # Or remove it at all, at the end of branch. set line1 [lindex $tlist 0] set under {^\s*#\s?_+$} if {[regexp $under $line1]} { set isund [expr {[regexp $under $line2] || [regexp $al(RE,leaf2) $line2]}] while {[incr pos1 -1]>1} { set line [string trim [$wtxt get $pos1.0 $pos1.end]] if {$line ne {}} { if {[regexp $under $line] || [regexp $al(RE,leaf2) $line]} { set tex [string range $tex [string first \n $tex] end] set len1 [llength $tlist] set len2 [llength [split [string trimleft $tex] \n]] set tex \n[string trim $tex]\n if {!$isund} {append tex $line1 \n} incr pl [expr {$len2-$len1+1}] ;# cursor position changed too set posc $pl.$pc } elseif {$line ne "\}"} { if {$isund} {append tex \n} break } set pos0 [$wtxt index "$pos1.0 + 1 line"] break } } } Source_unit_tpl # indent the template & increment the cursor position if {![regexp $REtodel $tex] && $indent1<$indent2} { incr indent2 -$indent1 set indent [string repeat { } $indent2] lassign [split $posc .] pl pc set posc $pl.[incr pc $indent2] foreach t [split $tex \n] { if {[incr _cnt]==1} {set tex {}} {append tex \n} if {$t ne {}} {set t $indent$t} append tex $t } } list $tex $pos0 $posc }
Creates type template files, if they don't exist.
proc ::alited::unit::CreateTypeTemplateFiles {} { # Creates type template files, if they don't exist. namespace upvar ::alited DATADIR DATADIR USERDIR USERDIR set aledir [file join $DATADIR typetpl] set tpldir [file join $USERDIR typetpl] if {![file exists $tpldir]} { if {[catch {file copy $aledir $tpldir} err]} { alited::Message $err 4 } } return $tpldir }
Deletes a unit from a text.
| unit tree's path |
| file name |
| relative Y-coordinate for a query |
proc ::alited::unit::Delete {wtree fname sy} { # Deletes a unit from a text. # wtree - unit tree's path # fname - file name # sy - relative Y-coordinate for a query namespace upvar ::alited al al set wtxt [alited::main::CurrentWTXT] set selection [$wtree selection] set wasdel no if {[set llen [llength $selection]]>1} { set dlg yesnocancel set dlgopts [list -ch $al(MC,noask)] } else { set dlg yesno set dlgopts [alited::tree::syOption $sy] } set ans 1 for {set i $llen} {$i} {} { # delete units from the text's bottom (text selection is sorted by items) incr i -1 set ID [lindex $selection $i] set name [$wtree item $ID -text] set msg [string map [list %n $name %f [file tail $fname]] $al(MC,delitem)] if {$ans<11} { set ans [alited::msg $dlg ques $msg YES {*}$dlgopts] } switch $ans { 0 - 12 break 1 - 11 { lassign [$wtree item $ID -values] l1 l2 set ind2 [$wtxt index "$l2.end +1 char"] $wtxt delete $l1.0 $ind2 set wasdel yes } } } }
Moves unit(s) from one location in the unit tree to other.
| unit tree's path |
| IDs of tree item "to move from" |
| ID of tree item "to move to" |
proc ::alited::unit::DropUnits {wtree fromIDs toID} { # Moves unit(s) from one location in the unit tree to other. # wtree - unit tree's path # fromIDs - IDs of tree item "to move from" # toID - ID of tree item "to move to" namespace upvar ::alited obPav obPav set tree [alited::tree::GetTree] set wtxt [alited::main::CurrentWTXT] set wtree [$obPav Tree] undoIn $wtxt # firstly, cut all moved lines set ijust 0 set movedlines [list] # we must cut from below, so sort units reversely: set fromIDs [lsort -decreasing -dictionary $fromIDs] set headers [list] foreach fromID $fromIDs { if {$fromID eq $toID} continue # simply for each unit: find its moved lines and a destination line set i1 [set i2 [set io 0]] foreach item $tree { lassign $item lev cnt id title values lassign $values l1 l2 prl id lev leaf fl1 if {$id eq $fromID} { set i1 $l1 set i2 $l2 } elseif {$id eq $toID} { set io $l1 } } if {$i1 && $i2 && $io} { lappend headers [GetHeader $wtree $fromID] # if the unit is above the destination, the destination should be adjusted if {$i2<$io} {set ijust [expr {$ijust-$i2+$i1-1}]} set ind2 [$wtxt index "$i2.end +1 char"] set lines [$wtxt get $i1.0 $ind2] $wtxt delete $i1.0 $ind2 # the cut lines are saved, to paste them afterwards lappend movedlines $lines } } # secondly, paste all moved lines if {[llength $movedlines]} { incr io $ijust foreach lines $movedlines { $wtxt insert $io.0 $lines } ::tk::TextSetCursor $wtxt $io.0 alited::main::UpdateAll $headers alited::main::FocusText } undoOut $wtxt }
Fills "Type Templates" submenu.
proc ::alited::unit::FillTypeTplMenu {} { # Fills "Type Templates" submenu. namespace upvar ::alited al al set ttdict [ReadTypeTemplate] set m $al(TYPETPLMENU) catch {$m delete 2 end} if {$ttdict ne {}} { $m add separator foreach ttl [lsort [dict keys $ttdict]] { if {[set i [string first ,ttl $ttl]]>0} { set tt [string range $ttl 0 [incr i -1]] set it [dict get $ttdict $ttl] if {[incr idx] % 25} {set cbr {}} {set cbr {-columnbreak 1}} $m add command -label $it -command [list alited::unit::InsertTypeTemplate $tt] {*}$cbr } } } }
Gets a unit's declaration.
| text widget |
| unit's name |
| 1st line of unit |
| last line of unit |
proc ::alited::unit::GetDeclaration {wtxt tip l1 l2} { # Gets a unit's declaration. # wtxt - text widget # tip - unit's name # l1 - 1st line of unit # l2 - last line of unit namespace upvar ::alited al al set unithead $tip if {[IsLeafRegexp] && ![catch {set unittext [$wtxt get $l1.0 $l2.end]}]} { foreach t [split $unittext \n] { if {[regexp $al(RE,proc2) $t]} { set unithead $t break } } } else { catch {set unithead [$wtxt get $l1.0 $l1.end]} } return $unithead }
Gets a header of unit: declaration + initial comments.
| unit tree widget |
| ID of item in the unit tree |
| index of column of the unit tree; optional, default "" |
| text widget; optional, default "" |
| unit's name; optional, default "" |
| 1st line of unit; optional, default 0 |
| last line of unit; optional, default 0 |
proc ::alited::unit::GetHeader {wtree ID {NC {}} {wtxt {}} {tip {}} {l1 0} {l2 0}} { # Gets a header of unit: declaration + initial comments. # wtree - unit tree widget # ID - ID of item in the unit tree # NC - index of column of the unit tree # wtxt - text widget # tip - unit's name # l1 - 1st line of unit # l2 - last line of unit namespace upvar ::alited al al if {$wtree ne {}} { set tip [string trim [$wtree item $ID -text]] lassign [$wtree item $ID -values] l1 l2 - id if {!$al(TREE,isunits)} { return $l2 ;# for file tree, it's a full file name } } if {$NC eq {#1}} { set tip "[string map {al #} $id]\n$l1 - [expr {max($l1,$l2)}]" set ID {} } else { catch { if {$wtxt eq {}} { set wtxt [alited::main::CurrentWTXT] } set tip2 [GetDeclaration $wtxt $tip $l1 $l2] if {[string match "*\{" $tip2] || [string match "test *" $tip2]} { set tip [string trim $tip2 " \{\\"] } if {$NC eq {}} { return $tip ;# returns a declaration only } # find first commented line, after the proc/method declaration set isleafRE [IsLeafRegexp] for {} {$l1<$l2} {} { incr l1 set line [string trim [$wtxt get $l1.0 $l1.end]] if {[string index $line end] ni [list \\ \{] && $line ni {{} # //} && ($isleafRE || ![regexp $al(RE,proc) $line])} { set line1 [string trimleft $line {#!;}] set line2 [string trimleft $line {/}] if {[string match #* $line] && [string trimleft $line1] ne {} && ![regexp $::hl_tcl::my::data(RETODO) $line]} { if {[regexp {^\s+} $line1]} {set line1 [string range $line1 1 end]} append tip \n $line1 break } elseif {[string match //* $line] && [string trimleft $line2] ne {}} { if {[regexp {^\s+} $line2]} {set line2 [string range $line2 1 end]} append tip \n $line2 if {$al(RE,proc) ne {}} break } elseif {$line ne {}} { break } } } } } return $tip }
Gets a template's content.
| template's word |
proc ::alited::unit::GetTypeTemplate {word} { # Gets a template's content. # word - template's word namespace upvar ::alited al al set res {} set ttdict [ReadTypeTemplate] if {[dict exists $ttdict $word]} { foreach line [dict get $ttdict $word] { if {$res ne {}} {append res \n} append res $line } } string map [list ``` {}] $res }
Gets a unit structure from a text.
| tab ID of the text |
| contents of the text |
Returns a list of unit items. An item contains:
proc ::alited::unit::GetUnits {TID textcont} { # Gets a unit structure from a text. # TID - tab ID of the text # textcont - contents of the text # Returns a list of unit items. # An item contains: # - level # - 0 (branch) or 1 (INI,LEAF) # - title # - line1 - first text line for the item # - line2 - last text line for the item # The procedure searhes "branch" units in commented lines, e.g. for: # # ___ level 1 _____ # # ## ___ level 2 _____ ## # ### ___ level 3 _____ ### # using regexp {^\s*(#+) [_]+([^_]+)[_]+ (#+)} $line -> cmn1 title cmn2 # it extracts two comment marks (#, ## or ###) and a title (level 1/2/3). # # To search "leaf" units (containing procs and methods), another `regexp` # is used, e.g. for: # # _____ # # _____ my leaf 1 # regexp {^\s*# [_]+([^_]*)$} $line -> title # extracts a title (my leaf 1). # # If "leaf" title is empty, it's taken from the proc/method name, e.g. for # proc unit::SelectUnit {} {...} # method unit::SelectUnit {} {...} # regexp {^\s*(proc|method)\s+([[:alnum:]_:]+)\s.+} $line -> type title # extracts a type (proc/method) and a title (unit::SelectUnit). # The last non-empty group is taken for the title. namespace upvar ::alited al al set retlist [set item [set title [list]]] set textcont [split $textcont \n] set llen [llength $textcont] lappend textcont "" ;# to save a last unit to the retlist lassign [UnitHeaderMode $TID] isLeafRE isProc leafRE set i [set lev [set leaf [set icomleaf -1]]] foreach line $textcont { incr i set flag1 0 if {[set flag [regexp $al(RE,branch) $line -> cmn1 title]]} { # a branch set leaf [set icomleaf 0] set lev [expr {max(0,[string length $cmn1]-1)}] } elseif { $isProc && [regexp $al(RE,proc) $line -> t1 t2 t3 t4 t5 t6 t7] || $isLeafRE && [regexp $leafRE $line -> t1 t2 t3 t4 t5 t6 t7]} { set title $t1 ;# default title: just after found string foreach t {t7 t6 t5 t4 t3 t2} { if {[set _ [set $t]] ne ""} { set title $_ ;# last non-empty group of others is a real title break } } if {[set cl [string last :: $title]]>-1 && [set cl [string last :: $title $cl]]>-1} { # let only a last namespace be present in the titles set title [string range $title $cl+2 end] } set flag1 $al(INI,LEAF) set flag [set leaf 1] } else { set flag [expr {$i>=$llen}] } if {$flag} { if {[llength $item]} { set l1 [expr {[lindex $item 4]-1}] if {$l1>0 && ![llength $retlist]} { # first found at line>1 => create a starting leaf set treeID [alited::tree::NewItemID [incr iit]] lappend retlist [list $lev 1 $al(INI,LEAF) "" 1 $l1 $treeID] } lassign [lindex $retlist end] levE leafE flE namE l1E - treeIDE lassign $item levC leafC flC namC l1C if {$flE eq "1" && $flC eq "0" && $levE==$levC && $leafE==$leafC} { # found a named previous leaf if {$namE eq ""} {set namE $namC} # update the named leaf set retlist [lreplace $retlist end end [list $levE $leafE $flE $namE $l1E $i $treeIDE]] } else { # add l2 (last line of unit), ID of unit set treeID [alited::tree::NewItemID [incr iit]] lappend retlist [lappend item $i $treeID] } } # prepare an item for saving set item [list [expr {$lev+$leaf}] $leaf $flag1 [string trim $title " #"] [expr {$i+1}]] } } if {![llength $retlist]} { set name [file tail [alited::bar::FileName $TID]] set name [string map [list %f $name] $al(MC,alloffile)] set treeID [alited::tree::NewItemID [incr iit]] lappend retlist [list 1 1 1 $name 1 $llen $treeID] } return $retlist }
Inserts a template into a current text.
| template |
| if yes, means "called from bindings, should return -code break" optional, default yes |
proc ::alited::unit::InsertTemplate {tpldata {dobreak yes}} { # Inserts a template into a current text. # tpldata - template # dobreak - if yes, means "called from bindings, should return -code break" # for noname file - save it beforehand, as templates refer to a file name if {[alited::file::IsNoName [alited::bar::FileName]]} { if {![alited::file::SaveFile]} { if {$dobreak} {return -code break} return } } set wtxt [alited::main::CurrentWTXT] lassign [alited::tree::CurrentItemByLine "" 1] itemID - - - - l1 l2 lassign [TemplateData $wtxt $l1 $l2 $tpldata] tex posc place lassign [split $posc .] -> col0 switch $place { 0 { ;# returned by TemplateData: after a declaration set pos0 [expr {$l1+1}].0 } 4 { ;# after 1st line set pos0 1.0 } 3 { ;# after cursor set pos0 [$wtxt index insert] } 2 { ;# after unit if {$l2 ne ""} { set pos0 [$wtxt index "$l2.0 +1 line linestart"] if {[string index $tex end] ne "\n"} {append tex \n} lassign [CorrectPos $wtxt $tex $posc $pos0 {}] tex pos0 posc lassign [split $posc .] -> col0 } else { set place 1 } } default { ;# after line set place 1 } } if {$place == 1} { set pos0 [$wtxt index "insert +1 line linestart"] set posi [$wtxt index "insert linestart"] lassign [CorrectPos $wtxt $tex $posc $pos0 $posi] tex pos0 posc lassign [split $posc .] -> col0 if {[string index $tex end] ne "\n"} {append tex \n} } set posc "[expr {int($posc)-1}].$col0" set posc [::apave::p+ $pos0 $posc] $wtxt insert $pos0 $tex ::tk::TextSetCursor $wtxt $posc alited::main::UpdateAll after idle alited::main::FocusText if {$dobreak} {return -code break} }
Inserts a type template at the cursor.
| template's word |
proc ::alited::unit::InsertTypeTemplate {word} { # Inserts a type template at the cursor. # word - template's word if {[set tpl [GetTypeTemplate $word]] ne {}} { set wtxt [alited::main::CurrentWTXT] set idxl [$wtxt index insert] undoIn $wtxt $wtxt insert $idxl $tpl AfterInsertingTypeTemplate $wtxt $idxl $tpl } }
Checks for using "leaf's regexp" setting.
proc ::alited::unit::IsLeafRegexp {} { # Checks for using "leaf's regexp" setting. namespace upvar ::alited al al set al(prjuseleafRE) [string is true -strict $al(prjuseleafRE)] if {$al(prjuseleafRE) && $al(prjleafRE) ne {}} { set res 1 } else { set res [expr {$al(RE,leaf) ne {} && $al(INI,LEAF)}] } return $res }
Gets "leaf's regexp" setting.
proc ::alited::unit::LeafRegexp {} { # Gets "leaf's regexp" setting. namespace upvar ::alited al al if {$al(prjuseleafRE) && $al(prjleafRE) ne {}} { return $al(prjleafRE) } return $al(RE,leaf) }
Moves a text lines to other location.
| text widget's path |
| first line to be moved |
| last line to be moved |
| destination line (to insert the moved lines before) |
| yes, if "edit separator" is required; optional, default yes |
Returns a position of destination line, if the moving was successful.
proc ::alited::unit::MoveL1L2 {wtxt i1 i2 io {dosep yes}} { # Moves a text lines to other location. # wtxt - text widget's path # i1 - first line to be moved # i2 - last line to be moved # io - destination line (to insert the moved lines before) # dosep - yes, if "edit separator" is required # Returns a position of destination line, if the moving was successful. set ind2 [$wtxt index "$i2.end +1 char"] if {($i1<=$io && $io<=$i2) || $io<1 || $i1<1 || $i2<1 || [set linesmoved [$wtxt get $i1.0 $ind2]] eq ""} { return "" ;# nothing to do } if {$dosep} {undoIn $wtxt} $wtxt delete $i1.0 $ind2 if {$io>$i2} { # 3. i1 if moved below, the moved (deleted) lines change 'io', so # 4. i2 'io' is shifted up (by range of moved lines i.e. i1-i2-1) # 5. # 6. io resulting io = io-(i2-i1+1) = io+i1-i2-1 (6+3-4-1=4) set io [expr {$io+$i1-$i2-1}] } if {$io == int([$wtxt index end])} { # "If index refers to the end of the text (the character after the last newline) # then the new text is inserted just before the last newline instead." # (The text manual page) $wtxt insert "end" \n$linesmoved $wtxt delete [$wtxt index "end -1 char"] end } else { $wtxt insert $io.0 $linesmoved } if {$dosep} {undoOut $wtxt} return $io }
Moves a unit up/down the unit tree.
| unit tree's path |
| direction (up/down) |
| header of the moved unit |
| headers of all selected units |
| yes, if run by F11/F12 keys |
| yes, if "edit separator" is required; optional, default yes |
proc ::alited::unit::MoveUnit {wtree to hd headers f1112 {dosep yes}} { # Moves a unit up/down the unit tree. # wtree - unit tree's path # to - direction (up/down) # hd - header of the moved unit # headers - headers of all selected units # f1112 - yes, if run by F11/F12 keys # dosep - yes, if "edit separator" is required namespace upvar ::alited al al set wtxt [alited::main::CurrentWTXT] set tree [alited::tree::GetTree] set itemID [SearchByHeader $hd] set newparent [set oldparent {}] set newlev [set oldlev [set iold -1]] set i1 [set i2 [set io 0]] foreach item $tree { lassign $item lev cnt id title values lassign $values l1 l2 prl id lev leaf fl1 if {$id eq $itemID} { set oldlev $lev set i1 $l1 set i2 $l2 if {$to eq "up"} break } elseif {$to ne "up" && $oldlev>-1} { set io [expr {$l2+1}] break } set io $l1 } if {$io<$al(INI,LINES1)} { set msg [string map [list %n $al(INI,LINES1)] $al(MC,introln2)] if {$f1112} {set geo ""} else {set geo "-geometry pointer+10+10"} alited::msg ok err $msg -title $al(MC,introln1) {*}$geo return no } if {[set pos [MoveL1L2 $wtxt $i1 $i2 $io $dosep]] ne {}} { ::tk::TextSetCursor $wtxt [expr {int($pos)}].0 alited::tree::RecreateTree $wtree $headers } else { return no } return yes }
Moves selected units up/down the unit tree.
| unit tree's path |
| direction (up/down) |
| tree item IDs of selected units |
| yes, if run by F11/F12 keys |
proc ::alited::unit::MoveUnits {wtree to itemIDs f1112} { # Moves selected units up/down the unit tree. # wtree - unit tree's path # to - direction (up/down) # itemIDs - tree item IDs of selected units # f1112 - yes, if run by F11/F12 keys namespace upvar ::alited al al # update the unit tree, to act for sure alited::tree::RecreateTree # check the moved units for the consistency of braces set wtxt [alited::main::CurrentWTXT] foreach ID $itemIDs { lassign [$wtree item $ID -values] l1 l2 - id set cc1 [set cc2 0] foreach line [split [$wtxt get $l1.0 $l2.end] \n] { incr cc1 [::apave::countChar $line \{] incr cc2 [::apave::countChar $line \}] } if {$cc1!=$cc2} { set tip [string trim [$wtree item $ID -text]] set msg [string map [list %n $tip %1 $cc1 %2 $cc2] $al(MC,errmove)] alited::Message $msg 4 return } } if {$to eq {move}} { DropUnits $wtree $itemIDs $f1112 return } set al(RECREATE) 0 set headers [list] foreach ID $itemIDs { set hd [GetHeader $wtree $ID] if {$to eq {up}} { lappend headers $hd } else { set headers [linsert $headers 0 $hd] } } # move items one by one, by their headers undoIn $wtxt foreach hd $headers { if {![MoveUnit $wtree $to $hd $headers $f1112 no]} { break } } undoOut $wtxt set com "set ::alited::al(RECREATE) 1; alited::tree::RecreateTree" if {[set sel [$wtree selection]] ne {}} { append com "; $wtree selection set {$sel}" } after idle $com }
Opens type template(s) for editing.
proc ::alited::unit::OpenTypeTemplate {} { # Opens type template(s) for editing. namespace upvar ::alited al al obPav obPav set tpldir [CreateTypeTemplateFiles] set ::alited::al(TMPfname) {} set fnames [$obPav chooser tk_getOpenFile ::alited::al(TMPfname) -initialdir $tpldir -parent $al(WIN) -multiple 1] unset ::alited::al(TMPfname) foreach fn [lreverse [lsort $fnames]] { alited::file::OpenFile $fn yes } }
Inserts a type template depending on a current chars at the cursor.
| text's path |
proc ::alited::unit::PutTypeTemplate {wtxt} { # Inserts a type template depending on a current chars at the cursor. # wtxt - text's path if {[set word [alited::find::GetWordOfText]] ne {}} { set idxr [$wtxt index insert] set idxl "$idxr -[string length $word] c" set wordleft [$wtxt get $idxl $idxr] if {$wordleft eq $word && [set tpl [GetTypeTemplate $word]] ne {}} { undoIn $wtxt $wtxt replace $idxl $idxr $tpl AfterInsertingTypeTemplate $wtxt $idxl $tpl return -code break } } }
Reads all template contents for the current edited file.
proc ::alited::unit::ReadTypeTemplate {} { # Reads all template contents for the current edited file. namespace upvar ::alited al al set type [alited::EditExt] if {![info exists al(_TypeTemplateFile,$type)]} { set al(_TypeTemplateFile,$type) [dict create] set ttsection \[alited: foreach fn [TypeTemplateFiles] { # find the current file type among template files: # template file rootname can be "htm,html,css" if {[regexp "\(^|,\)$type\(,|$\)" [file rootname $fn]]} { set fcont [CheckTypeTemplate $fn] set tt {} foreach line $fcont { set linetr [string trim $line] if {[string first $ttsection $linetr]==0 && [string index $linetr end] eq "\]"} { set tt [string range $linetr [string length $ttsection] end-1] set tt [set ttl [string trim $tt]] if {[set i [string first { } $tt]]>0} { set tt [string range $tt 0 $i] } set tt [string trim $tt] dict set al(_TypeTemplateFile,$type) $tt [list] ;# template's contents dict set al(_TypeTemplateFile,$type) $tt,ttl $ttl ;# template's title } elseif {$tt ne {}} { dict lappend al(_TypeTemplateFile,$type) $tt $line } } break } } } return $al(_TypeTemplateFile,$type) }
Recreates the internal tree of units.
| tab's ID |
| text's path |
proc ::alited::unit::RecreateUnits {TID wtxt} { # Recreates the internal tree of units. # TID - tab's ID # wtxt - text's path namespace upvar ::alited al al set al(_unittree,$TID) [GetUnits $TID [$wtxt get 1.0 {end -1 char}]] }
Runs Templates dialogue.
| Optional arguments. |
proc ::alited::unit::Run_unit_tpl {args} { # Runs Templates dialogue. Source_unit_tpl return [::alited::unit_tpl::_run {*}$args] }
Gets tree item ID of a units by its header (declaration+initial comment).
| Not documented. |
proc ::alited::unit::SearchByHeader {header} { # Gets tree item ID of a units by its header (declaration+initial comment). namespace upvar ::alited obPav obPav set wtree [$obPav Tree] foreach item [alited::tree::GetTree] { set ID [lindex $item 2] set header2 [GetHeader $wtree $ID] if {$header eq $header2} {return $ID} } return {} }
Checks whether a unit is in a branch.
| ID of the unit |
| the branch or its ID; optional, default "" |
If branch is omitted, searches in all of the tree. If branch is set as ID, the branch is fetched from this ID.
Returns the unit's index in the branch or -1 if not found.
proc ::alited::unit::SearchInBranch {unit {branch {}}} { # Checks whether a unit is in a branch. # unit - ID of the unit # branch - the branch or its ID # If *branch* is omitted, searches in all of the tree. # If *branch* is set as ID, the branch is fetched from this ID. # Returns the unit's index in the branch or -1 if not found. if {[llength $branch]<2} { set branch [alited::tree::GetTree $branch] } return [lsearch -exact -index 2 $branch $unit] }
Sources unit_tpl.tcl.
proc ::alited::unit::Source_unit_tpl {} { # Sources unit_tpl.tcl. if {![namespace exists ::alited::unit_tpl]} { namespace eval ::alited { source [file join $SRCDIR unit_tpl.tcl] } } }
Switches between last two active units.
proc ::alited::unit::SwitchUnits {} { # Switches between last two active units. namespace upvar ::alited al al if {[llength $al(FAV,visited)]<2} return lassign [lindex $al(FAV,visited) 1 4] name fname header if {[set TID [alited::favor::OpenSelectedFile $fname]] eq {}} return alited::favor::GoToUnit $TID $name $header }
Replaces the template wildcards with data of current text and unit.
| text's path |
| 1st line of current unit |
| last line of current unit |
| template |
proc ::alited::unit::TemplateData {wtxt l1 l2 tpldata} { # Replaces the template wildcards with data of current text and unit. # wtxt - text's path # l1 - 1st line of current unit # l2 - last line of current unit # tpldata - template namespace upvar ::alited al al DIR DIR MNUDIR MNUDIR lassign $tpldata tex pos place set sec [clock seconds] set fname [alited::bar::FileName] set tex [TemplateMap $tex] # get a list of proc/method's arguments: # from "proc pr {ar1 ar2 ar3} " and a template " # %a -\n" # to get # # ar1 - # # ar2 - # # ar3 - set unithead [GetDeclaration $wtxt {} $l1 $l2] set unithead [string trim $unithead "\{ "] lassign [split $unithead "\{"] proc set iarg [string range $unithead [string length $proc] end] catch { set ipad [obj leadingSpaces [$wtxt get $l1.0 $l1.end]] if {![IsLeafRegexp]} { incr ipad [obj leadingSpaces $tex] } set pad [string repeat " " $ipad] set tpla $pad[string map [list \\n \n] $al(TPL,%a)] set oarg [set st1 ""] if {[string match \{*\} $iarg]} {set iarg [string range $iarg 1 end-1]} foreach a [list {*}$iarg] { lassign $a a set a [string trim $a "\{\} "] if {$a ne {}} { set st [string map [list %a $a] $tpla] if {$st1 eq ""} {set st1 $st} append oarg $st } } if {[string first %a $tex]>-1} { set tex $pad[string trimleft $tex] set place 0 set pos 1.[string length $st1] } set tex [string map [list \\n \n %a $oarg] $tex] } set ll1 [string length $tex] set tex [string map [list %p [lindex $proc 1]] $tex] set ll2 [string length $tex] if {[set ll [expr {$ll2-$ll1}]]} { lassign [split $pos .] r c if {[string is digit -strict $c]} { set pos $r.[expr {$c+$ll}] } } list $tex $pos $place }
Maps a string using template wildcards.
| string to map |
proc ::alited::unit::TemplateMap {str} { # Maps a string using template wildcards. # str - string to map namespace upvar ::alited al al DIR DIR set sec [clock seconds] set fname [alited::bar::FileName] return [alited::Map {} $str %d [alited::tool::FormatDate $sec] %t [clock format $sec -format $al(TPL,%t) -locale $::alited::al(LOCAL)] %u $al(TPL,%u) %U $al(TPL,%U) %m $al(TPL,%m) %w $al(TPL,%w) %F $fname %f [file tail $fname] %n [file rootname [file tail $fname]] %A $DIR %M $al(EM,mnudir) ] }
Lists files of type template directory.
proc ::alited::unit::TypeTemplateFiles {} { # Lists files of type template directory. namespace upvar ::alited al al if {![info exists al(_TypeTemplateDir)]} { set tpldir [CreateTypeTemplateFiles] set al(_TypeTemplateDir) [list] foreach fn [glob -nocomplain [file join $tpldir *]] { lappend al(_TypeTemplateDir) $fn } } return $al(_TypeTemplateDir) }
Gets modes for unit tree : do use RE for leaf headers and do not.
| tab's ID |
Returns 2 flags: "Use leaf's RE" and "Use proc/method declaration".
proc ::alited::unit::UnitHeaderMode {TID} { # Gets modes for unit tree : do use RE for leaf headers and do not. # TID - tab's ID # Returns 2 flags: "Use leaf's RE" and "Use proc/method declaration". set isLeafRE [IsLeafRegexp] set isProc [expr {!$isLeafRE && ($TID eq {TMP} || [alited::file::IsTcl [alited::bar::FileName $TID]])}] set leafRE [LeafRegexp] list $isLeafRE $isProc $leafRE }
Gets RE to check unit's beginning.
proc ::alited::unit::UnitRegexp {} { # Gets RE to check unit's beginning. namespace upvar ::alited al al if {[IsLeafRegexp]} { return [LeafRegexp] } return $al(RE,proc2) }
Creates "Templates" dialogue.
| "-geometry" option for showModal; optional, default "" |
proc ::alited::unit_tpl::_create {{geom {}}} { # Creates "Templates" dialogue. # geom - "-geometry" option for showModal namespace upvar ::alited al al tplgeometry tplgeometry variable obTpl variable win variable tpllist variable tplkey variable dosel set tipson [baltip::cget -on] baltip::configure -on $al(TIPS,Templates) if {$dosel} { set forget {} set ::alited::unit_tpl::BUTEXIT Cancel } else { set forget forget set ::alited::unit_tpl::BUTEXIT Close } ::apave::APave create $obTpl $win $obTpl makeWindow $win $al(MC,tpl) $obTpl paveWindow $win { {fraTreeTpl - - 10 10 {-st nswe -rw 3 -pady 8} {}} {.fra - - - - {pack -side right -fill both} {}} {.fra.btTAd - - - - {pack $forget -side top -anchor n} {-com ::alited::unit_tpl::Add -tip "Add a template" -image alimg_add-big}} {.fra.btTChg - - - - {pack $forget -side top} {-com ::alited::unit_tpl::Change -tip "Change a template" -image alimg_change-big}} {.fra.btTDel - - - - {pack $forget -side top} {-com ::alited::unit_tpl::Delete -tip "Delete a template" -image alimg_delete-big}} {.fra.v_ - - - - {pack -side top -expand 1 -fill x -pady 2} {}} {.fra.btTImp - - - - {pack $forget -side top} {-com ::alited::unit_tpl::Import -tip "Import templates\nfrom external alited.ini" -image alimg_plus-big}} {.TreeTpl - - - - {pack -side left -expand 1 -fill both} {-h 12 -show headings -columns {C1 C2} -displaycolumns {C1 C2} -columnoptions "C2 {-stretch 0}"}} {.sbvTpls + L - - {pack -side left -fill both}} {fra1 fraTreeTpl T 10 10 {-st nsew}} {.h_ - - 1 1 {-st we} {-h 20}} {.labTpl .h_ T 1 1 {-st e} {-anchor center -t "Current template:"}} {.EntTpl .labTpl L 1 8 {-st we} {-tvar ::alited::unit_tpl::tpl -w 45 -tip {-BALTIP {$al(MC,tplent1)} -MAXEXP 1}}} {.CbxKey + L 1 1 {-st w} {-tvar ::alited::unit_tpl::tplkey -postcommand ::alited::unit_tpl::GetKeyList -state readonly -h 16 -w 16 -tip {-BALTIP {$al(MC,tplent3)} -MAXEXP 1}}} {fratex fra1 T 10 10 {-st nsew -rw 1 -cw 1} {}} {.TexTpl - - - - {pack -side left -expand 1 -fill both} {-h 10 -w 80 -tip {-BALTIP {$al(MC,tplent2)} -MAXEXP 1}}} {.sbvTpl + L - - pack {}} {fra2 fratex T 1 10 {-st nsew} {-padding {5 5 5 5} -relief groove}} {.labBA - - - - {pack -side left} {-t "Place after:"}} {.radA - - - - {pack -side left -padx 8} {-t "line" -var ::alited::unit_tpl::place -value 1 -tip {-BALTIP {$al(MC,tplaft1)} -UNDER 4}}} {.radB - - - - {pack -side left -padx 8} {-t "unit" -var ::alited::unit_tpl::place -value 2 -tip {-BALTIP {$al(MC,tplaft2)} -UNDER 4}}} {.radC - - - - {pack -side left -padx 8} {-t "cursor" -var ::alited::unit_tpl::place -value 3 -tip {-BALTIP {$al(MC,tplaft3)} -UNDER 4}}} {.radD - - - - {pack -side left -padx 8} {-t "file's beginning" -var ::alited::unit_tpl::place -value 4 -tip {-BALTIP {$al(MC,tplaft4)} -UNDER 4}}} {LabMess fra2 T 1 10 {-st nsew -pady 0 -padx 3} {-style TLabelFS}} {fra3 + T 1 10 {-st nsew}} {.ButHelp - - - - {pack -side left} {-t {$al(MC,help)} -tip F1 -command ::alited::unit_tpl::Help}} {.h_ - - - - {pack -side left -expand 1 -fill both}} {.butOK - - - - {pack $forget -side left -padx 2} {-t "$al(MC,select)" -command ::alited::unit_tpl::Ok}} {.butCancel - - - - {pack -side left} {-t $::alited::unit_tpl::BUTEXIT -command ::alited::unit_tpl::Cancel}} } set tree [$obTpl TreeTpl] $tree heading C1 -text [msgcat::mc Template] $tree heading C2 -text [msgcat::mc {Hot keys}] UpdateTree no Select set wtxt [$obTpl TexTpl] SyntaxText $wtxt bind $tree <<TreeviewSelect>> ::alited::unit_tpl::Select bind $tree <Delete> ::alited::unit_tpl::Delete bind $tree <Double-Button-1> ::alited::unit_tpl::Ok bind $tree <Return> ::alited::unit_tpl::Ok bind $wtxt <FocusIn> "::alited::unit_tpl::InText $wtxt" bind [$obTpl CbxKey] <FocusOut> ::alited::unit_tpl::ClearCbx bind $win <F1> "[$obTpl ButHelp] invoke" bind [$obTpl LabMess] <Button-1> alited::unit_tpl::ProcMessage if {[llength $tpllist]} {set foc $tree} {set foc [$obTpl EntTpl]} if {[set il $::alited::unit::ilast] > -1} { Select $il after idle "alited::unit_tpl::Select $il" ;# just to highlight } after 500 ::alited::unit_tpl::HelpMe ;# show an introduction after a short pause set geo {-resizable 1 -minsize {640 480}} if {$geom ne {}} { set geo $geom } elseif {$tplgeometry ne {}} { append geo " -geometry $tplgeometry" } set res [$obTpl showModal $win -onclose ::alited::unit_tpl::Cancel -focus $foc {*}$geo] if {$geom eq {}} { set tplgeometry [wm geometry $win] } baltip::configure {*}$tipson catch {destroy $win} $obTpl destroy if {[llength $res] < 2} {set res {}} return $res }
Runs "Templates" dialogue.
| if yes, enables "Select" action; optional, default yes |
| "-geometry" option for showModal; optional, default "" |
proc ::alited::unit_tpl::_run {{doselect yes} {geom {}}} { # Runs "Templates" dialogue. # doselect - if yes, enables "Select" action # geom - "-geometry" option for showModal variable win variable dosel if {[winfo exists $win]} {return {}} set dosel $doselect set wtxt [alited::main::CurrentWTXT] alited::keys::UnBindKeys $wtxt template ReadIni set res [_create $geom] destroy $win alited::keys::BindKeys $wtxt template return $res }
Handles "Add template" button.
| cursor position in template text; optional, default "" |
Returns 1, if the template was added, else returns 0.
proc ::alited::unit_tpl::Add {{inpos {}}} { # Handles "Add template" button. # inpos - cursor position in template text # Returns 1, if the template was added, else returns 0. namespace upvar ::alited al al variable obTpl variable tpllist variable tpl variable tplcont variable tplpos variable tplpla variable place variable tplkeys variable tplkey variable tplid set tpl [string trim $tpl] set txt [Text] set tree [$obTpl TreeTpl] if {$tplkey ne {}} { set isel2 [lsearch -exact $tplkeys $tplkey] } else { set isel2 -1 } if {$tpl ne {} && $txt ne {} && ( [set isel1 [lsearch -exact $tpllist $tpl]]>-1 || $isel2>-1 || [set isel3 [lsearch -exact $tplcont $txt]]>-1 )} { if {$isel1>-1} { focus [$obTpl EntTpl] } elseif {$isel2>-1} { focus [$obTpl CbxKey] } else { set wtxt [$obTpl TexTpl] focus $wtxt set pos [lindex $tplpos $isel3] ::tk::TextSetCursor $wtxt $pos } Message $al(MC,tplexists) 4 return 0 } elseif {$tpl eq {}} { focus [$obTpl EntTpl] Message $al(MC,tplent1) 4 return 0 } elseif {[string trim $txt] eq {}} { focus [$obTpl TexTpl] Message $al(MC,tplent2) 4 return 0 } if {$inpos eq {}} {set inpos [Pos]} lappend tpllist $tpl lappend tplcont $txt lappend tplpos $inpos lappend tplpla $place set msg [string map [list %n [llength $tpllist]] $al(MC,tplnew)] set item [$tree insert {} end -values [list $tpl $tplkey]] lappend tplkeys $tplkey UpdateTree set item [lindex [$tree children {}] end] lappend tplid $item set isel [expr {[llength $tplid]-1}] after idle "::alited::unit_tpl::Select $isel" Message $msg 3 return 1 }
Handles "Cancel" button.
| Optional arguments. |
proc ::alited::unit_tpl::Cancel {args} { # Handles "Cancel" button. variable obTpl variable win alited::CloseDlg SaveIni $obTpl res $win 0 }
Handles "Change template" button.
proc ::alited::unit_tpl::Change {} { # Handles "Change template" button. variable tpllist variable tplcont variable tplpos variable tplpla variable place variable tplkeys variable tplkey variable tpl if {[set isel [Selected index]] eq {}} return set tpllist [lreplace $tpllist $isel $isel $tpl] set tplcont [lreplace $tplcont $isel $isel [Text]] set tplpos [lreplace $tplpos $isel $isel [Pos [lindex $tplpos $isel]]] set tplpla [lreplace $tplpla $isel $isel $place] set tplkeys [lreplace $tplkeys $isel $isel $tplkey] UpdateTree after idle "::alited::unit_tpl::Select $isel" set msg [string map [list %n [incr isel]] $::alited::al(MC,tplupd)] Message $msg 3 }
Helper to clear the combobox's selection.
proc ::alited::unit_tpl::ClearCbx {} { # Helper to clear the combobox's selection. variable obTpl [$obTpl CbxKey] selection clear }
Handles "Delete template" button.
proc ::alited::unit_tpl::Delete {} { # Handles "Delete template" button. namespace upvar ::alited al al variable tpllist variable tplcont variable tplpos variable tplpla variable tplkeys variable tplid variable win variable dosel if {!$dosel || [set isel [Selected index]] eq {}} return set nsel [expr {$isel+1}] set msg [string map [list %n $nsel] $al(MC,tpldelq)] if {![alited::msg yesno warn $msg NO -centerme $win]} { return } foreach tl {tpllist tplcont tplpos tplpla tplid tplkeys} { set $tl [lreplace [set $tl] $isel $isel] } set llen [expr {[llength $tpllist]-1}] if {$isel>$llen} {set isel $llen} UpdateTree if {$llen>=0} {after idle "alited::unit_tpl::Select $isel"} set msg [string map [list %n $nsel] $al(MC,tplrem)] Message $msg 3 }
Sets the focus on the template list's item.
| index of item |
proc ::alited::unit_tpl::Focus {isel} { # Sets the focus on the template list's item. # isel - index of item variable obTpl set tree [$obTpl TreeTpl] $tree selection set $isel $tree see $isel $tree focus $isel }
Creates a key list for "Keys" combobox.
proc ::alited::unit_tpl::GetKeyList {} { # Creates a key list for "Keys" combobox. variable obTpl RegisterKeys set keys [linsert [alited::keys::VacantList] 0 ""] [$obTpl CbxKey] configure -values $keys }
Handles "Help" button.
| Optional arguments. |
proc ::alited::unit_tpl::Help {args} { # Handles "Help" button. variable win alited::Help $win }
'Help' for start.
| Optional arguments. |
proc ::alited::unit_tpl::HelpMe {args} { # 'Help' for start. variable win alited::HelpMe $win }
Handles "Import templates" button.
proc ::alited::unit_tpl::Import {} { # Handles "Import templates" button. namespace upvar ::alited al al DATAUSERINI DATAUSERINI variable obTpl variable tpl variable tplkey variable place variable win set al(TMPfname) alited.ini set fname [$obTpl chooser tk_getOpenFile ::alited::al(TMPfname) -initialdir $DATAUSERINI -parent $win] unset al(TMPfname) if {$fname eq {}} return set imported 0 set wtxt [$obTpl TexTpl] foreach line [textsplit [readTextFile $fname]] { if {[string match tpl=* $line]} { set line [string range $line 4 end] if {![catch {lassign $line tpl tplkey cont pos place}]} { set cont [::alited::ProcEOL $cont in] if {$tpl ne {} && $cont ne {} && $pos ne {}} { if {![string is double -strict $pos]} {set pos 1.0} $wtxt delete 1.0 end $wtxt insert end $cont incr imported [Add $pos] } } } } set msg [string map "%n $imported" [msgcat::mc "Number of imported templates: %n"]] Message $msg 3 }
Goes into the template's text and sets the cursor on it.
| text's path |
proc ::alited::unit_tpl::InText {wtxt} { # Goes into the template's text and sets the cursor on it. # wtxt - text's path variable tplpos if {[set isel [Selected index no]] ne {}} { set pos [lindex $tplpos $isel] after idle " ::hl_tcl::iscurline $wtxt yes ; ::tk::TextSetCursor $wtxt $pos ; event generate $wtxt <Enter> ;# to force highlighting " } }
Displays a message in statusbar of templates dialogue.
| message |
| mode of Message; optional, default 2 |
proc ::alited::unit_tpl::Message {msg {mode 2}} { # Displays a message in statusbar of templates dialogue. # msg - message # mode - mode of Message variable obTpl alited::Message $msg $mode [$obTpl LabMess] }
Handles "OK" button.
| Optional arguments. |
proc ::alited::unit_tpl::Ok {args} { # Handles "OK" button. variable obTpl variable win variable tplpos variable tplcont variable tplpla variable dosel alited::CloseDlg if {!$dosel || [set isel [Selected index]] eq {}} { focus [$obTpl TreeTpl] return } set tex [lindex $tplcont $isel] set pos [lindex $tplpos $isel] set pla [lindex $tplpla $isel] SaveIni $obTpl res $win [list $tex $pos $pla] }
Returns a cursor position in the template's text.
| if not "", it's a position to be returned by default; optional, default "" |
Returns a cursor position in the template's text.
proc ::alited::unit_tpl::Pos {{pos {}}} { # Returns a cursor position in the template's text. # pos - if not "", it's a position to be returned by default variable obTpl set wtxt [$obTpl TexTpl] if {$wtxt eq [focus] || $pos eq {}} { return [$wtxt index insert] } return $pos }
Handles clicking on message label.
proc ::alited::unit_tpl::ProcMessage {} { # Handles clicking on message label. variable obTpl set msg [baltip cget [$obTpl LabMess] -text] Message $msg 3 }
Gets templates' data from al(TPL,list) saved in alited.ini.
proc ::alited::unit_tpl::ReadIni {} { # Gets templates' data from al(TPL,list) saved in alited.ini. namespace upvar ::alited al al foreach tv {tpllist tplcont tplkeys tplpos tplpla} { variable $tv set $tv [list] } foreach lst $al(TPL,list) { if {![catch {lassign $lst tpl key cont pos pla}]} { set cont [::alited::ProcEOL $cont in] if {$tpl ne {} && $cont ne {} && $pos ne {}} { if {![string is double -strict $pos]} {set pos 1.0} lappend tpllist $tpl lappend tplcont $cont lappend tplkeys $key lappend tplpos $pos lappend tplpla $pla } } } }
Registers key bindings of templates, to save them to alited.ini afterwards.
proc ::alited::unit_tpl::RegisterKeys {} { # Registers key bindings of templates, to save them to alited.ini afterwards. namespace upvar ::alited al al variable tpllist variable tplcont variable tplkeys variable tplpos variable tplpla alited::keys::Delete template set al(TPL,list) [list] foreach tpl $tpllist key $tplkeys cont $tplcont pos $tplpos pla $tplpla { set cont [::alited::ProcEOL $cont out] lappend al(TPL,list) [list $tpl $key $cont $pos $pla] alited::keys::Add template $tpl $key [list $cont $pos $pla] } }
Puts templates' data to al(TPL,list) to save in alited.ini.
proc ::alited::unit_tpl::SaveIni {} { # Puts templates' data to al(TPL,list) to save in alited.ini. set ::alited::unit::ilast [Selected index no] RegisterKeys alited::ini::SaveIni }
Selects an item of the template list.
| index (ID) of template list; optional, default "" |
proc ::alited::unit_tpl::Select {{item {}}} { # Selects an item of the template list. # item - index (ID) of template list variable obTpl variable tpllist variable tplkey variable tplkeys variable tplcont variable tplid variable tplpla variable tpl variable place if {$item eq {}} {set item [Selected item no]} if {$item ne {}} { if {[string is digit $item]} { ;# the item is an index set item [lindex $tplid $item] } catch { set tree [$obTpl TreeTpl] set isel [$tree index $item] set tpl [lindex $tpllist $isel] set tplkey [lindex $tplkeys $isel] set place [lindex $tplpla $isel] set cont [lindex $tplcont $isel] set wtxt [$obTpl TexTpl] ::hl_tcl::iscurline $wtxt no $wtxt delete 1.0 end $wtxt insert end $cont InText $wtxt if {[$tree selection] ne $item} { $tree selection set $item } focus $tree $tree see $item $tree focus $item } } }
Gets ID or index of currently selected item of the template list.
| if "index", gets a current item's index |
| if yes, shows a message about the selection; optional, default yes |
proc ::alited::unit_tpl::Selected {what {domsg yes}} { # Gets ID or index of currently selected item of the template list. # what - if "index", gets a current item's index # domsg - if yes, shows a message about the selection variable obTpl variable tpllist set tree [$obTpl TreeTpl] if {[set isel [$tree selection]] eq {} && [set isel [$tree focus]] eq {} && $domsg} { Message $::alited::al(MC,tplsel) 4 } if {$isel ne {} && $what eq {index}} { set isel [$tree index $isel] } return $isel }
Prepares syntax highlighting of template's text
| the text's path |
proc ::alited::unit_tpl::SyntaxText {wtxt} { # Prepares syntax highlighting of template's text # wtxt - the text's path alited::SyntaxHighlight tcl $wtxt [alited::SyntaxColors] }
Returns the contents of the template's text.
Returns the contents of the template's text.
proc ::alited::unit_tpl::Text {} { # Returns the contents of the template's text. variable obTpl return [[$obTpl TexTpl] get 1.0 {end -1 char}] }
Updates the template list.
| save templates in ini-file; optional, default yes |
proc ::alited::unit_tpl::UpdateTree {{saveini yes}} { # Updates the template list. # saveini - save templates in ini-file variable obTpl variable tpllist variable tplkeys variable tplid set tree [$obTpl TreeTpl] $tree delete [$tree children {}] set tplid [list] set item0 {} foreach tpl $tpllist tplkey $tplkeys { set item [$tree insert {} end -values [list $tpl $tplkey]] if {$item0 eq {}} {set item0 $item} lappend tplid $item } if {$item0 ne {} && $::alited::unit::ilast<0} {Focus $item0} ClearCbx if {$saveini} SaveIni }