Tcl/Tk: entry + listbox : how to convert it to a widget? - listbox

I adapted code from Brent Welch's book so that my entry box can be filled using listbox. Can the code listed below be improved upon? Also, I want to convert this code into a widget so that any one using the code base can reuse it. What do I need to do convert this into a reusable widget?
The code is listed below:
#----------------------------------------------
# Code adapted from Brent Welch's book
#----------------------------------------------
proc scrolled_listbox { f args } {
frame $f
listbox $f.list
eval {$f.list configure} $args
scrollbar $f.xscroll -orient horizontal \
-command [list $f.list xview]
scrollbar $f.yscroll -orient vertical \
-command [list $f.list yview]
grid $f.list -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 0 -weight 1
return $f.list
}
proc listbox_transfer_select {src dst} {
set select [$src curselection]
foreach i $select {
set elements [$dst get 0 end]
set e [$src get $i]
# insert only if the new element e is not present
if {$e ni $elements} {
$dst insert end $e
}
}
}
proc listbox_delete_select {dst} {
foreach i [lsort -integer -decreasing [$dst curselection]] {
$dst delete $i
}
}
proc onOk {picked parent window} {
set elements [$picked get 0 end]
$parent.e delete 0 end
$parent.e insert insert $elements
destroy $window
}
#----------------------------------------------
# Put everything together
#----------------------------------------------
proc list_select { parent values } {
# Create two lists side by side
set choiceWindow ${parent}.choices
toplevel $choiceWindow
set main [frame $choiceWindow.f1]
set choices [scrolled_listbox $main.choices \
-selectmode extended -width 20 -height 5 ]
set picked [scrolled_listbox $main.picked \
-selectmode extended -width 20 -height 5]
set inter [frame $main.inter -width 20 -height 5]
button $inter.b1 -width 10 -text ">>"
pack $inter.b1 -side top
button $inter.b2 -width 10 -text "<<"
pack $inter.b2 -side bottom
pack $main.choices $inter $main.picked -side left -expand true -fill both
set okcancel [frame $choiceWindow.f2]
button $okcancel.ok -text "OK" -command [list onOk $picked $parent $choiceWindow]
button $okcancel.cancel -text "Cancel" -command [list destroy $choiceWindow]
grid $okcancel.ok $okcancel.cancel
pack $main $okcancel -side top -anchor e
# Selecting in choices moves items into picked
bind $inter.b1 <ButtonRelease-1> [list listbox_transfer_select $choices $picked]
# Selecting in picked deletes items
bind $inter.b2 <ButtonRelease-1> [list listbox_delete_select $picked]
# ok
bind $choiceWindow <Return> [list onOk $picked $parent $choiceWindow]
# cancel
bind $choiceWindow <Escape> [list destroy $choiceWindow]
# Insert all the choices
foreach x $values {
$choices insert end $x
}
}
proc my_entry_list { parent options } {
frame $parent
label $parent.l -text "Fruits:"
entry $parent.e -width 15 -textvariable result -relief sunken
button $parent.b -text ... -command [list list_select $parent $options]
pack $parent.l $parent.e $parent.b -side left
}
#----------------------------------------------
# main
#----------------------------------------------
set options { grapes mangos peaches pears oranges berries }
my_entry_list .mel $options
pack .mel

No way to use the ttk::combobox widget from Tk 8.5 or the ComboBox widget from BWidget (if you have to stay at 8.4 or below)?

Related

How to return values from foreach loop in tcl

I have a list of all the files in the directory. I have stored them in a variable file_list. I want to get the tail name for each file. My approach is like this.
set file_list [list /a/b/a.txt /a/b/b.txt /a/b/c/file1.tcl /a/b/c/file2.tcl]
proc file_tail {filename} {
set x {}
set f_tail [file tail $filename]
lappend x $f_tail
return $x
}
foreach ft $file_list {
set f_tail [file_tail $ft]
}
but f_tail only contains last value stored i.e. "file2.tcl" Please guide me. I want a list of all tail values of file
I suggest either:
set f_tail {}
foreach ft $file_list {
lappend f_tail [file_tail $ft]
}
or (if you have a later version of Tcl):
set f_tail [lmap ft $file_list {file_tail $ft}]
Documentation:
foreach,
lappend,
lmap (for Tcl 8.5),
lmap
If you are making a list of all the tails, do this:
set f_tail {}
foreach ft $file_list {
lappend f_tail [file tail $ft]
}
If your helper function is going to do the lappend, you need to keep the variable holding the list outside the procedure:
proc file_tail {filename listVariable} {
upvar 1 $listVariable theList
set f_tail [file tail $filename]
lappend theList $f_tail
}
set tails {}
foreach ft $file_list {
file_tail $ft tails ; # <<< NAME, so not $tails as that would READ the variable
}
Note that we are passing in the name of the variable (tails outside) and using upvar 1 inside the procedure to make a linked local variable (theList inside) that can be updated. However, you can't do it by passing in a list value; Tcl uses copy-on-write semantics for its values. You need to be careful about the difference between the names of variables and the values they contain; they're not the same.

