summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/latex/tcldoc/dtxload.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/source/latex/tcldoc/dtxload.tcl')
-rw-r--r--Master/texmf-dist/source/latex/tcldoc/dtxload.tcl361
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'.