svk/projman
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Исправлен changelog
Some checks failed
Gitea Actions Demo / Explore-Gitea-Actions (push) Has been cancelled
Details

Browse Source
This commit is contained in:
Sergey Kalinin
2025-10-29 13:10:31 +03:00
parent 4e67dbfccf
commit 8834c0954e
7 changed files with 110 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
debian/changelog vendored
View File

@@ -1,11 +1,10 @@
projman (2.0.0-alpha18) stable; urgency=medium
* Новая сборка
-- Sergey Kalinin <svk@nuk-svk.ru> Mon, 27 Oct 2025 21:01:15 +0300
projman (2.0.0-alpha18) stable; urgency=medium
* Добавлен диалог при открытии файлов отличных от текстовых
* Добавлен просмотр файлов изображений (png, bmp, gif, ppm, pgm)
* Исправлена роцедура опреления типа файла
* Добавлены диалоги для подтверждения открытия больших файлов, и двоичных файлов.
* Поправил тему оформления
* Исправлена работа в windows
* Уменьшил колдичество выводимой отладочной информации
* Добавлено определение пути до git в зависимости от платформы.

91
lib/files.tcl
View File

@@ -48,17 +48,70 @@ namespace eval FileOper {
# используем пакет из tcl
lassign [::fileutil::fileType $fileFullPath] fType fBinaryType fBinaryInterp
puts "File type is $fType, $fBinaryType, $fBinaryInterp"
set ext [string tolower [file extension $fileFullPath]]
# Установка корректного типа для svg
# Но для новых версий tcl
switch $ext {
".svg" {
set fType "binary"
set fBinaryInterp "svg"
set fBinaryType "graphic"
}
".torrent" {
set fType "binary"
set fBinaryInterp "torrent"
set fBinaryType "x-bittorrent"
}
".pdf" {
set fType "binary"
set fBinaryInterp "pdf"
set fBinaryType "binary"
}
}
puts "File type is $fType, $fBinaryType, $fBinaryInterp, $ext"
switch $fType {
"binary" {
if {$fBinaryType ne ""} {
switch $fBinaryType {
"graphic" {
if {$fBinaryInterp ne "png" && $fBinaryInterp ne "gif" && $fBinaryInterp ne "ppm" && $fBinaryInterp ne "pgm"} {
set answer [tk_messageBox -message [::msgcat::mc "The file looks like a image. Support not implemented yet."] -icon question -type ok]
switch $answer {
ok {
return false
}
}
} else {
return image
}
}
default {
return binary
}
}
} else {
return binary
}
}
"text" {
return text
}
"image" {
if {$fBinaryInterp ne "png" && $fBinaryInterp ne "gif" && $fBinaryInterp ne "ppm" && $fBinaryInterp ne "pgm" && $fBinaryInterp} {
set answer [tk_messageBox -message [::msgcat::mc "The file looks like a image. Support not implemented yet."] -icon question -type ok]
switch $answer {
ok {
return false
}
}
return image
}
}
"empty" {
return text
}
default {
return false
}
@@ -402,24 +455,39 @@ namespace eval FileOper {
# puts "$fileFullPath File type [::fileutil::magic::filetype $fileFullPath]"
set fileType [FileOper::GetFileMimeType $fileFullPath]
}
# puts "$fileType <<<<<<<<<<<"
switch $fileType {
"text" {
# return text
}
"image" {
if {[tk_messageBox -message [::msgcat::mc "The file looks like a image file"] -icon question -type ok] == "Yes"} {
return
}
}
"binary" {
if {[tk_dialog .question [::msgcat::mc "Open file"] [::msgcat::mc "The file looks like a binary file. Open anyway?"] questhead 0 Yes No] == 1} {
return
set answer [tk_messageBox -message [::msgcat::mc "The file looks like a binary file. Open anyway?"] \
-icon question -type yesno]
switch $answer {
yes {}
no {return}
}
}
false {
return
}
}
# Проверяем размер файла и если он больше 1мб вывести предупреждение
# puts " File size = [file size $fileFullPath]"
if {[file size $fileFullPath] > 1000000} {
set answer [tk_messageBox -message [::msgcat::mc "The file size to big. Open anyway?"] \
-detail [GetFileAttr $fileFullPath "size"] \
-icon question -type yesno]
switch $answer {
yes {}
no {return}
}
}
set filePath [file dirname $fileFullPath]
set fileName [file tail $fileFullPath]
@@ -433,6 +501,11 @@ namespace eval FileOper {
if {[winfo exists $itemName] == 0} {
NB::InsertItem $nbEditor $fileFullPath "file"
if {$fileType eq "image"} {
ImageViewer $fileFullPath $itemName $itemName
return $itemName
}
Editor::Editor $fileFullPath $nbEditor $itemName
ReadFile $fileFullPath $itemName
$itemName.frmText.t highlight 1.0 end
@@ -440,6 +513,11 @@ namespace eval FileOper {
$itemName.frmText.t see 1.1
}
$nbEditor select $itemName
focus -force $itemName
if {$fileType eq "image"} {
# ImageViewer $fileFullPath $itemName $itemName
return $itemName
}
Editor::ReadStructure $itemName.frmText.t $treeItemName
GetVariablesFromFile $fileFullPath
$itemName.frmText.t.t mark set insert 1.0
@@ -447,7 +525,8 @@ namespace eval FileOper {
focus -force $itemName.frmText.t.t
.frmStatus.lblSize configure -text [GetFileAttr $fileFullPath "size"]
.frmStatus.lblEncoding configure -text [GetFileMimeType $fileFullPath "charset"]
puts ">> $itemName"
# puts ">> $itemName"
return $itemName
}

15
lib/imgviewer.tcl
View File

@@ -1,8 +1,9 @@
proc ImageViewer {f w node} {
global factor cfgVariables
set factor($node) 1.0
ttk::frame $w.f
pack $w.f -side left -fill both -expand true
canvas $w.f.c -xscrollcommand "$w.f.x set" -yscrollcommand "$w.y set"
canvas $w.f.c -xscrollcommand "$w.f.x set" -yscrollcommand "$w.y set" -bg $cfgVariables(backGround)
ttk::scrollbar $w.f.x -ori hori -command "$w.f.c xview"
ttk::scrollbar $w.y -ori vert -command "$w.f.c yview"
@@ -20,15 +21,15 @@ proc ImageViewer {f w node} {
}
proc openImg {fn w node} {
global im1
global im1 factor
set im1 [image create photo -file $fn]
#scale $w
scale $w $factor($node) $node
list [file size $fn] bytes, [image width $im1]x[image height $im1]
$w create image 1 1 -image $im1 -anchor nw -tag img
}
proc scale {w {n 1} node} {
global im1 im2 factor noteBook tab_label
global im1 im2 factor tab_label
set factor($node) [expr {$factor($node) * $n}]
$w delete img
catch {image delete $im2}
@@ -41,7 +42,8 @@ proc scale {w {n 1} node} {
$im2 copy $im1 -subsample $f $f
}
$w create image 1 1 -image $im2 -anchor nw -tag img
$noteBook itemconfigure $node -text "$tab_label (size x$factor($node))"
set noteBook [file extension $node]
# $noteBook itemconfigure $node -text "(size x$factor($node))"
$w config -scrollregion [$w bbox all]
}
@@ -52,6 +54,7 @@ proc ImageBase64Encode {text} {
{"GIF" {.gif}}
{"JPEG" {.jpg}}
{"BMP" {.bmp}}
# {"SVG" {.svg}}
{"All files" *}
}
set img [tk_getOpenFile -initialdir $env(HOME) -filetypes $types -parent .]
@@ -65,5 +68,3 @@ proc ImageBase64Encode {text} {
$text insert [Position] "image create photo $name -data {\n$data\n}"
}
}

2
lib/msgs/en.msg
View File

@@ -67,6 +67,7 @@
::msgcat::mcset en "File was modifyed. Save?"
::msgcat::mcset en "The file looks like a binary file. Open anyway?"
::msgcat::mcset en "The file looks like a image. Support not implemented yet."
::msgcat::mcset en "The file size to big. Open anyway?"
::msgcat::mcset en "File saved"
::msgcat::mcset en "Files"
::msgcat::mcset en "Find"
@@ -185,4 +186,3 @@

3
lib/msgs/ru.msg
View File

@@ -89,7 +89,8 @@
::msgcat::mcset ru "File modify" "Файл изменен"
::msgcat::mcset ru "File saved" "Файл сохранен"
::msgcat::mcset ru "The file looks like a binary file. Open anyway?" "Файл похож на двоичный. Открыть все равно?"
::msgcat::mcset en "The file looks like a image. Support not implemented yet." "Файл выглядит как изображение. Поддержка пока не реализована."
::msgcat::mcset ru "The file looks like a image. Support not implemented yet." "Файл выглядит как изображение. Поддержка пока не реализована."
::msgcat::mcset ru "The file size to big. Open anyway?" "Файл большого размера. Открыть все равно?"
::msgcat::mcset ru "Find" "Найти"
::msgcat::mcset ru "Found" "Найдено"
::msgcat::mcset ru "Find in files" "Найти в файлах"

5
projman.tcl
View File

@@ -9,8 +9,8 @@ exec wish8.6 "$0" -- "$@"
# Home page: https://nuk-svk.ru
######################################################
# Version: 2.0.0
# Release: alpha18
# Build: 28102025160338
# Release: alpha19
# Build: 29102025130524
######################################################
# определим текущую версию, релиз и т.д.
@@ -149,4 +149,3 @@ if [info exists opened] {
}
}
}

5
theme/black.tcl
View File

@@ -118,6 +118,11 @@ namespace eval ttk::theme::black {
# -background [list selected $colors(-selectbg)] \
$styleCmd configure Treeview -fieldbackground gray25
$styleCmd map Canvas \
-background [list selected $colors(-lighter)] \
-foreground [list selected $colors(-selectfg)] \
-highlightbackground [list selected $colors(-lighter)]
}
puts [ttk::style element names]
}