/
filelib.tcl
147 lines (100 loc) · 3.48 KB
/
filelib.tcl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
###########################################################
# Name: filelib.tcl
# Author: Daniele Bonini (posta@elettronica.lol)
# Date: 01/12/2023
# Desc: Filelib namespace of RadXIDE.
#
# Filelib namespace and most of the code
# here presented and distributed contains excerpts
# from [alited](https://github.com/aplsimple/alited
# by Alex Plotnikov and contributors to the project.
# The original code of these excerpts could be
# borrowed from other sources which the author
# and the contributors to this RadXIDE have no
# knowledge about.
#
# License: MIT. Copyrights 5 Mode (Last implementation and adaptations.)
# Copyright (c) 2021-2023 Alex Plotnikov https://aplsimple.github.io (original scaffolding and excerpts.)
#
###########################################################
namespace eval filelib {
# __________________________ createFile _________________________ #
proc createFile {{destfolder ""}} {
# Create a file.
# fname - file name
# stxt - text to save
namespace upvar ::radxide dan dan project project
set n "newfile"
#tk_messageBox -title $dan(TITLE) -icon error -message $destfolder
if {$destfolder ne ""} {
set num 1
while {[file exists $destfolder/$n$num]} {
incr num
}
#tk_messageBox -title $dan(TITLE) -icon error -message $destfolder/$n$num
set fname $destfolder/$n$num
set fh [open $fname {WRONLY CREAT}]
set stxt ""
puts $fh $stxt
close $fh
}
}
# __________________________ createFile _________________________ #
proc createFolder {{parentfolder ""}} {
# Create a file.
# fname - file name
# stxt - text to save
namespace upvar ::radxide dan dan project project
set n "newfolder"
#tk_messageBox -title $dan(TITLE) -icon error -message $parentfolder
if {$parentfolder ne ""} {
set num 1
while {[file exists $parentfolder/$n$num]} {
incr num
}
#tk_messageBox -title $dan(TITLE) -icon error -message $parentfolder/$n$num
set fname $parentfolder/$n$num
file mkdir $fname
}
}
# __________________________ delFile _________________________ #
proc delFile {{fname ""}} {
# Delete a file.
# fname - file name
if {($fname ne "")} {
catch {[file delete $fname]}
}
}
# __________________________ openFile _________________________ #
proc openFile {{fname ""} {reload no} {islist no} {Message {}}} {
# Handles "Open file" menu item.
# fnames - file name (if not set, asks for it)
# reload - if yes, loads the file even if it has a "strange" extension
# islist - if yes, *fnames* is a file list
# Message - name of procedure for "open file" message
# Return the content of the file
namespace upvar ::radxide dan dan
set ret ""
if {$fname ne "" && [file exists $fname]} {
set fh [open $fname {RDONLY}]
set ret [set data [read $fh]]
close $fh
}
return $ret
}
# __________________________ saveFile _________________________ #
proc saveFile {{fname ""} {stxt ""}} {
# Saves a file.
# fname - file name
# stxt - text to save
namespace upvar ::radxide dan dan project project
if {($fname ne "") && ($stxt ne "")} {
set fh [open $fname {WRONLY CREAT}]
puts $fh $stxt
chan truncate $fh
close $fh
}
}
#_______________________
}
# _________________________________ EOF _________________________________ #