don't show non-string char data as strings; dugfix in cainfo
This commit is contained in:
55
ca
55
ca
@@ -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
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user