Compare commits

..

3 Commits

Author SHA1 Message Date
Sergey Kalinin
e534b27407 Добавлены настройки путей к программам для выполнения редактируемых файлов для каждого поддержимаего типа. И использование этих настроек при выполнении файла.
Some checks failed
Gitea Actions Demo / Explore-Gitea-Actions (push) Has been cancelled
2025-12-03 17:01:58 +03:00
Sergey Kalinin
b830838f8e Добавил вывод номера версии tcl/tl в О Программе
Some checks failed
Gitea Actions Demo / Explore-Gitea-Actions (push) Has been cancelled
2025-11-10 13:13:44 +03:00
df1d9aa36d Добавил проверку пакета Img. И поправил проверку типов изображений
All checks were successful
Gitea Actions Demo / Explore-Gitea-Actions (push) Successful in 1m23s
2025-10-31 17:30:16 +03:00
9 changed files with 140 additions and 32 deletions

20
debian/changelog vendored
View File

@@ -1,12 +1,24 @@
projman (2.0.0-alpha20) stable; urgency=medium projman (2.1.0-alpha0) stable; urgency=medium
* Исправил сохранение и закрытие нового файла. Теперь при сохранении файл будет переоткрыт под новым именем. * Добавил вывод информации о версиях tcl и tk
* Добавил вывод номера версии tcl/tl в О Программе
-- Sergey Kalinin <svk@nuk-svk.ru> Fri, 31 Oct 2025 18:56:38 +0300 -- Sergey Kalinin <svkalinin@samsonpost.ru> Mon, 10 Nov 2025 13:13:44 +0300
projman (2.1.0-alpha0) stable; urgency=medium
* Незначительные изменения
-- Sergey Kalinin <svkalinin@samsonpost.ru> Mon, 10 Nov 2025 13:00:43 +0300
projman (2.0.0-alpha19) stable; urgency=medium
* Небольшие исправления
-- Sergey Kalinin <svk@nuk-svk.ru> Thu, 30 Oct 2025 14:47:05 +0300
projman (2.0.0-alpha19) stable; urgency=medium projman (2.0.0-alpha19) stable; urgency=medium
* Переделал сигналы и сочетния
* Добавлен перевод фокуса ввода на прежнее окно после закрытия диалога выполнения. * Добавлен перевод фокуса ввода на прежнее окно после закрытия диалога выполнения.
* Добавлена передача сигналов для закрытия запущенного процесса * Добавлена передача сигналов для закрытия запущенного процесса
* Изменил виджет текста в окне псевдо-терминала. Добавил подстановку имени файла к командную строку по шаблону %f * Изменил виджет текста в окне псевдо-терминала. Добавил подстановку имени файла к командную строку по шаблону %f

0
errors Normal file
View File

View File