tcl loop through multiple lists

I have two lists I'd like manipulate.. ( I am a tcl newbie..). I'd like to associate these two lists and create a third list with some data added.
The data I have:
set aes {ae0 ae3 ae6 ae1v1 ae1v8}
set c {c1 c2 c3 k1 k2}
foreach A $aes {
foreach C $c {
puts ${A}_$C
}
}
The data I get as you'd expect is:
ae0_c1
ae0_c2
ae0_c3
ae0_k1
ae0_k2
..
..
What I want to do is
append some data in front of this.
AE-To-c = All ae0_c1 ae0_c2 ae0_c3 ae0_k1 ae0_k2 .. End.
% set aes {ae0 ae3 ae6 ae1v1 ae1v8}
ae0 ae3 ae6 ae1v1 ae1v8
% set c {c1 c2 c3 k1 k2}
c1 c2 c3 k1 k2
% foreach A $aes {
foreach C $c {
# saving into 'result' variable
lappend result ${A}_${C}
}
}
% set data "some more here"
some more here
% set result
ae0_c1 ae0_c2 ae0_c3 ae0_k1 ae0_k2 ae3_c1 ae3_c2 ae3_c3 ae3_k1 ae3_k2 ae6_c1 ae6_c2 ae6_c3 ae6_k1 ae6_k2 ae1v1_c1 ae1v1_c2 ae1v1_c3 ae1v1_k1 ae1v1_k2 ae1v8_c1 ae1v8_c2 ae1v8_c3 ae1v8_k1 ae1v8_k2
% set result [linsert $result 0 $data]
some more here ae0_c1 ae0_c2 ae0_c3 ae0_k1 ae0_k2 ae3_c1 ae3_c2 ae3_c3 ae3_k1 ae3_k2 ae6_c1 ae6_c2 ae6_c3 ae6_k1 ae6_k2 ae1v1_c1 ae1v1_c2 ae1v1_c3 ae1v1_k1 ae1v1_k2 ae1v8_c1 ae1v8_c2 ae1v8_c3 ae1v8_k1 ae1v8_k2
Your question isn't 100% clear. Is it something like this you want?
set res [list AE-To-c = All]
foreach A $aes {
foreach C $c {
lappend res ${A}_$C
}
}
lappend res End
If you want to do what I think you want to do, you need to capture the permutations of the two lists in a list instead of printing them out, and then wrap that list in a prefix and suffix.
The method above pre-loads the result list with the AE-To-c = All prefix, then picks up the permutations using lappend, and finally adds the End suffix as a last element in the list.
Another way:
set res [list]
foreach A $aes {
foreach C $c {
lappend res ${A}_$C
}
}
concat [list AE-To-c = All] $res End
In this variant the list of permutations is created first, and then the prefix list, the permutation list, and the suffix list (yes, End is a list) are concatenated into one flat list.
Documentation: concat, foreach, lappend, list, set

Foreach command ,initiation error

This is the list i have
set session_list [list ../../TIMING_ANALYSIS_CRPR/FUNC_ss28_0.85V_0.95V_0.85V_125C_RCmax/reports.15_03_10-22/SAVED_SESSION
../../TIMING_ANALYSIS_CRPR/FUNC_ff28_0.85V_0.95V_0.85V_m40C_Cmin/reports.15_03_10-22/SAVED_SESSION]
foreach j $session_list {
set x [string trimleft $j "../../TIMING_ANALYSIS_CRPR/ "]
}
foreach item $x {
puts "create_scenario -name $item "
}
so what i want is my output to the list be given out as :
create_scenario -name FUNC_ss28_0.85V_0.95V_0.85V_125C_RCmax/reports.15_03_10-22/SAVED_SESSION
create_scenario -name FUNC_ff28_0.85V_0.95V_0.85V_m40C_Cmin/reports.15_03_10-22/SAVED_SESSION
IN the top stated code ,it does not read the first foreach command and does not display the whole list
You are setting the value of x in each loop which will cause the x value to get overwritten.
You have to use lappend command
foreach j $session_list {
lappend x [string trimleft $j "../../TIMING_ANALYSIS_CRPR/ "]
}
foreach item $x {
puts "create_scenario -name $item "
}
Output :
create_scenario -name FUNC_ss28_0.85V_0.95V_0.85V_125C_RCmax/reports.15_03_10-22/SAVED_SESSION
create_scenario -name FUNC_ff28_0.85V_0.95V_0.85V_m40C_Cmin/reports.15_03_10-22/SAVED_SESSION
Reference : lappend
[string trimleft] doesn't do what you think it does. The line:
string trimleft $j "../../TIMING_ANALYSIS_CRPR/ "
basically means: remove the characters . and / and T and I and M and N and G and _ and A and N and L and Y and S and C and R and P and (single space) form the left of the string.
What you want instead is regsub:
regsub {^../../TIMING_ANALYSIS_CRPR/} $j ""

