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

Изменения перед слиянием
Some checks failed
Gitea Actions Demo / Explore-Gitea-Actions (push) Has been cancelled
Details

Browse Source
This commit is contained in:
Sergey Kalinin
2025-12-03 17:09:42 +03:00
parent 45cbd7845b e534b27407
commit ead8267d61
8 changed files with 147 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
lib/config.tcl
View File

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

2
lib/editor.tcl
View File

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

45
lib/files.tcl
View File

@@ -9,12 +9,42 @@
namespace eval FileOper {
variable types
global packages
variable types
set ::types {
{"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 ""}} {
global cfgVariables
# Проверям наличие программы в системе, если есть то добавляем опции
@@ -76,15 +106,15 @@ namespace eval FileOper {
if {$fBinaryType ne ""} {
switch $fBinaryType {
"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]
switch $answer {
ok {
return false
}
}
} else {
return image
}
}
default {
@@ -99,14 +129,15 @@ namespace eval FileOper {
return text
}
"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]
switch $answer {
ok {
return false
}
}
return image
}
}
"empty" {

2
lib/imgviewer.tcl
View File

@@ -54,7 +54,7 @@ proc ImageBase64Encode {text} {
{"GIF" {.gif}}
{"JPEG" {.jpg}}
{"BMP" {.bmp}}
# {"SVG" {.svg}}
{"SVG" {.svg}}
{"All files" *}
}
set img [tk_getOpenFile -initialdir $env(HOME) -filetypes $types -parent .]

51
lib/procedure.tcl
View File

@@ -258,7 +258,11 @@ namespace eval Help {
set msg "Tcl/Tk project Manager\n\n"
append msg "Version: " $projman(Version) "\n" \
"Release: " $projman(Release) "\n" \
<<<<<<< HEAD
"Build: " $projman(Build) "\n\n" \
=======
"Build: " $projman(Build) "\n" \
>>>>>>> tcltk9.0
"Tcl Version: " $tcl_version "\n" \
"Tk Version: " $tk_version "\n\n" \
"Author: " $projman(Author) "\n" \
@@ -911,9 +915,25 @@ proc Execute {filePath w activeEditor} {
$txt insert end "[::msgcat::mc "Enter command for execute file"] $filePath >\n"
set pos [$w.frame.text index insert]
set lineNum [lindex [split $pos "."] 0]
<<<<<<< HEAD
$txt insert 0.0 "======================================================================================\n"
$txt tag add bold $lineNum.0 $lineNum.end
Highlight::ExecuteColorized $txt
=======
$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
Highlight::ExecuteColorized $w.frame.text
>>>>>>> tcltk9.0
# focus -force $w.frame.text
# Привязки событий для защиты от редактирования
@@ -1082,3 +1102,34 @@ proc Settings {} {
FileOper::Edit [file join $dir(cfg) projman.ini]
# 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)
}
}