Compare commits

1 Commits

Author SHA1 Message Date
df1d9aa36d Добавил проверку пакета Img. И поправил проверку типов изображений
All checks were successful
Gitea Actions Demo / Explore-Gitea-Actions (push) Successful in 1m23s
2025-10-31 17:30:16 +03:00
5 changed files with 60 additions and 12 deletions

1
debian/changelog vendored
View File

@@ -394,4 +394,3 @@ projman (2.0.0-alfa0) stable; urgency=medium

View File

@@ -9,11 +9,41 @@
namespace eval FileOper { namespace eval FileOper {
variable types global packages
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" {

View File

@@ -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 .]

View File

@@ -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]

View File

@@ -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 {