1 # ui-print.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/mb/ui-print.tcl,v 1.12 2002/02/03 04:27:17 lim Exp $
32
33 import WidgetClass Dialog FileBox
34
35 WidgetClass MBUI_Print -superclass Dialog -configspec {
36 { -colorMode colorMode ColorMode gray set_colorMode colorMode }
37 { -orient orient Orient portrait set_orient orient }
38 { -content content Content full set_content content }
39 { -range range Range current set_range range }
40 { -pageMgr pageMgr PageMgr {} set_pageMgr pageMgr }
41 } -default {
42 { *Radiobutton.font WidgetDefault }
43 { *font WidgetDefault }
44 }
45
46 MBUI_Print instproc build_widget {path} {
47 set topf [frame $path.topf -bd 2 -relief ridge]
48 wm title $path "Save to Postscript"
49 set optionL [label $topf.optionL -text Options]
50 pack $optionL -side left -fill x
51 pack $topf -side top -fill x
52
53 set colorf [frame $topf.colorf -bd 1 -relief sunken]
54 set colorb [radiobutton $colorf.pscolor -text color -underline 0 \
55 -variable [$self tkvarname colorMode_] -value color]
56 set grayb [radiobutton $colorf.psgray -text gray -underline 0 \
57 -variable [$self tkvarname colorMode_] -value gray]
58 pack $colorb $grayb -side bottom -anchor w -expand 1
59
60 set orientf [frame $topf.orientf -bd 1 -relief sunken]
61 set portb [radiobutton $orientf.port -text portrait -underline 0 \
62 -variable [$self tkvarname orient_] -value portrait]
63 set landb [radiobutton $orientf.land -text landscape -underline 0 \
64 -variable [$self tkvarname orient_] \
65 -value landscape]
66 pack $landb $portb -side bottom -expand 1 -anchor w
67
68 set contentf [frame $topf.contentf -bd 1 -relief sunken]
69 set fullB [radiobutton $contentf.fullB -text "fit all items" \
70 -underline 0 \
71 -variable [$self tkvarname content_] -value full]
72 set displayB [radiobutton $contentf.displayB -text "displayed view" \
73 -underline 3 -variable [$self tkvarname content_] \
74 -value displayed]
75 pack $fullB $displayB -side top -expand 1 -anchor w
76
77 set rangef [frame $topf.rangef -bd 1 -relief sunken]
78 set currB [radiobutton $rangef.currB -text "current page" \
79 -underline 0 \
80 -variable [$self tkvarname range_] -value current]
81 set allB [radiobutton $rangef.allB -text "all pages" \
82 -underline 0 \
83 -variable [$self tkvarname range_] -value all]
84 pack $currB $allB -side top -expand 1 -anchor w
85
86 pack $orientf $colorf $contentf $rangef -side left -fill x \
87 -padx 2 -pady 4 -expand 1
88
89 $self tkvar filename_
90 set filef [frame $path.filef -bd 2 -relief ridge]
91 set filebox [FileBox $filef.filebox -filetypes {{postscript .ps}} \
92 -command "$self save; $self ignore_args" ]
93 $self set_subwidget filebox $filebox
94 pack $filef $filebox -side top -fill x -pady 3
95
96 set botf [frame $path.botf -bd 2]
97 set dismissb [button $botf.dismiss -text dismiss -width 10 \
98 -command "$self hide" -underline 0]
99 set okb [button $botf.ok -text ok -width 10 -command "$self save" \
100 -underline 0]
101 pack $dismissb $okb -side left
102 pack $botf -side right
103 }
104
105 MBUI_Print proc decl_accessor {className varName {instvarName {}}} {
106 if {"$instvarName"==""} {
107 set instvarName $varName
108 append instvarName "_"
109 }
110 $className instproc set_$varName {option value} \
111 "\$self set $instvarName \$value"
112 $className instproc $varName {} \
113 "return \[\$self set $instvarName \$value\]"
114 }
115
116 MBUI_Print proc decl_tk_accessor {className varName {tkvarName {}}} {
117 if {"$tkvarName" == ""} {
118 set tkvarName $varName
119 append tkvarName "_"
120 }
121 $className instproc set_$varName {option value} \
122 "\$self tkvar $tkvarName; set $tkvarName \$value"
123 $className instproc $varName {} \
124 "\$self tkvar $tkvarName; return \$tkvarname"
125 }
126
127 MBUI_Print proc decl_wgt_accessor { className varName {tkvarName {}} } {
128 if {$tkvarName == {}} {
129 set tkvarName $varName
130 append tkvarName _
131 }
132 eval [list $className instproc set_$varName {option value} \
133 "\$self tkvar $tkvarName; set $tkvarName \$value"]
134 eval [list $className instproc $varName {option} \
135 "\$self tkvar $tkvarName; return \$tkvarname"]
136 }
137
138 MBUI_Print decl_wgt_accessor MBUI_Print colorMode {}
139 MBUI_Print decl_wgt_accessor MBUI_Print orient {}
140 MBUI_Print decl_wgt_accessor MBUI_Print content {}
141 MBUI_Print decl_wgt_accessor MBUI_Print range {}
142 MBUI_Print decl_accessor MBUI_Print pageMgr {}
143
144 MBUI_Print instproc show {} {
145 $self instvar path_
146 wm deiconify $path_
147 wm title $path_ "Save to Postscript"
148 }
149
150 MBUI_Print instproc hide {} {
151 wm withdraw [$self set path_]
152 }
153
154 MBUI_Print instproc save {} {
155 set filebox [$self subwidget filebox]
156 set dir [$filebox cget -directory]
157 set file [$filebox cget -filename]
158 if { $file=="" } return
159 set path [file join $dir $file]
160 if [file exists $path] {
161 set reply [Dialog transient MessageBox -image Icons(warning) \
162 -type yesno -text \
163 "File \"$path\" already exists.\
164 \nDo you want to overwrite it?"]
165 if ![string compare $reply "no"] {
166 return
167 }
168 }
169
170 set f [open $path "w"]
171 $self tkvar orient_ colorMode_ content_ range_
172 set pageMgr [$self set pageMgr_]
173 if {$range_ == "all"} {
174 set pagelist [MBPageMgr sort_pages [$pageMgr pagelist]]
175 } else {
176 set pagelist [$pageMgr current_page]
177 }
178 set p [removeFirst pagelist]
179 if {"$p" == ""} return
180
181 set i 1
182 # FIXME: figure out why $self get_option does not work here
183 set confName [$pageMgr get_option conferenceName]
184 set hdr "Page $i --- \[[$pageMgr page_label $p]\] $confName [gettimeofday ascii]"
185
186 # dump prolog and document header
187 TkCanvPsHeader $f "Conference Name: $confName"
188
189 puts $f "%%Page: 1 1\nsave\n"
190
191 [$pageMgr page2canv $p] to_ps $content_ $orient_ $hdr \
192 -channel $f -colormode $colorMode_ \
193 -prolog 0 -trailer 0
194
195 foreach p $pagelist {
196 incr i
197 puts $f "\n%%Page: $i $i\n"
198 set hdr "Page $i --- \[[$pageMgr page_label $p]\] $confName [gettimeofday ascii]"
199 [$pageMgr page2canv $p] to_ps $content_ $orient_ $hdr \
200 -channel $f -colormode $colorMode_ \
201 -prolog 0 -trailer 0
202 puts $f "%%PageTrailer\n"
203 }
204 puts $f "%%Trailer\n%%Pages:$i\nend\n%%EOF\n"
205 close $f
206 $self hide
207 }
208
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.