don't show non-string char data as strings; dugfix in cainfo

This commit is contained in:
zimoch
2011-12-20 16:18:26 +00:00
parent f5052be337
commit 27adff91ca

55
ca
View File

@@ -2,12 +2,12 @@
# ca* by Dirk Zimoch
# $Source: /cvs/G/EPICS/App/scripts/ca,v $
# $Date: 2011/07/05 07:38:17 $
# $Date: 2011/12/20 16:18:26 $
regsub -all {\$} {ca* by Dirk Zimoch
$Source: /cvs/G/EPICS/App/scripts/ca,v $
$Revision: 1.18 $
$Date: 2011/07/05 07:38:17 $} {} version
$Revision: 1.19 $
$Date: 2011/12/20 16:18:26 $} {} version
proc printHelp {} {
puts {usage: caget [flags] <channel> [<channel> ...]}
@@ -17,8 +17,7 @@ proc printHelp {} {
puts { cainfo [flags] <channel> [<channel> ...]}
puts { camon [flags] <channel> [<channel> ...]}
puts { cado [flags] <channel> [<channel> ...]}
puts { cawait [flags] <channel> '<condition>' [<channel> '<condition>'...]
}
puts { cawait [flags] <channel> '<condition>' [<channel> '<condition>'...]}
puts {caget reads and formats values from channels (arrays too)}
puts {cagets writes 1 to .PROC and reads after processing has finished}
puts {caput writes, waits until processing finishes and reads back}
@@ -26,8 +25,7 @@ proc printHelp {} {
puts {cainfo reads additional information}
puts {camon starts monitors (terminate with CTRL-C)}
puts {cado writes 1 but does not wait for processing}
puts {cawait waits until any condition ('>4.3', '!3...5', etc) matches
}
puts {cawait waits until any condition ('>4.3', '!3...5', etc) matches}
puts {accepted flags:}
puts {-date add record execution date}
puts {-localdate add host date}
@@ -38,6 +36,7 @@ proc printHelp {} {
puts {-stat always add severity and status}
puts {-nostat never add severity and status}
puts {-hex show integer values as hex}
puts {-num show numeric values instead of strings}
puts {-prec <digits> override the PREC field}
puts {-plain don't do any formatting}
puts {-timeout <sec> timeout cawait after <sec> seconds}
@@ -84,13 +83,27 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} {
foreach {attr val} $info($channel) {
set $attr $val
}
if {$TYPE == "DBF_CHAR"} {
foreach char $VAL {
append s [format "%c" $char]
catch {
set null 0
if {$TYPE == "DBF_CHAR" && $SIZE > 1 \
&& [lsearch $flags "-int"] == -1 \
&& [lsearch $flags "-hex"] == -1} {
foreach char $VAL {
if {$null && $char != 0} {
error "Not printable"
}
if {($char & 0x7f) >= 0x20 || $char == 0x0a || $char == 0x0d && $char != 0x7f} {
append s [format "%c" $char]
} elseif {$char == 0} {
set null 1
} else {
error "Not prinable"
}
}
set SIZE 1
set TYPE DBF_STRING
set VAL $s
}
set SIZE 1
set TYPE DBF_STRING
set VAL $s
}
if {[lsearch $flags -plain] != -1} {
set formatted $VAL
@@ -118,8 +131,14 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} {
set val [format "%.${PREC}f" $val]
}
}
if {$TYPE == "DBF_ENUM" && \
([lsearch $flags "-int"] != -1 || [lsearch $flags "-hex"] != -1)} {
set v [lsearch $ENUM $val]
if {$v != -1} {set val $v}
set TYPE "DBF_INT"
}
if {$TYPE == "DBF_STRING" || $TYPE == "DBF_ENUM"} {
set val \"$val\"
set val \"[string map {"\n" "\\n" "\r" "\\r" "\"" "\\\"" "\\" "\\\\"} $val]\"
} else {
if {[lsearch $flags -hex] != -1} {
catch {
@@ -246,12 +265,6 @@ switch $command {
foreach {channel setvalue} $argv {
if [catch {
pvput $channel $setvalue
} msg] {
puts stderr $msg
incr faults
}
if [catch {
pvget $channel
lappend channels $channel
} msg] {
puts stderr $msg
@@ -325,7 +338,7 @@ foreach channel $channels {
set HHSV "\t([pvget $base.HHSV])"
set HSV "\t([pvget $base.HSV])"
set LSV "\t([pvget $base.LSV])"
set LLSV "\t([pvget $base.LSV])"
set LLSV "\t([pvget $base.LLSV])"
set extra $HHSV
}
}