Fortran · 20893 bytes Raw Blame History
1 module text_buffer_module
2 use iso_fortran_env, only: int32, int64, error_unit
3 use utf8_module
4 implicit none
5 private
6
7 public :: buffer_t, init_buffer, cleanup_buffer, copy_buffer
8 public :: buffer_insert, buffer_delete, buffer_get_char
9 public :: buffer_get_line, buffer_get_line_count, buffer_get_line_char_count
10 public :: buffer_load_file, buffer_save_file, buffer_load_file_as_hex
11 public :: buffer_move_gap
12 public :: buffer_char_at, buffer_byte_to_char_col, buffer_char_to_byte_col
13 public :: buffer_to_string
14
15 integer, parameter :: INITIAL_SIZE = 8192
16 integer, parameter :: GROW_FACTOR = 2
17
18 type :: buffer_t
19 character(len=:), allocatable :: data
20 integer(int32) :: gap_start = 1
21 integer(int32) :: gap_end = 1
22 integer(int32) :: size = 0
23 logical :: modified = .false.
24 end type buffer_t
25
26 contains
27
28 subroutine init_buffer(buffer, initial_content)
29 type(buffer_t), intent(out) :: buffer
30 character(len=*), intent(in), optional :: initial_content
31 integer :: content_len, alloc_size
32
33 if (present(initial_content)) then
34 content_len = len(initial_content)
35 alloc_size = max(INITIAL_SIZE, content_len * 2)
36 else
37 content_len = 0
38 alloc_size = INITIAL_SIZE
39 end if
40
41 ! Allocate the buffer data
42 allocate(character(len=alloc_size) :: buffer%data)
43 buffer%data = repeat(' ', alloc_size) ! Initialize with spaces
44 buffer%size = alloc_size
45
46 if (present(initial_content) .and. content_len > 0) then
47 buffer%data(1:content_len) = initial_content
48 buffer%gap_start = content_len + 1
49 buffer%gap_end = buffer%size + 1
50 else
51 buffer%gap_start = 1
52 buffer%gap_end = buffer%size + 1
53 end if
54
55 buffer%modified = .false.
56 end subroutine init_buffer
57
58 subroutine cleanup_buffer(buffer)
59 type(buffer_t), intent(inout) :: buffer
60 if (allocated(buffer%data)) deallocate(buffer%data)
61 buffer%gap_start = 1
62 buffer%gap_end = 1
63 buffer%size = 0
64 end subroutine cleanup_buffer
65
66 subroutine buffer_move_gap(buffer, position)
67 type(buffer_t), intent(inout) :: buffer
68 integer, intent(in) :: position
69 integer :: gap_size, move_size, i
70 character :: ch
71
72 if (position == buffer%gap_start) return
73
74 gap_size = buffer%gap_end - buffer%gap_start
75
76 if (position < buffer%gap_start) then
77 ! Move gap left - copy character by character to avoid allocation issues
78 move_size = buffer%gap_start - position
79 do i = 1, move_size
80 ch = buffer%data(position + i - 1:position + i - 1)
81 buffer%data(buffer%gap_end - move_size + i - 1:buffer%gap_end - move_size + i - 1) = ch
82 end do
83 buffer%gap_start = position
84 buffer%gap_end = position + gap_size
85 else
86 ! Move gap right - copy character by character to avoid allocation issues
87 move_size = position - buffer%gap_start
88 do i = 1, move_size
89 ch = buffer%data(buffer%gap_end + i - 1:buffer%gap_end + i - 1)
90 buffer%data(buffer%gap_start + i - 1:buffer%gap_start + i - 1) = ch
91 end do
92 buffer%gap_start = position
93 buffer%gap_end = position + gap_size
94 end if
95 end subroutine buffer_move_gap
96
97 subroutine buffer_insert(buffer, position, text)
98 type(buffer_t), intent(inout) :: buffer
99 integer, intent(in) :: position
100 character(len=*), intent(in) :: text
101 integer :: text_len, gap_size, new_size
102 character(len=:), allocatable :: new_data
103
104 text_len = len(text)
105 if (text_len == 0) return
106
107 call buffer_move_gap(buffer, position)
108 gap_size = buffer%gap_end - buffer%gap_start
109
110 ! Grow buffer if needed
111 if (text_len > gap_size) then
112 new_size = buffer%size * GROW_FACTOR
113 do while (text_len > new_size - (buffer%size - gap_size))
114 new_size = new_size * GROW_FACTOR
115 end do
116
117 allocate(character(len=new_size) :: new_data)
118 new_data = repeat(' ', new_size)
119
120 ! Copy data before gap
121 if (buffer%gap_start > 1) then
122 new_data(1:buffer%gap_start-1) = buffer%data(1:buffer%gap_start-1)
123 end if
124
125 ! Copy data after gap
126 if (buffer%gap_end <= buffer%size) then
127 new_data(new_size-(buffer%size-buffer%gap_end+1)+1:new_size) = &
128 buffer%data(buffer%gap_end:buffer%size)
129 end if
130
131 buffer%gap_end = new_size - (buffer%size - buffer%gap_end) + 1
132 deallocate(buffer%data)
133 buffer%data = new_data
134 buffer%size = new_size
135 end if
136
137 ! Insert text at gap start
138 buffer%data(buffer%gap_start:buffer%gap_start+text_len-1) = text
139 buffer%gap_start = buffer%gap_start + text_len
140 buffer%modified = .true.
141 end subroutine buffer_insert
142
143 subroutine buffer_delete(buffer, position, count)
144 type(buffer_t), intent(inout) :: buffer
145 integer, intent(in) :: position, count
146
147 if (count <= 0) return
148
149 call buffer_move_gap(buffer, position)
150 buffer%gap_end = min(buffer%gap_end + count, buffer%size + 1)
151 buffer%modified = .true.
152 end subroutine buffer_delete
153
154 function buffer_get_char(buffer, position) result(ch)
155 type(buffer_t), intent(in) :: buffer
156 integer, intent(in) :: position
157 character :: ch
158 integer :: actual_pos
159
160 ! Check bounds
161 if (position < 1 .or. position > buffer%size - (buffer%gap_end - buffer%gap_start)) then
162 ch = char(0)
163 return
164 end if
165
166 if (.not. allocated(buffer%data)) then
167 ch = char(0)
168 return
169 end if
170
171 if (position < buffer%gap_start) then
172 if (position <= len(buffer%data)) then
173 ch = buffer%data(position:position)
174 else
175 ch = char(0)
176 end if
177 else
178 actual_pos = position + (buffer%gap_end - buffer%gap_start)
179 if (actual_pos > 0 .and. actual_pos <= len(buffer%data)) then
180 ch = buffer%data(actual_pos:actual_pos)
181 else
182 ch = char(0)
183 end if
184 end if
185 end function buffer_get_char
186
187 function buffer_get_line(buffer, line_num) result(line)
188 type(buffer_t), intent(in) :: buffer
189 integer, intent(in) :: line_num
190 character(len=:), allocatable :: line
191 integer :: current_line, pos, start_pos, end_pos, logical_size
192 character :: ch
193
194 line = ''
195 current_line = 1
196 pos = 1
197 start_pos = 1
198 logical_size = buffer%size - (buffer%gap_end - buffer%gap_start)
199
200 ! Find start of requested line
201 do while (current_line < line_num)
202 ch = buffer_get_char(buffer, pos)
203 if (ch == char(10)) then ! LF
204 current_line = current_line + 1
205 start_pos = pos + 1
206 end if
207 if (ch == char(0)) return ! Null terminator
208 pos = pos + 1
209 if (pos > logical_size) return
210 end do
211
212 ! Find end of line
213 end_pos = start_pos
214 do
215 ch = buffer_get_char(buffer, end_pos)
216 if (ch == char(10) .or. ch == char(0)) exit
217 end_pos = end_pos + 1
218 if (end_pos > logical_size) exit
219 end do
220
221 ! Extract line
222 if (allocated(line)) deallocate(line)
223 if (end_pos > start_pos) then
224 allocate(character(len=end_pos-start_pos) :: line)
225 do pos = start_pos, end_pos - 1
226 line(pos-start_pos+1:pos-start_pos+1) = buffer_get_char(buffer, pos)
227 end do
228 else
229 ! Empty line
230 allocate(character(len=0) :: line)
231 end if
232 end function buffer_get_line
233
234 function buffer_get_line_count(buffer) result(count)
235 type(buffer_t), intent(in) :: buffer
236 integer :: count
237 integer :: pos, logical_size
238 character :: ch
239
240 count = 1
241 pos = 1
242 logical_size = buffer%size - (buffer%gap_end - buffer%gap_start)
243
244 do while (pos <= logical_size)
245 ch = buffer_get_char(buffer, pos)
246 if (ch == char(10)) count = count + 1
247 if (ch == char(0)) exit ! Stop at null terminator
248 pos = pos + 1
249 end do
250 end function buffer_get_line_count
251
252 subroutine buffer_load_file(buffer, filename, status)
253 type(buffer_t), intent(inout) :: buffer
254 character(len=*), intent(in) :: filename
255 integer, intent(out) :: status
256 integer :: unit, filesize, ios, i, null_count, check_size
257 character(len=:), allocatable :: content
258 character :: ch
259
260 status = -1
261 open(newunit=unit, file=filename, status='old', action='read', &
262 form='unformatted', access='stream', iostat=ios)
263
264 if (ios /= 0) then
265 write(error_unit, *) 'Error opening file: ', trim(filename)
266 return
267 end if
268
269 inquire(unit=unit, size=filesize)
270 if (filesize > 0) then
271 ! Check if file is binary by reading first chunk
272 check_size = min(512, filesize)
273 null_count = 0
274
275 ! Read first chunk to check for binary content
276 do i = 1, check_size
277 read(unit, iostat=ios) ch
278 if (ios /= 0) exit
279 if (iachar(ch) == 0) null_count = null_count + 1
280 end do
281
282 ! If more than 1% null bytes, it's likely binary
283 if (null_count > check_size / 100) then
284 close(unit)
285 write(error_unit, '(A)') ''
286 write(error_unit, '(A)') 'Error: Cannot open binary file: ' // trim(filename)
287 write(error_unit, '(A)') ''
288 write(error_unit, '(A)') 'This appears to be a binary file (contains null bytes).'
289 write(error_unit, '(A)') 'Binary files like .mod, .o, .a, executables, and images cannot be edited as text.'
290 write(error_unit, '(A)') ''
291 write(error_unit, '(A)') 'To view binary files, try:'
292 write(error_unit, '(A)') ' xxd ' // trim(filename) // ' # Hex dump'
293 write(error_unit, '(A)') ' file ' // trim(filename) // ' # File type info'
294 write(error_unit, '(A)') ''
295 status = -2 ! Special status for binary files
296 return
297 end if
298
299 ! Rewind to beginning to read full file
300 rewind(unit)
301
302 allocate(character(len=filesize) :: content)
303 read(unit, iostat=ios) content
304 if (ios == 0) then
305 call init_buffer(buffer, content)
306 status = 0
307 end if
308 deallocate(content)
309 else
310 call init_buffer(buffer)
311 status = 0
312 end if
313
314 close(unit)
315 end subroutine buffer_load_file
316
317 subroutine buffer_save_file(buffer, filename, status)
318 type(buffer_t), intent(inout) :: buffer
319 character(len=*), intent(in) :: filename
320 integer, intent(out) :: status
321 integer :: unit, ios, pos
322 character :: ch
323
324 status = -1
325 open(newunit=unit, file=filename, status='replace', action='write', &
326 form='unformatted', access='stream', iostat=ios)
327
328 if (ios /= 0) then
329 write(error_unit, *) 'Error creating file: ', trim(filename)
330 return
331 end if
332
333 ! Write content, skipping gap
334 ! Write content before gap
335 do pos = 1, buffer%gap_start - 1
336 ch = buffer%data(pos:pos)
337 write(unit, iostat=ios) ch
338 if (ios /= 0) exit
339 end do
340
341 ! Write content after gap
342 if (ios == 0 .and. buffer%gap_end <= buffer%size) then
343 do pos = buffer%gap_end, buffer%size
344 ch = buffer%data(pos:pos)
345 if (ch /= char(0)) then ! Only write non-null characters
346 write(unit, iostat=ios) ch
347 if (ios /= 0) exit
348 end if
349 end do
350 end if
351
352 close(unit)
353 if (ios == 0) then
354 buffer%modified = .false.
355 status = 0
356 end if
357 end subroutine buffer_save_file
358
359 ! Copy buffer contents from source to destination
360 subroutine copy_buffer(dest, src)
361 type(buffer_t), intent(inout) :: dest
362 type(buffer_t), intent(in) :: src
363
364 ! Cleanup destination first
365 if (allocated(dest%data)) deallocate(dest%data)
366
367 ! Allocate same size as source
368 allocate(character(len=src%size) :: dest%data)
369
370 ! Copy all fields
371 dest%data = src%data
372 dest%gap_start = src%gap_start
373 dest%gap_end = src%gap_end
374 dest%size = src%size
375 dest%modified = src%modified
376 end subroutine copy_buffer
377
378 ! ========================================================================
379 ! UTF-8 Helper Functions
380 ! ========================================================================
381
382 ! Get the number of UTF-8 characters (not bytes) in a line
383 function buffer_get_line_char_count(buffer, line_num) result(char_count)
384 type(buffer_t), intent(in) :: buffer
385 integer, intent(in) :: line_num
386 integer :: char_count
387 character(len=:), allocatable :: line
388
389 line = buffer_get_line(buffer, line_num)
390 char_count = utf8_char_count(line)
391 if (allocated(line)) deallocate(line)
392 end function buffer_get_line_char_count
393
394 ! Get character at a specific character position (not byte) in a line
395 ! Returns empty string if out of bounds
396 function buffer_char_at(buffer, line_num, char_col) result(char_str)
397 type(buffer_t), intent(in) :: buffer
398 integer, intent(in) :: line_num, char_col
399 character(len=:), allocatable :: char_str
400 character(len=:), allocatable :: line
401
402 line = buffer_get_line(buffer, line_num)
403 char_str = utf8_char_at(line, char_col)
404 if (allocated(line)) deallocate(line)
405 end function buffer_char_at
406
407 ! Convert byte column to character column in a line
408 function buffer_byte_to_char_col(buffer, line_num, byte_col) result(char_col)
409 type(buffer_t), intent(in) :: buffer
410 integer, intent(in) :: line_num, byte_col
411 integer :: char_col
412 character(len=:), allocatable :: line
413
414 line = buffer_get_line(buffer, line_num)
415 char_col = utf8_byte_to_char_index(line, byte_col)
416 if (allocated(line)) deallocate(line)
417 end function buffer_byte_to_char_col
418
419 ! Convert character column to byte column in a line
420 function buffer_char_to_byte_col(buffer, line_num, char_col) result(byte_col)
421 type(buffer_t), intent(in) :: buffer
422 integer, intent(in) :: line_num, char_col
423 integer :: byte_col
424 character(len=:), allocatable :: line
425
426 line = buffer_get_line(buffer, line_num)
427 byte_col = utf8_char_to_byte_index(line, char_col)
428 if (allocated(line)) deallocate(line)
429 end function buffer_char_to_byte_col
430
431 ! Load binary file as hex display (like xxd format)
432 subroutine buffer_load_file_as_hex(buffer, filename, status)
433 type(buffer_t), intent(inout) :: buffer
434 character(len=*), intent(in) :: filename
435 integer, intent(out) :: status
436 integer :: unit, filesize, ios, i, line_count, bytes_read, byte_count
437 character(len=:), allocatable :: hex_content
438 character(len=16) :: byte_buffer
439 character(len=100) :: hex_line
440 character :: ch
441 integer :: line_offset
442
443 status = -1
444 open(newunit=unit, file=filename, status='old', action='read', &
445 form='unformatted', access='stream', iostat=ios)
446
447 if (ios /= 0) then
448 write(error_unit, *) 'Error opening file: ', trim(filename)
449 return
450 end if
451
452 inquire(unit=unit, size=filesize)
453 if (filesize > 0) then
454 ! Estimate hex content size (each byte becomes ~4 chars + formatting)
455 ! Format: "00000000: 00 01 02 ... 0f ................\n"
456 ! Each line = 8 (offset) + 2 (: ) + 48 (hex) + 2 ( ) + 16 (ascii) + 1 (newline) = 77 chars
457 line_count = (filesize + 15) / 16 ! Round up to nearest 16-byte line
458 allocate(character(len=line_count * 80) :: hex_content)
459 hex_content = ''
460
461 line_offset = 0
462 bytes_read = 0
463
464 do while (bytes_read < filesize)
465 ! Clear byte buffer and read up to 16 bytes
466 byte_buffer = repeat(' ', 16)
467 byte_count = 0
468 do i = 1, 16
469 if (bytes_read >= filesize) exit
470 read(unit, iostat=ios) ch
471 if (ios /= 0) exit
472 byte_buffer(i:i) = ch
473 bytes_read = bytes_read + 1
474 byte_count = byte_count + 1
475 end do
476
477 if (byte_count == 0) exit
478
479 ! Build hex line (format similar to xxd)
480 hex_line = repeat(' ', 100) ! Clear output line
481 call format_hex_line(byte_buffer, byte_count, line_offset, hex_line)
482 hex_content = trim(hex_content) // trim(hex_line) // char(10)
483 line_offset = line_offset + 16
484 end do
485
486 close(unit)
487
488 ! Initialize buffer with hex content
489 call init_buffer(buffer, trim(hex_content))
490 status = 0
491 else
492 close(unit)
493 call init_buffer(buffer, "Empty file")
494 status = 0
495 end if
496 end subroutine buffer_load_file_as_hex
497
498 ! Format a line in xxd-style hex display
499 subroutine format_hex_line(bytes, count, offset, output)
500 character(len=*), intent(in) :: bytes
501 integer, intent(in) :: count, offset
502 character(len=*), intent(out) :: output
503 integer :: i, byte_val, pos
504 character :: ch
505
506 ! Build the line: "00000000: 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f 10 ................"
507 output = ''
508 pos = 1
509
510 ! Add offset (8 hex digits + ": ")
511 write(output(pos:pos+9), '(Z8.8,A)') offset, ': '
512 pos = 11
513
514 ! Add hex bytes (3 chars each: "XX ", plus extra space after 8th byte)
515 do i = 1, 16
516 if (i <= count) then
517 byte_val = iachar(bytes(i:i))
518 write(output(pos:pos+2), '(Z2.2,A)') byte_val, ' '
519 else
520 output(pos:pos+2) = ' '
521 end if
522 pos = pos + 3
523
524 ! Extra space after 8th byte
525 if (i == 8) then
526 output(pos:pos) = ' '
527 pos = pos + 1
528 end if
529 end do
530
531 ! Add ASCII representation
532 output(pos:pos) = ' '
533 pos = pos + 1
534
535 do i = 1, count
536 ch = bytes(i:i)
537 byte_val = iachar(ch)
538 if (byte_val >= 32 .and. byte_val <= 126) then
539 ! Printable ASCII
540 output(pos:pos) = ch
541 else
542 ! Non-printable - use dot
543 output(pos:pos) = '.'
544 end if
545 pos = pos + 1
546 end do
547 end subroutine format_hex_line
548
549 ! Convert buffer contents to a string
550 function buffer_to_string(buffer) result(str)
551 type(buffer_t), intent(in) :: buffer
552 character(len=:), allocatable :: str
553 integer :: content_len
554
555 if (buffer%gap_start == 1) then
556 ! No content before gap
557 content_len = buffer%size - buffer%gap_end + 1
558 if (content_len > 0) then
559 allocate(character(len=content_len) :: str)
560 str = buffer%data(buffer%gap_end:buffer%size)
561 else
562 allocate(character(len=0) :: str)
563 str = ""
564 end if
565 else if (buffer%gap_end > buffer%size) then
566 ! No gap (full buffer)
567 content_len = buffer%gap_start - 1
568 allocate(character(len=content_len) :: str)
569 str = buffer%data(1:content_len)
570 else
571 ! Content on both sides of gap
572 content_len = (buffer%gap_start - 1) + (buffer%size - buffer%gap_end + 1)
573 allocate(character(len=content_len) :: str)
574 str = buffer%data(1:buffer%gap_start-1) // buffer%data(buffer%gap_end:buffer%size)
575 end if
576 end function buffer_to_string
577
578 end module text_buffer_module