Изменения перед слиянием

2025-12-03 17:09:42 +03:00
parent 45cbd7845b e534b27407
commit ead8267d61
8 changed files with 147 additions and 11 deletions
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,21 @@
+<<<<<<< HEAD
 projman (2.0.0-alpha20) stable; urgency=medium
+=======
+projman (2.1.0-alpha0) stable; urgency=medium
+
+  *  Добавил вывод информации о версиях tcl и tk
+  *  Добавил вывод номера версии tcl/tl в О Программе
+
+ -- 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
+>>>>>>> tcltk9.0

  *  Исправил сохранение и закрытие нового файла. Теперь при сохранении файл будет переоткрыт под новым именем.
  *  Добавил проверку пакета Img. И поправил проверку типов изображений
@@ -417,3 +434,4 @@ projman (2.0.0-alfa0) stable; urgency=medium



+
--- a/lib/config.tcl
+++ b/lib/config.tcl
@@ -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+"]
--- a/lib/editor.tcl
+++ b/lib/editor.tcl
@@ -1547,6 +1547,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]"
        ttk::label $fr.header.$lblName -text $lblText
--- a/lib/files.tcl
+++ b/lib/files.tcl
@@ -9,11 +9,41 @@


 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" {
--- a/lib/imgviewer.tcl
+++ b/lib/imgviewer.tcl
@@ -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 .]
--- a/lib/procedure.tcl
+++ b/lib/procedure.tcl
@@ -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)
+    }
+}
--- a/projman.tcl
+++ b/projman.tcl
@@ -1,6 +1,6 @@
 #!/bin/sh
 # Tcl ignores the next line -*- tcl -*- \
-exec wish8.6 "$0" -- "$@"
+exec wish9.0 "$0" -- "$@"

 ######################################################
 #        Tcl/Tk Project manager 2.0
@@ -8,9 +8,15 @@ exec wish8.6 "$0" -- "$@"
 # Author: Sergey Kalinin svk@nuk-svk.ru
 # Home page: https://nuk-svk.ru
 ######################################################
+<<<<<<< HEAD
 # Version: 2.0.0
 # Release: alpha20
 # Build: 07112025145212
+=======
+# Version: 2.1.0
+# Release: alpha0
+# Build: 10112025132121
+>>>>>>> tcltk9.0
 ######################################################

 # определим текущую версию, релиз и т.д.
@@ -43,6 +49,24 @@ package require fileutil
 # package require Thread
 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(doc) [file join $dir(root) doc]
--- a/theme/black.tcl
+++ b/theme/black.tcl
@@ -6,8 +6,8 @@
 #
 # $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 tile 0.8;               # depends upon tile
+package require Tk;                 # minimum version for Tile
+package require tile;               # depends upon tile


 namespace eval ttk {