mirror of https://gitlab.com/QEF/q-e.git
updating custom tcl utility library (adding lineread rouutine)
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@4882 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
parent
f3d72cf67e
commit
56f77584d7
|
@ -24,6 +24,7 @@ set auto_index(::tclu::absolutePath) [list source [file join $dir tclUtils.tcl]]
|
|||
set auto_index(::tclu::usage) [list source [file join $dir tclUtils.tcl]]
|
||||
set auto_index(::tclu::writeFile) [list source [file join $dir tclUtils.tcl]]
|
||||
set auto_index(::tclu::readFile) [list source [file join $dir tclUtils.tcl]]
|
||||
set auto_index(::tclu::lineread) [list source [file join $dir tclUtils.tcl]]
|
||||
set auto_index(::tclu::DEBUG) [list source [file join $dir tclUtils.tcl]]
|
||||
set auto_index(::tclu::ERROR) [list source [file join $dir tclUtils.tcl]]
|
||||
set auto_index(::tclu::abort) [list source [file join $dir tclUtils.tcl]]
|
||||
|
|
|
@ -19,7 +19,7 @@
|
|||
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
#
|
||||
#
|
||||
# $Id: tclUtils.tcl,v 1.14 2008-05-05 14:45:33 kokalj Exp $
|
||||
# $Id: tclUtils.tcl,v 1.15 2008-05-08 18:30:47 kokalj Exp $
|
||||
#
|
||||
|
||||
#------------------------------------------------------------------------
|
||||
|
@ -63,6 +63,7 @@ namespace eval ::tclu {
|
|||
namespace export usage
|
||||
namespace export writeFile
|
||||
namespace export readFile
|
||||
namespace export lineread
|
||||
namespace export DEBUG
|
||||
namespace export ERROR
|
||||
namespace export errorDialog
|
||||
|
@ -209,6 +210,51 @@ proc ::tclu::readFile {args} {
|
|||
#********
|
||||
|
||||
|
||||
#****f* ::tclu/::tclu::lineread
|
||||
# SYNOPSIS
|
||||
proc ::tclu::lineread {var file script} {
|
||||
# PURPOSE
|
||||
# Read entire file line-by-line and at each line execute a
|
||||
# script at one level up.
|
||||
# ARGUMENTS
|
||||
# * var -- name of variable where the content of line will be stored
|
||||
# * file -- name of file to read
|
||||
# * script -- script to execute when line is read
|
||||
#
|
||||
# CREDITS
|
||||
# Based on fileutils::foreachLine from tcllib (almost verbatim).
|
||||
# SOURCE
|
||||
upvar $var line
|
||||
|
||||
set fid [open $file r]
|
||||
set code 0
|
||||
set result {}
|
||||
|
||||
while { ! [eof $fid] } {
|
||||
gets $fid line
|
||||
set code [catch {uplevel 1 $script} result]
|
||||
if {($code != 0) && ($code != 4)} {
|
||||
break
|
||||
}
|
||||
}
|
||||
close $fid
|
||||
|
||||
if { ($code == 0) || ($code == 3) || ($code == 4) } {
|
||||
return $result
|
||||
}
|
||||
if { $code == 1 } {
|
||||
global errorCode errorInfo
|
||||
return \
|
||||
-code $code \
|
||||
-errorcode $errorCode \
|
||||
-errorinfo $errorInfo \
|
||||
$result
|
||||
}
|
||||
return -code $code $result
|
||||
}
|
||||
#******
|
||||
|
||||
|
||||
#****f* ::tclu/::tclu::DEBUG
|
||||
# SYNOPSIS
|
||||
proc ::tclu::DEBUG {args} {
|
||||
|
|
Loading…
Reference in New Issue