@@ -65,6 +65,16 @@ multilineComments=true
opened= opened=
editedFiles= editedFiles=
recentFolder= recentFolder=
\[Executor\]
TCL=tclsh
GO=go
PY=python3
SH=bash
PL=perl
RB=ruby
HTM=firefox
HTML=firefox
LUA=lua
" "
proc Config::create {dir} { proc Config::create {dir} {
set cfgFile [open [file join $dir projman.ini] "w+"] set cfgFile [open [file join $dir projman.ini] "w+"]

View File

@@ -1546,6 +1546,8 @@ namespace eval Editor {
} }
set fileType [string toupper [string trimleft [file extension $fileFullPath] "."]] set fileType [string toupper [string trimleft [file extension $fileFullPath] "."]]
if {$fileType eq ""} {set fileType "Unknown"} if {$fileType eq ""} {set fileType "Unknown"}
ExecutorCommandPathSetting $fileType
ttk::frame $fr.header ttk::frame $fr.header
set lblName "lbl[string range $itemName [expr [string last "." $itemName] +1] end]" set lblName "lbl[string range $itemName [expr [string last "." $itemName] +1] end]"

View File

@@ -9,12 +9,42 @@
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" {
@@ -279,16 +310,14 @@ namespace eval FileOper {
-icon question -type yesnocancel \ -icon question -type yesnocancel \
-detail [::msgcat::mc "Do you want to save it?"]] -detail [::msgcat::mc "Do you want to save it?"]]
switch $answer { switch $answer {
yes {Save close} yes Save
no {} no {}
cancel {return "cancel"} cancel {return "cancel"}
} }
} }
} }
if {[$nbEditor select] eq $nbItem} { $nbEditor forget $nbItem
$nbEditor forget $nbItem destroy $nbItem
destroy $nbItem
}
set treeItem "file::[string range $nbItem [expr [string last "." $nbItem] +1] end ]" set treeItem "file::[string range $nbItem [expr [string last "." $nbItem] +1] end ]"
if [$tree exists $treeItem] { if [$tree exists $treeItem] {
# delete all functions from tree item # delete all functions from tree item
@@ -313,7 +342,7 @@ namespace eval FileOper {
NB::NextTab $nbEditor 0 NB::NextTab $nbEditor 0
} }
proc Save {{type ""}} { proc Save {} {
global nbEditor tree env activeProject dir global nbEditor tree env activeProject dir
if [info exists activeProject] { if [info exists activeProject] {
@@ -348,12 +377,6 @@ namespace eval FileOper {
if {[file tail $filePath] eq "projman.ini"} { if {[file tail $filePath] eq "projman.ini"} {
Config::read $dir(cfg) Config::read $dir(cfg)
} }
if [string match "*untitled*" $nbEditorItem] {
FileOper::Close
if {$type ne "close"} {
FileOper::Edit $filePath
}
}
} }
proc SaveAll {} { proc SaveAll {} {

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

@@ -254,11 +254,13 @@ proc FindImage {ext} {
namespace eval Help { namespace eval Help {
proc About {} { proc About {} {
global projman global projman tcl_version tk_version
set msg "Tcl/Tk project Manager\n\n" set msg "Tcl/Tk project Manager\n\n"
append msg "Version: " $projman(Version) "\n" \ append msg "Version: " $projman(Version) "\n" \
"Release: " $projman(Release) "\n" \ "Release: " $projman(Release) "\n" \
"Build: " $projman(Build) "\n\n" \ "Build: " $projman(Build) "\n" \
"Tcl Version: " $tcl_version "\n" \
"Tk Version: " $tk_version "\n\n" \
"Author: " $projman(Author) "\n" \ "Author: " $projman(Author) "\n" \
"Home page: " $projman(Homepage) "Home page: " $projman(Homepage)
# foreach name [array names projman] { # foreach name [array names projman] {
@@ -871,6 +873,16 @@ proc Execute {filePath w activeEditor} {
set pos [$w.frame.text index insert] set pos [$w.frame.text index insert]
set lineNum [lindex [split $pos "."] 0] set lineNum [lindex [split $pos "."] 0]
$w.frame.text insert 0.0 "======================================================================================\n" $w.frame.text insert 0.0 "======================================================================================\n"
# Added executor from config
set fileType [string toupper [string trimleft [file extension $filePath] "."]]
if {[info exists cfgVariables(fileType)] == 0} {
$w.frame.text insert end "$cfgVariables($fileType) "
}
unset fileType
# $w.frame.text insert end [string toupper [string trimleft [file extension $filePath] "."]]
# $w.frame.text insert end cfgVariables($fileType)
$w.frame.text tag add bold $lineNum.0 $lineNum.end $w.frame.text tag add bold $lineNum.0 $lineNum.end
Highlight::ExecuteColorized $w.frame.text Highlight::ExecuteColorized $w.frame.text
# focus -force $w.frame.text # focus -force $w.frame.text
@@ -977,3 +989,34 @@ proc Settings {} {
FileOper::Edit [file join $dir(cfg) projman.ini] FileOper::Edit [file join $dir(cfg) projman.ini]
# Config::read $dir(cfg) # Config::read $dir(cfg)
} }
# Определяем пути до программ для запуска исходников
proc ExecutorCommandPathSetting {fileType} {
global cfgVariables tcl_platform
# puts $cfgVariables($fileType)
if {[info exists cfgVariables($fileType)] == 1 && $cfgVariables($fileType) ne ""} {
if {$tcl_platform(platform) eq "windows"} {
set cmd "where $cfgVariables($fileType)"
} else {
set cmd "which $cfgVariables($fileType)"
}
puts "ExecutorCommandPathSetting $fileType"
puts [catch {exec {*}$cmd} executor_path]
puts "executor_path $executor_path"
if {[catch {exec {*}$cmd} executor_path]} {
puts "Программа $cfgVariables($fileType) для выполнения файлов $fileType не найдена в системе"
set cfgVariables($fileType) ""
return
}
set full_path [string trim $executor_path]
set first_path [lindex [split $executor_path "\n"] 0]
# puts "Git найден: $first_path"
set cfgVariables($fileType) $first_path
puts "first_path $first_path"
}
if {[info exists cfgVariables($fileType)] == 0} {
set cfgVariables($fileType) ""
puts $cfgVariables($fileType)
}
}

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
@@ -8,9 +8,9 @@ exec wish8.6 "$0" -- "$@"
# Author: Sergey Kalinin svk@nuk-svk.ru # Author: Sergey Kalinin svk@nuk-svk.ru
# Home page: https://nuk-svk.ru # Home page: https://nuk-svk.ru
###################################################### ######################################################
# Version: 2.0.0 # Version: 2.1.0
# Release: alpha20 # Release: alpha0
# Build: 31102025185656 # Build: 10112025132121
###################################################### ######################################################
# определим текущую версию, релиз и т.д. # определим текущую версию, релиз и т.д.
@@ -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 {