## (auto-install) ## ## This is file `dtxload.tcl', ## generated with the docstrip utility. ## ## The original source files were: ## ## dtxload.dtx (with options: `tcl') ## ## This file may be distributed and/or modified under the conditions ## of the LaTeX Project Public License, either version 1.2 of this ## license or (at your option) any later version. The latest version ## of this license is in ## http://www.latex-project.org/lppl.txt ## and version 1.2 or later is part of all distributions of LaTeX ## version 1999/12/01 or later. ## ## This file may only be distributed together with a copy of the source ## file from which it was generated. You may distribute that source file ## without this generated file. ## alpha::feature dtxload 1.1 {TeX} { # When set, the Load Tcl Code command will be disabled in # TeX files whose suffix is not dtx. newPref flag onlyLoadDtxFiles 1 TeX # When set, the Load Tcl Code command will only extract code # from code lines in tcl and tcl* environments. newPref flag onlyLoadTclEnvs 1 TeX # This is the key binding for dtxload's Load Tcl Code command. newPref binding loadTclCode modules be included?"]"}] } set dtxload::known_expressions($e) } proc dtxload::push_module {e p} { global dtxload::module_stack lappend dtxload::module_stack [list $e $p] } proc dtxload::pop_module {e p} { global dtxload::module_stack dtxload::module_included\ dtxload::next_module_idx set len [llength ${dtxload::module_stack}] if {$len==0} then {return} set L [lindex ${dtxload::module_stack} [expr {$len-1}]] if {[lindex $L 0] != $e} then { switch [buttonAlert "Module nesting error: <*[lindex $L 0]>\ module ended by . For which guards should the positions\ be pushed?" None Start End Both]\ { Start {dtxload::push_bookmarks [lindex $L 1]} End {dtxload::push_bookmarks $p} Both {dtxload::push_bookmarks [lindex $L 1] $p} } } set dtxload::module_stack\ [lreplace ${dtxload::module_stack} end end] if {$len>=${dtxload::next_module_idx}} then { incr dtxload::next_module_idx -1 } if {[llength $L]>2} then { set dtxload::module_included [lindex $L 2] } } proc dtxload::push_bookmarks {args} { global markStack markName foreach pos $args { set name mark$markName incr markName createTMark $name $pos set fileName [win::Current] set markStack [linsert $markStack 0 [list $fileName $name]] } } proc dtxload::update_included {} { global dtxload::module_included dtxload::module_stack\ dtxload::next_module_idx while {${dtxload::module_included} &&\ ${dtxload::next_module_idx}<[llength ${dtxload::module_stack}]}\ { set L [lindex ${dtxload::module_stack} ${dtxload::next_module_idx}] lappend L ${dtxload::module_included} set dtxload::module_stack [lreplace ${dtxload::module_stack}\ ${dtxload::next_module_idx} ${dtxload::next_module_idx} $L] incr dtxload::next_module_idx set dtxload::module_included [dtxload::eval_guard [lindex $L 0]] } } proc dtxload::extract_line {startpos endpos} { global dtxload::in_tcl_env onlyLoadTclEnvs dtxload::module_included for {set pos $startpos} {[pos::compare {$pos<$endpos}]}\ {set pos $pos2} { set pos2 [nextLineStart $pos] if {$pos2>$endpos} then {set pos2 $endpos} set line [getText $pos $pos2] switch -regexp -- $line { {^%<<} { if {!$onlyLoadTclEnvs || ${dtxload::in_tcl_env}} then { dtxload::update_included if {${dtxload::module_included}} then { alertnote "docstrip verbatim mode guard line\ encountered. Verbatim mode extraction is\ currently not supported, so I stop here." goto $pos return [list $endpos] } } set endtag %[string trimright [string trimright\ [string range $line 3 end] \n\r] \ ] while {[string trimright [string trimright $line \n\r] \ ]\ != $endtag} { set pos $pos2 if {[pos::compare {$pos>=$endpos}]}\ then {return [list $pos]} set pos2 [nextLineStart $pos] if {$pos2>$endpos} then {set pos2 $endpos} set line [getText $pos $pos2] } } {^%<[*/]} { if {![regexp {^%<(\*|/)([^>]+)>} $line foo modifier\ expression]}\ then { if {"[askyesno "Malformed guard line \"$line\"\ encountered. Push position?"]"=="yes"}\ then {dtxload::push_bookmarks $pos} } elseif {$modifier=="*"} then { dtxload::push_module $expression $pos } else { dtxload::pop_module $expression $pos } } {^%<} { if {![regexp {^%<(-|\+|)([^>]+)>(.*)$} $line\ foo modifier expression code]}\ then { if {"[askyesno "Malformed guard line \"$line\"\ encountered. Push position?"]"=="yes"}\ then {dtxload::push_bookmarks $pos} } elseif {!$onlyLoadTclEnvs || ${dtxload::in_tcl_env}} then { dtxload::update_included if {${dtxload::module_included}} then { if {[dtxload::eval_guard $expression] !=\ ($modifier=="-")}\ then {return [list $pos2 $code $pos]} } } } {^%} { while {[regexp -indices {\\(begin|end) *{tcl\*?}} $line\ match type]} { set dtxload::in_tcl_env\ [expr {"[eval string range \$line $type]"=="begin"}] set line [string range $line\ [expr {[lindex $match 1]+1}] end] } } default { if {!$onlyLoadTclEnvs || ${dtxload::in_tcl_env}} then { dtxload::update_included if {${dtxload::module_included}}\ then {return [list $pos2 $line $pos]} } } } } list $endpos } proc dtxload::evaluate {t} { global errorInfo errorCode evaluateRemotely tcl_platform if {!$evaluateRemotely} then { if {[set code [catch {uplevel \#0 $t} msg]] == 1} then { set L [split $errorInfo \n] set errorInfo [join [lrange $L 0 [expr {[llength $L] - 4}]] \n] } list $code $msg $errorInfo $errorCode } elseif {$tcl_platform(platform) == "macintosh"} then { global tclshSig app::ensureRunning $tclshSig list [catch { aebuild::result -t 30000 '${tclshSig}' misc dosc ----\ [aebuild::TEXT $t] } res]\ $res } else { global tclshInterp if {![info exists tclshInterp]} { if {[catch {tcltk::findTclshInterp}]} { return [list 1 "No shell selected"] } } if {$tcl_platform(platform) == "windows"} { if {[dde services Tk $tclshInterp] == ""} { alertnote "The remote shell has died, please select a new one." unset tclshInterp return [dtxload::evaluate $t] } list [catch {dde execute Tk $tclshInterp $t} res] $res } else { list [catch {send $tclshInterp $t} res] $res } } } proc dtxload::message_log {script} { set res [dtxload::evaluate $script] if {[lindex $res 0]==1} then { message "Tcl eval error: [lindex $res 1]" expr 1 } else { if {[string length [lindex $res 1]] == 0} then { message "Tcl eval OK." } else { message "Tcl eval OK: [lindex $res 1]" } expr 0 } } if {[info exists dtxload::log_window_name]} then { unset dtxload::log_window_name } proc dtxload::window_log {script} { upvar #0 dtxload::log_window_name win global win::Modes Shel::startPrompt Shel::endPrompt if {[set win::Modes($win)] == "Shel"} then { global Shel::histnum regsub -all \n [string trimright $script] " ; " text history add $text set Shel::histnum [history nextid] } set pos [maxPos -w $win] select -w $win $pos $pos set dtxprompt "${Shel::startPrompt}dtxload${Shel::endPrompt} " if {[set win::Modes($win)] != "Shel"} then { insertText -w $win \r$dtxprompt } else { set stdprompt [Alpha::Prompt] set pos2 [pos::math $pos - [string length $stdprompt]] if {[getText -w $win $pos2 $pos] != $stdprompt} then { insertText -w $win \r$dtxprompt } else { replaceText -w $win $pos2 $pos $dtxprompt refresh } } regsub -all \n [string trimright $script] \r$dtxprompt text insertText -w $win "$text\r" set res [dtxload::evaluate $script] if {[lindex $res 0]==1} then { insertText -w $win "Error: [lindex $res 1]\r" if {[llength $res]>2} then { global errorInfo set errorInfo [lindex $res 2] } message "Tcl eval error" } else { if {[string length [lindex $res 1]]>0}\ then {insertText -w $win "[lindex $res 1]\r"} message "Tcl eval OK" } if {[set win::Modes($win)] == "Shel"}\ then {insertText -w $win [Alpha::Prompt]} expr {[lindex $res 0]==1} } proc dtxload::load {} { global onlyLoadDtxFiles if {$onlyLoadDtxFiles && ![string match *.dtx [win::CurrentTail]]}\ then { message "Not a .dtx file." return } set startpos [getPos] set endpos [selEnd] if {[pos::compare {$startpos == $endpos}]} then { set startpos [minPos] set endpos [maxPos] } global dtxload::log_window_name if { [info exists dtxload::log_window_name] && [lsearch -exact [winNames] ${dtxload::log_window_name}]!=-1 } then {set log dtxload::window_log}\ else {set log dtxload::message_log} global dtxload::in_tcl_env dtxload::module_stack\ dtxload::next_module_idx dtxload::module_included set dtxload::in_tcl_env\ [expr {[getText $startpos [pos::math {$startpos+1}]] != "%"}] set dtxload::module_stack {} set dtxload::next_module_idx 0 set dtxload::module_included 1 set script "" set escaped 0 set spos none while {[pos::compare $startpos < $endpos]} { set extract [dtxload::extract_line $startpos $endpos] if {[llength $extract]>1} then { if {[string length $script]==0} then { set spos [lindex $extract 2] } set line [lindex $extract 1] if {$escaped} then {set line [string trimleft $line]} set escaped [regsub -all\ "((^|\[^\\\\\])(\\\\\\\\)*)\\\\(\r|\n|\r\n)$" $line {\1 } line] if {!$escaped} then {regsub "\r\n?\$" $line \n line} append script $line if {!$escaped && [info complete $script]} then { if {[$log $script]} then { select $spos $endpos markHilite return } else { set script "" } } } elseif {$spos=="none"} then { message "No extractable code found." } set startpos [lindex $extract 0] } if {[string length $script]>0 && [$log $script]} then { select $spos $endpos markHilite } else { global dtxload::known_expressions if {[info exists dtxload::known_expressions]}\ then {unset dtxload::known_expressions} } } proc dtxload::logdest {type {win "dtxload log"}} { global dtxload::log_window_name switch -exact -- $type { status { if {[info exists dtxload::log_window_name]}\ then {unset dtxload::log_window_name} } here {set dtxload::log_window_name [win::CurrentTail]} window { if {[lsearch -exact [winNames] $win] == -1} then { new -n $win -shell 1 -text "This is a dtxload log window.\r" } set dtxload::log_window_name $win } shell { Shel::start "Alpha" $win\ "This is a dtxload log window (and Alpha Tcl shell).\r" set dtxload::log_window_name $win } } } ## ## ## End of file `dtxload.tcl'.