1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
# ImageMagic.tcl --
#
# ImportWindowSnapShot
# Depends on ImageMagic installation
# Contributed by Raymond Tang, adapted as a plugin by Mats Bengtsson.
#
# Unix/Linux only.
#
# Copyright (c) 2007 Mats Bengtsson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
# $Id: ImageMagic.tcl,v 1.14 2007-11-17 07:40:52 matben Exp $
namespace eval ::ImageMagic {
if {[string equal $::tcl_platform(platform) "unix"]} {
set importcmd [lindex [auto_execok import] 0]
if {[llength $importcmd]} {
component::define ImageMagic \
"ImageMagic import command bindings for taking screenshots on X11"
}
}
variable imageType gif
}
proc ::ImageMagic::Init {} {
global tcl_platform
variable imageType
variable haveImageMagic
variable importcmd
set haveImageMagic 0
if {[string equal $tcl_platform(platform) "unix"]} {
set importcmd [lindex [auto_execok import] 0]
if {[llength $importcmd]} {
set haveImageMagic 1
}
}
# Register a menu entry for this component.
if {$haveImageMagic} {
component::register ImageMagic
# 'type' 'label' 'command' 'opts' {subspec}
# where subspec defines a cascade menu recursively
# TRANSLATORS: see Plugins menu in whiteboard
set menuspec [list \
command mSnapshot [mc "Take &Snapshot"] {::ImageMagic::ImportWindowSnapShot $w} {} {} \
]
::WB::RegisterNewMenu addon [mc "Plu&gins"] $menuspec
}
}
proc ::ImageMagic::ImportWindowSnapShot {w} {
global this
variable imageType
variable tmpfiles
variable haveImageMagic
variable importcmd
set wcan [::WB::GetCanvasFromWtop $w]
if {$haveImageMagic == 0} {
::UI::MessageBox -title [mc "Error"] -icon error -type ok -message \
"Failed to locate ImageMagic package! Can't do screen snap shot :-("
return
}
set ans [::ImageMagic::BuildDialog .imagic]
update
if {$ans eq "1"} {
set tmpfile [::tfileutils::tempfile $this(tmpPath) imagemagic]
append tmpfile .$imageType
exec $importcmd $tmpfile
set optList [list -coords [::CanvasUtils::NewImportAnchor $wcan]]
set errMsg [::Import::DoImport $wcan $optList -file $tmpfile]
if {$errMsg eq ""} {
lappend tmpfiles $tmpfile
} else {
::UI::MessageBox -title [mc "Error"] -icon error -type ok \
-message "Failed importing: $errMsg"
}
}
}
proc ::ImageMagic::BuildDialog {w} {
variable imageType
variable finished
::UI::Toplevel $w -usemacmainmenu 1 -macstyle documentProc \
-macclass {document closeBox}
wm title $w [mc "Take Snapshot"]
set finished -1
# Global frame.
ttk::frame $w.frall
pack $w.frall -fill both -expand 1
set wbox $w.frall.f
ttk::frame $wbox -padding [option get . dialogPadding {}]
pack $wbox -fill both -expand 1
ttk::label $wbox.msg -style Small.TLabel \
-padding {0 0 0 6} -wraplength 300 -justify left \
-text [mc "Click on a window or drag a rectangular area to import a snapshot into the current whiteboard."]
pack $wbox.msg -side top -fill x -anchor w
ttk::label $wbox.la -text {Captured image format:} -style Small.TLabel
pack $wbox.la -side top -anchor w
set frbt $wbox.frbt
ttk::frame $frbt
pack $frbt -side top -anchor w
foreach type {bmp gif jpeg png tiff} {
ttk::radiobutton $frbt.$type -text $type -style Small.TRadiobutton \
-variable [namespace current]::imageType -value $type
grid $frbt.$type -sticky w -padx 20 -pady 1
# Verify that we've got an importer for the format.
set theMime [::Types::GetMimeTypeForFileName x.$type]
if {![::Media::HaveImporterForMime $theMime]} {
$frbt.$type configure -state disabled
}
}
# Button part.
set frbot $wbox.b
ttk::frame $frbot -padding [option get . okcancelTopPadding {}]
ttk::button $frbot.btok -text [mc "OK"] -default active \
-command [list set [namespace current]::finished 1]
ttk::button $frbot.btcancel -text [mc "Cancel"] \
-command [list set [namespace current]::finished 0]
set padx [option get . buttonPadX {}]
if {[option get . okcancelButtonOrder {}] eq "cancelok"} {
pack $frbot.btok -side right
pack $frbot.btcancel -side right -padx $padx
} else {
pack $frbot.btcancel -side right
pack $frbot.btok -side right -padx $padx
}
pack $frbot -side bottom -fill x
wm resizable $w 0 0
bind $w <Return> [list $frbot.btok invoke]
# Grab and focus.
focus $w
catch {grab $w}
# Wait here for a button press.
tkwait variable [namespace current]::finished
catch {grab release $w}
catch {destroy $w}
return $finished
}
# Clear Import files from in box
# Argument
# w
#
proc ::ImageMagic::ClearImportFiles {wcan} {
global prefs
variable tmpfiles
if {$prefs(incomingFilePath) eq "" || [string match {*[*?]*} $prefs(incomingFilePath)]} {
::UI::MessageBox -message [mc "Dangerous in-box path name: %s" $prefs(incomingFilePath)] \
-icon warning
return
}
if {![file exists $prefs(incomingFilePath)]} {
file mkdir $prefs(incomingFilePath)
}
set all_files [glob -nocomplain [file join $prefs(incomingFilePath) -- {*}]]
if {$all_files == ""} {
return
}
set msg [mc "Click OK to remove files: %s" "\n[join $all_files \n]"]
set ans [::UI::MessageBox -message $msg -type okcancel -icon warning]
if {"$ans" eq "ok"} {
foreach file $all_files {
file delete $file
}
}
}
|