tk: make listbox "toggle" or "deselect"

In tk, the listbox can take a number of different selectModes: single, browse, multiple, and extended. What I want is to be to select only one item at a time (like single or browse) but then deselect the option when the user clicks again - essentially a "single or none" option.
I don't think I can use the ListboxSelect callback because that only is called "when the set of selected item(s) in the listbox is updated" - not when the user clicks a previous selection.
Do I have to resort to a series of checkboxes?
Note: For the listbox, I have exportselection=0 so I don't lose my selection when another widget takes focus.
You don't have to resort to a series of checkboxes, you can simply bind to the buttonpress event, and add a click handler.
Observe, an example:
bind $listbox <Button-1> {listbox_selection_toggler %W %x %y}
proc listbox_selection_toggler {W x y} {
set c [$W cursel]
set i [$W index #$x,$y]
lassign [$W bbox $i] x1 y1 x2 y2;
set x2 [expr {$x1 + $x2}]
set y2 [expr {$y1 + $y2}]
if { $y < $y1 || $y > $y2 } {
puts "(Cur: $c) Clicked on $W at $x,$y, index $i. (NOT IN BBOX)";
} else {
puts "(Cur: $c) Clicked on $W at $x,$y, index $i.";
if { $c != "" && $i == $c } {
puts "Toggling selection off."
after 0 [list $W sel clear 0 end]
}
}
}
Now, obviously there's room for improvement, but this demonstrates the general idea.

How do I know if PDF pages are color or black-and-white?

Given a set of PDF files among which some pages are color and the remaining are black & white, is there any program to find out among the given pages which are color and which are black & white? This would be useful, for instance, in printing out a thesis, and only spending extra to print the color pages. Bonus points for someone who takes into account double sided printing, and sends an appropriate black and white page to the color printer if it is are followed by a color page on the opposite side.
This is one of the most interesting questions I've seen! I agree with some of the other posts that rendering to a bitmap and then analyzing the bitmap will be the most reliable solution. For simple PDFs, here's a faster but less complete approach.
Parse each PDF page
Look for color directives (g, rg, k, sc, scn, etc)
Look for embedded images, analyze for color
My solution below does #1 and half of #2. The other half of #2 would be to follow up with user-defined color, which involves looking up the /ColorSpace entries in the page and decoding them -- contact me offline if this is interesting to you, as it's very doable but not in 5 minutes.
First the main program:
use CAM::PDF;
my $infile = shift;
my $pdf = CAM::PDF->new($infile);
PAGE:
for my $p (1 .. $pdf->numPages) {
my $tree = $pdf->getPageContentTree($p);
if (!$tree) {
print "Failed to parse page $p\n";
next PAGE;
}
my $colors = $tree->traverse('My::Renderer::FindColors')->{colors};
my $uncertain = 0;
for my $color (#{$colors}) {
my ($name, #rest) = #{$color};
if ($name eq 'g') {
} elsif ($name eq 'rgb') {
my ($r, $g, $b) = #rest;
if ($r != $g || $r != $b) {
print "Page $p is color\n";
next PAGE;
}
} elsif ($name eq 'cmyk') {
my ($c, $m, $y, $k) = #rest;
if ($c != 0 || $m != 0 || $y != 0) {
print "Page $p is color\n";
next PAGE;
}
} else {
$uncertain = $name;
}
}
if ($uncertain) {
print "Page $p has user-defined color ($uncertain), needs more investigation\n";
} else {
print "Page $p is grayscale\n";
}
}
And then here's the helper renderer that handles color directives on each page:
package My::Renderer::FindColors;
sub new {
my $pkg = shift;
return bless { colors => [] }, $pkg;
}
sub clone {
my $self = shift;
my $pkg = ref $self;
return bless { colors => $self->{colors}, cs => $self->{cs}, CS => $self->{CS} }, $pkg;
}
sub rg {
my ($self, $r, $g, $b) = #_;
push #{$self->{colors}}, ['rgb', $r, $g, $b];
}
sub g {
my ($self, $gray) = #_;
push #{$self->{colors}}, ['rgb', $gray, $gray, $gray];
}
sub k {
my ($self, $c, $m, $y, $k) = #_;
push #{$self->{colors}}, ['cmyk', $c, $m, $y, $k];
}
sub cs {
my ($self, $name) = #_;
$self->{cs} = $name;
}
sub cs {
my ($self, $name) = #_;
$self->{CS} = $name;
}
sub _sc {
my ($self, $cs, #rest) = #_;
return if !$cs; # syntax error
if ($cs eq 'DeviceRGB') { $self->rg(#rest); }
elsif ($cs eq 'DeviceGray') { $self->g(#rest); }
elsif ($cs eq 'DeviceCMYK') { $self->k(#rest); }
else { push #{$self->{colors}}, [$cs, #rest]; }
}
sub sc {
my ($self, #rest) = #_;
$self->_sc($self->{cs}, #rest);
}
sub SC {
my ($self, #rest) = #_;
$self->_sc($self->{CS}, #rest);
}
sub scn { sc(#_); }
sub SCN { SC(#_); }
sub RG { rg(#_); }
sub G { g(#_); }
sub K { k(#_); }
Newer versions of Ghostscript (version 9.05 and later) include a "device" called inkcov. It calculates the ink coverage of each page (not for each image) in Cyan (C), Magenta (M), Yellow (Y) and Black (K) values, where 0.00000 means 0%, and 1.00000 means 100% (see Detecting all pages which contain color).
For example:
$ gs -q -o - -sDEVICE=inkcov file.pdf
0.11264 0.11605 0.11605 0.09364 CMYK OK
0.11260 0.11601 0.11601 0.09360 CMYK OK
If the CMY values are not 0 then the page is color.
To just output the pages that contain colors use this handy oneliner:
$ gs -o - -sDEVICE=inkcov file.pdf |tail -n +4 |sed '/^Page*/N;s/\n//'|sed -E '/Page [0-9]+ 0.00000 0.00000 0.00000 / d'
It is possible to use the Image Magick tool identify. If used on PDF pages it converts the page first to a raster image. If the page contained color can be tested using the -format "%[colorspace]" option, which for my PDF printed either Gray or RGB. IMHO identify (or what ever tool it uses in the background; Ghostscript?) does choose the colorspace depending on the presents of color.
An example is:
identify -format "%[colorspace]" $FILE.pdf[$PAGE]
where PAGE is the page starting from 0, not 1. If the page selection is not used all pages will be collapsed to one, which is not what you want.
I wrote the following BASH script which uses pdfinfo to get the number of pages and then loops over them. Outputting the pages which are in color. I also added a feature for double sided document where you might need a non-colored backside page as well.
Using the outputted space separated list the colored PDF pages can be extracted using pdftk:
pdftk $FILE cat $PAGELIST output color_${FILE}.pdf
#!/bin/bash
FILE=$1
PAGES=$(pdfinfo ${FILE} | grep 'Pages:' | sed 's/Pages:\s*//')
GRAYPAGES=""
COLORPAGES=""
DOUBLECOLORPAGES=""
echo "Pages: $PAGES"
N=1
while (test "$N" -le "$PAGES")
do
COLORSPACE=$( identify -format "%[colorspace]" "$FILE[$((N-1))]" )
echo "$N: $COLORSPACE"
if [[ $COLORSPACE == "Gray" ]]
then
GRAYPAGES="$GRAYPAGES $N"
else
COLORPAGES="$COLORPAGES $N"
# For double sided documents also list the page on the other side of the sheet:
if [[ $((N%2)) -eq 1 ]]
then
DOUBLECOLORPAGES="$DOUBLECOLORPAGES $N $((N+1))"
#N=$((N+1))
else
DOUBLECOLORPAGES="$DOUBLECOLORPAGES $((N-1)) $N"
fi
fi
N=$((N+1))
done
echo $DOUBLECOLORPAGES
echo $COLORPAGES
echo $GRAYPAGES
#pdftk $FILE cat $COLORPAGES output color_${FILE}.pdf
The script from Martin Scharrer is great. It contains a minor bug: It counts two pages which contain color and are directly consecutive twice. I fixed that. In addition the script now counts the pages and lists the grayscale pages for double-paged printing. Also it prints the pages comma separated, so the output can directly be used for printing from a PDF viewer. I've added the code, but you can download it here, too.
Cheers,
timeshift
#!/bin/bash
if [ $# -ne 1 ]
then
echo "USAGE: This script needs exactly one paramter: the path to the PDF"
kill -SIGINT $$
fi
FILE=$1
PAGES=$(pdfinfo ${FILE} | grep 'Pages:' | sed 's/Pages:\s*//')
GRAYPAGES=""
COLORPAGES=""
DOUBLECOLORPAGES=""
DOUBLEGRAYPAGES=""
OLDGP=""
DOUBLEPAGE=0
DPGC=0
DPCC=0
SPGC=0
SPCC=0
echo "Pages: $PAGES"
N=1
while (test "$N" -le "$PAGES")
do
COLORSPACE=$( identify -format "%[colorspace]" "$FILE[$((N-1))]" )
echo "$N: $COLORSPACE"
if [[ $DOUBLEPAGE -eq -1 ]]
then
DOUBLEGRAYPAGES="$OLDGP"
DPGC=$((DPGC-1))
DOUBLEPAGE=0
fi
if [[ $COLORSPACE == "Gray" ]]
then
GRAYPAGES="$GRAYPAGES,$N"
SPGC=$((SPGC+1))
if [[ $DOUBLEPAGE -eq 0 ]]
then
OLDGP="$DOUBLEGRAYPAGES"
DOUBLEGRAYPAGES="$DOUBLEGRAYPAGES,$N"
DPGC=$((DPGC+1))
else
DOUBLEPAGE=0
fi
else
COLORPAGES="$COLORPAGES,$N"
SPCC=$((SPCC+1))
# For double sided documents also list the page on the other side of the sheet:
if [[ $((N%2)) -eq 1 ]]
then
DOUBLECOLORPAGES="$DOUBLECOLORPAGES,$N,$((N+1))"
DOUBLEPAGE=$((N+1))
DPCC=$((DPCC+2))
#N=$((N+1))
else
if [[ $DOUBLEPAGE -eq 0 ]]
then
DOUBLECOLORPAGES="$DOUBLECOLORPAGES,$((N-1)),$N"
DPCC=$((DPCC+2))
DOUBLEPAGE=-1
elif [[ $DOUBLEPAGE -gt 0 ]]
then
DOUBLEPAGE=0
fi
fi
fi
N=$((N+1))
done
echo " "
echo "Double-paged printing:"
echo " Color($DPCC): ${DOUBLECOLORPAGES:1:${#DOUBLECOLORPAGES}-1}"
echo " Gray($DPGC): ${DOUBLEGRAYPAGES:1:${#DOUBLEGRAYPAGES}-1}"
echo " "
echo "Single-paged printing:"
echo " Color($SPCC): ${COLORPAGES:1:${#COLORPAGES}-1}"
echo " Gray($SPGC): ${GRAYPAGES:1:${#GRAYPAGES}-1}"
#pdftk $FILE cat $COLORPAGES output color_${FILE}.pdf
ImageMagick has some built-in methods for image comparison.
http://www.imagemagick.org/Usage/compare/#type_general
There are some Perl APIs for ImageMagick, so maybe if you cleverly combine these with a PDF to Image converter you can find a way to do your black & white test.
I would try to do it like that, although there might be other easier solutions, and I'm curious to hear them, I just want to give it try:
Loop through all pages
Extract the pages to an image
Verify the color range of the image
For the page count, you can probably translate that without too much effort to Perl. It's basically a regex. It's also said that:
r"(/Type)\s?(/Page)[/>\s]"
You simply have to count how many
times this regular expression occurs
in the PDF file, minus the times you
find the string "<>"
(empty ages which are not rendered).
To extract the image, you can use ImageMagick to do that. Or see this question.
Finally, to get whether it is black and white, it depends if you mean literally black and white or grayscale. For black and white, you should only have, well, black and white in all the image. If you want to see grayscale, now, it's really not my speciality but I guess you could see if the averages of the red, the green and the blue are close to each other or if the original image and a grayscale converted one are close to each other.
Hope it gives some hints to help you go further.
Here is the ghostscript solution for Windows, which requires grep from GnuWin (http://gnuwin32.sourceforge.net/packages/grep.htm):
Monochrome (Black and White) pages:
gswin64c -q -o - -sDEVICE=inkcov DOCUMENT.pdf | grep "^ 0.00000 0.00000 0.00000" | find /c /v ""
Color pages:
gswin64c -q -o - -sDEVICE=inkcov DOCUMENT.pdf | grep -v "^ 0.00000 0.00000 0.00000" | find /c /v ""
Total pages (you get this one easier from any pdf reader):
gswin64c -q -o - -sDEVICE=inkcov DOCUMENT.pdf | find /c /v ""

Resources