diff options
Diffstat (limited to 'Master/texmf-dist/source/latex/tcldoc/dtxload.tcl')
-rw-r--r-- | Master/texmf-dist/source/latex/tcldoc/dtxload.tcl | 361 |
1 files changed, 0 insertions, 361 deletions
diff --git a/Master/texmf-dist/source/latex/tcldoc/dtxload.tcl b/Master/texmf-dist/source/latex/tcldoc/dtxload.tcl deleted file mode 100644 index af26546a774..00000000000 --- a/Master/texmf-dist/source/latex/tcldoc/dtxload.tcl +++ /dev/null @@ -1,361 +0,0 @@ -## (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 <O/L TeX "" dtxload::load TeX -} "" "" uninstall {this-file} \ - maintainer {"Lars Hellstr\x9am" Lars.Hellstrom@math.umu.se} \ - help {The dtxload package implements a command for loading - Tcl code that is embedded in a .dtx file without docstripping - the file first. For more help, LaTeX the file dtxload.dtx.} -namespace eval dtxload {} -proc dtxload::eval_guard {e} { - global dtxload::known_expressions - if {![info exists dtxload::known_expressions($e)]} then { - set dtxload::known_expressions($e)\ - [expr {"yes" ==\ - "[askyesno "Should <$e> 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 </$e>. 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'. |