Compare commits
1 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| df1d9aa36d |
1
debian/changelog
vendored
1
debian/changelog
vendored
@@ -394,4 +394,3 @@ projman (2.0.0-alfa0) stable; urgency=medium
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -9,11 +9,41 @@
|
|||||||
|
|
||||||
|
|
||||||
namespace eval FileOper {
|
namespace eval FileOper {
|
||||||
|
global packages
|
||||||
variable types
|
variable types
|
||||||
|
|
||||||
set ::types {
|
set ::types {
|
||||||
{"All files" *}
|
{"All files" *}
|
||||||
}
|
}
|
||||||
|
# Проверка поддерживаемых типов изображений
|
||||||
|
# в зависимости устновлен пакет или нет
|
||||||
|
proc SupportImageType {type} {
|
||||||
|
if {[PackagePresent Img] eq "true"} {
|
||||||
|
switch $type {
|
||||||
|
jpeg { return true }
|
||||||
|
png { return true }
|
||||||
|
gif { return true }
|
||||||
|
bmp { return true }
|
||||||
|
svg { return true }
|
||||||
|
ppm { return true }
|
||||||
|
pgm { return true }
|
||||||
|
tiff { return true }
|
||||||
|
xbm { return true }
|
||||||
|
xpm { return true }
|
||||||
|
default { return false}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
switch $type {
|
||||||
|
png { return true }
|
||||||
|
gif { return true }
|
||||||
|
bmp { return true }
|
||||||
|
svg { return true }
|
||||||
|
ppm { return true }
|
||||||
|
pgm { return true }
|
||||||
|
default { return false}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
proc GetFileMimeType {fileFullPath {opt ""}} {
|
proc GetFileMimeType {fileFullPath {opt ""}} {
|
||||||
global cfgVariables
|
global cfgVariables
|
||||||
@@ -76,15 +106,15 @@ namespace eval FileOper {
|
|||||||
if {$fBinaryType ne ""} {
|
if {$fBinaryType ne ""} {
|
||||||
switch $fBinaryType {
|
switch $fBinaryType {
|
||||||
"graphic" {
|
"graphic" {
|
||||||
if {$fBinaryInterp ne "png" && $fBinaryInterp ne "gif" && $fBinaryInterp ne "ppm" && $fBinaryInterp ne "pgm"} {
|
if {[SupportImageType $fBinaryInterp] eq "true"} {
|
||||||
|
return image
|
||||||
|
} else {
|
||||||
set answer [tk_messageBox -message [::msgcat::mc "The file looks like a image. Support not implemented yet."] -icon question -type ok]
|
set answer [tk_messageBox -message [::msgcat::mc "The file looks like a image. Support not implemented yet."] -icon question -type ok]
|
||||||
switch $answer {
|
switch $answer {
|
||||||
ok {
|
ok {
|
||||||
return false
|
return false
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else {
|
|
||||||
return image
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
default {
|
default {
|
||||||
@@ -99,14 +129,15 @@ namespace eval FileOper {
|
|||||||
return text
|
return text
|
||||||
}
|
}
|
||||||
"image" {
|
"image" {
|
||||||
if {$fBinaryInterp ne "png" && $fBinaryInterp ne "gif" && $fBinaryInterp ne "ppm" && $fBinaryInterp ne "pgm" && $fBinaryInterp} {
|
if {[SupportImageType $fBinaryInterp] eq "true"} {
|
||||||
|
return image
|
||||||
|
} else {
|
||||||
set answer [tk_messageBox -message [::msgcat::mc "The file looks like a image. Support not implemented yet."] -icon question -type ok]
|
set answer [tk_messageBox -message [::msgcat::mc "The file looks like a image. Support not implemented yet."] -icon question -type ok]
|
||||||
switch $answer {
|
switch $answer {
|
||||||
ok {
|
ok {
|
||||||
return false
|
return false
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return image
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
"empty" {
|
"empty" {
|
||||||
|
|||||||
@@ -54,7 +54,7 @@ proc ImageBase64Encode {text} {
|
|||||||
{"GIF" {.gif}}
|
{"GIF" {.gif}}
|
||||||
{"JPEG" {.jpg}}
|
{"JPEG" {.jpg}}
|
||||||
{"BMP" {.bmp}}
|
{"BMP" {.bmp}}
|
||||||
# {"SVG" {.svg}}
|
{"SVG" {.svg}}
|
||||||
{"All files" *}
|
{"All files" *}
|
||||||
}
|
}
|
||||||
set img [tk_getOpenFile -initialdir $env(HOME) -filetypes $types -parent .]
|
set img [tk_getOpenFile -initialdir $env(HOME) -filetypes $types -parent .]
|
||||||
|
|||||||
20
projman.tcl
20
projman.tcl
@@ -1,6 +1,6 @@
|
|||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
# Tcl ignores the next line -*- tcl -*- \
|
# Tcl ignores the next line -*- tcl -*- \
|
||||||
exec wish8.6 "$0" -- "$@"
|
exec wish9.0 "$0" -- "$@"
|
||||||
|
|
||||||
######################################################
|
######################################################
|
||||||
# Tcl/Tk Project manager 2.0
|
# Tcl/Tk Project manager 2.0
|
||||||
@@ -43,6 +43,24 @@ package require fileutil
|
|||||||
# package require Thread
|
# package require Thread
|
||||||
package require fileutil::magic::filetype
|
package require fileutil::magic::filetype
|
||||||
|
|
||||||
|
# Определим установлен ли пакет Img для расширенной поддержки изображений
|
||||||
|
proc PackagePresent {pkg} {
|
||||||
|
# puts $pkg
|
||||||
|
foreach item [package names] {
|
||||||
|
# puts [string match -nocase Img $item]
|
||||||
|
if {[string match -nocase Img $item] == 1} {
|
||||||
|
puts "The $pkg package was found"
|
||||||
|
return true
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if {[PackagePresent "Img"] eq "true"} {
|
||||||
|
package require Img
|
||||||
|
} else {
|
||||||
|
puts "Img not present"
|
||||||
|
}
|
||||||
|
|
||||||
# Устанавливаем текущий каталог
|
# Устанавливаем текущий каталог
|
||||||
set dir(root) [pwd]
|
set dir(root) [pwd]
|
||||||
set dir(doc) [file join $dir(root) doc]
|
set dir(doc) [file join $dir(root) doc]
|
||||||
|
|||||||
@@ -6,8 +6,8 @@
|
|||||||
#
|
#
|
||||||
# $Id: black.tcl,v 1.2 2009/10/25 19:21:30 oberdorfer Exp $
|
# $Id: black.tcl,v 1.2 2009/10/25 19:21:30 oberdorfer Exp $
|
||||||
|
|
||||||
package require Tk 8.4; # minimum version for Tile
|
package require Tk; # minimum version for Tile
|
||||||
package require tile 0.8; # depends upon tile
|
package require tile; # depends upon tile
|
||||||
|
|
||||||
|
|
||||||
namespace eval ttk {
|
namespace eval ttk {
|
||||||
|
|||||||
Reference in New Issue
Block a user