1-- 2-- Copyright (c) 2014-15 John Marino <draco@marino.st> 3-- 4-- Permission to use, copy, modify, and distribute this software for any 5-- purpose with or without fee is hereby granted, provided that the above 6-- copyright notice and this permission notice appear in all copies. 7-- 8-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15-- 16 17 18with Ada.Text_IO; 19with Ada.Text_IO.Text_Streams; 20with Ada.Direct_IO; 21with Ada.Calendar.Formatting; 22with GNAT.OS_Lib; 23 24package body Transactions.Delete is 25 26 package TIO renames Ada.Text_IO; 27 package TTS renames Ada.Text_IO.Text_Streams; 28 package GOS renames GNAT.OS_Lib; 29 30 31 --------------------- 32 -- launch_deleted -- 33 --------------------- 34 35 procedure launch_deleted (path : in String; newpath : in String) 36 is 37 use type TIC.Column_Count; 38 use type TIC.Real_Key_Code; 39 viewable : Boolean; 40 KeyCode : TIC.Real_Key_Code; 41 origin : constant String := path & ScanData.history (1).trax_id; 42 success : Boolean; 43 mformat : menu_format := found_binary; 44 begin 45 viewable := textfile (origin); 46 TIC.Init_Screen; 47 if not TIC.Has_Colors then 48 TIC.End_Windows; 49 TIO.Put_Line (msg_mono1); 50 TIO.Put_Line (msg_mono2); 51 return; 52 end if; 53 TIC.Set_Echo_Mode (False); 54 TIC.Set_Raw_Mode (True); 55 TIC.Set_Cbreak_Mode (True); 56 if TIC.Columns > app_width then 57 app_width := TIC.Columns; 58 end if; 59 TIC.Start_Color; 60 TIC.Init_Pair (TIC.Color_Pair (1), TIC.Cyan, TIC.Black); 61 TIC.Init_Pair (TIC.Color_Pair (2), TIC.White, TIC.Black); 62 TIC.Init_Pair (TIC.Color_Pair (3), TIC.Black, TIC.Black); 63 TIC.Init_Pair (TIC.Color_Pair (4), TIC.Black, TIC.White); 64 TIC.Init_Pair (TIC.Color_Pair (5), TIC.Green, TIC.Black); 65 TIC.Init_Pair (TIC.Color_Pair (6), TIC.Red, TIC.Black); 66 TIC.Init_Pair (TIC.Color_Pair (7), TIC.Yellow, TIC.Black); 67 c_cyan := TIC.Color_Pair (1); 68 c_white := TIC.Color_Pair (2); 69 c_black := TIC.Color_Pair (3); 70 c_path := TIC.Color_Pair (4); 71 c_green := TIC.Color_Pair (5); 72 c_red := TIC.Color_Pair (6); 73 c_yellow := TIC.Color_Pair (7); 74 75 start_command_window (path); 76 start_view_window; 77 78 if viewable then 79 mformat := found_text; 80 end if; 81 show_menu (format => mformat); 82 show_version (viewable => viewable); 83 start_input_window; 84 TIC.Set_KeyPad_Mode (Win => inpwindow, SwitchOn => True); 85 loop 86 KeyCode := TIC.Get_Keystroke (inpwindow); 87 case KeyCode is 88 when TIC.Key_F1 | Key_Num1 => 89 if viewable then 90 browse_file (origin); 91 show_menu (format => mformat); 92 show_version (viewable => viewable); 93 clear_input_window; 94 end if; 95 when TIC.Key_F2 | Key_Num2 => 96 recreate (origin, path, success); 97 if success then 98 indicate_success (path); 99 exit; 100 else 101 error_message ("Error: failed to restore file at " & 102 "original location. (permissions issue?)"); 103 end if; 104 when TIC.Key_F3 | Key_Num3 => 105 show_menu (format => saveas); 106 declare 107 confirmed : Boolean; 108 begin 109 clear_input_window; 110 confirmed := confirm_save_as (newpath); 111 show_menu (format => mformat); 112 show_version (viewable => viewable); 113 if confirmed then 114 recreate (origin, newpath, success); 115 if success then 116 indicate_success (newpath); 117 exit; 118 else 119 error_message ("Error: failed to restore file at " & 120 "SaveAs location. (permissions issue?)"); 121 end if; 122 end if; 123 end; 124 when TIC.Key_F4 | Key_Num4 => exit; 125 when others => 126 clear_input_window; 127 end case; 128 end loop; 129 TIC.Delete (inpwindow); 130 TIC.Delete (viewport); 131 TIC.Delete (comwindow); 132 TIC.End_Windows; 133 end launch_deleted; 134 135 136 ------------------------------- 137 -- launch_deleted_directory -- 138 ------------------------------- 139 140 procedure launch_deleted_directory ( 141 path : in String; 142 cleanpath : in String; 143 newpath : in String) 144 is 145 use type TIC.Column_Count; 146 use type TIC.Real_Key_Code; 147 mformat : menu_format := found_text; 148 begin 149 TIC.Init_Screen; 150 TIC.Set_Echo_Mode (False); 151 TIC.Set_Raw_Mode (True); 152 TIC.Set_Cbreak_Mode (True); 153 if TIC.Columns > app_width then 154 app_width := TIC.Columns; 155 end if; 156 TIC.Start_Color; 157 TIC.Init_Pair (TIC.Color_Pair (1), TIC.Cyan, TIC.Black); 158 TIC.Init_Pair (TIC.Color_Pair (2), TIC.White, TIC.Black); 159 TIC.Init_Pair (TIC.Color_Pair (3), TIC.Black, TIC.Black); 160 TIC.Init_Pair (TIC.Color_Pair (4), TIC.Black, TIC.White); 161 TIC.Init_Pair (TIC.Color_Pair (5), TIC.Green, TIC.Black); 162 TIC.Init_Pair (TIC.Color_Pair (6), TIC.Red, TIC.Black); 163 TIC.Init_Pair (TIC.Color_Pair (7), TIC.Yellow, TIC.Black); 164 TIC.Init_Pair (TIC.Color_Pair (10), TIC.Magenta, TIC.Black); 165 c_cyan := TIC.Color_Pair (1); 166 c_white := TIC.Color_Pair (2); 167 c_black := TIC.Color_Pair (3); 168 c_path := TIC.Color_Pair (4); 169 c_green := TIC.Color_Pair (5); 170 c_red := TIC.Color_Pair (6); 171 c_yellow := TIC.Color_Pair (7); 172 c_magenta := TIC.Color_Pair (10); 173 174 start_command_window (path); 175 start_view_window; 176 show_menu (format => mformat); 177 show_directory_version (path); 178 start_input_window; 179 declare 180 success : Boolean; 181 confirmed : Boolean; 182 KeyCode : TIC.Real_Key_Code; 183 begin 184 TIC.Set_KeyPad_Mode (Win => inpwindow, SwitchOn => True); 185 loop 186 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 187 KeyCode := TIC.Get_Keystroke (inpwindow); 188 clear_input_window; 189 case KeyCode is 190 when TIC.Key_F1 | Key_Num1 => 191 browse_directory (path); 192 show_menu (format => mformat); 193 show_directory_version (path); 194 when TIC.Key_F2 | Key_Num2 => 195 show_menu (format => saveas); 196 confirmed := confirm_save_as (cleanpath); 197 show_menu (format => mformat); 198 show_directory_version (path); 199 if confirmed then 200 duplicate_directory (path, cleanpath, success); 201 if success then 202 indicate_success (cleanpath); 203 exit; 204 end if; 205 end if; 206 when TIC.Key_F3 | Key_Num3 => 207 show_menu (format => saveas); 208 confirmed := confirm_save_as (newpath); 209 show_menu (format => mformat); 210 show_directory_version (path); 211 if confirmed then 212 duplicate_directory (path, newpath, success); 213 if success then 214 indicate_success (newpath); 215 exit; 216 end if; 217 end if; 218 when TIC.Key_F4 | Key_Num4 => exit; 219 when others => null; 220 end case; 221 end loop; 222 end; 223 TIC.Delete (inpwindow); 224 TIC.Delete (viewport); 225 TIC.Delete (comwindow); 226 TIC.End_Windows; 227 end launch_deleted_directory; 228 229 230 -------------------------- 231 -- start_input_window -- 232 -------------------------- 233 234 procedure start_input_window is 235 use type TIC.Line_Position; 236 use type TIC.Column_Count; 237 begin 238 inpwindow := TIC.Create ( 239 Number_Of_Lines => 1, 240 Number_Of_Columns => app_width + 1, 241 First_Line_Position => viewheight + 2, 242 First_Column_Position => 0); 243 TIC.Set_Character_Attributes (Win => inpwindow, Attr => bright); 244 end start_input_window; 245 246 247 ----------------------- 248 -- show_page_count -- 249 ----------------------- 250 251 procedure show_page_count (page : in Positive; total_pages : in Positive) 252 is 253 use type TIC.Column_Count; 254 whole_line : String (1 .. Natural (app_width)) := (others => ' '); 255 info : constant String := "page" & page'Img & " of" & total_pages'Img; 256 leftside : constant Positive := Positive (app_width) - info'Length + 1; 257 begin 258 whole_line (leftside .. whole_line'Last) := info; 259 TIC.Set_Color (Win => inpwindow, Pair => c_yellow); 260 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 261 TIC.Add (Win => inpwindow, Str => whole_line); 262 TIC.Refresh (Win => inpwindow); 263 end show_page_count; 264 265 266 -------------------------- 267 -- clear_input_window -- 268 -------------------------- 269 270 procedure clear_input_window is 271 blank_line : String (1 .. Natural (app_width)) := (others => ' '); 272 begin 273 TIC.Erase (Win => inpwindow); 274 TIC.Refresh (Win => inpwindow); 275 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 276 end clear_input_window; 277 278 279 ------------------------- 280 -- start_view_window -- 281 ------------------------- 282 283 procedure start_view_window is 284 use type TIC.Line_Position; 285 use type TIC.Column_Count; 286 begin 287 viewheight := TIC.Lines - 3; 288 if viewheight < 7 then 289 viewheight := 7; 290 end if; 291 viewport := TIC.Create ( 292 Number_Of_Lines => viewheight, 293 Number_Of_Columns => app_width + 1, 294 First_Line_Position => 2, 295 First_Column_Position => 0); 296 end start_view_window; 297 298 299 -------------------- 300 -- show_version -- 301 -------------------- 302 303 procedure show_version (viewable : in Boolean) is 304 use type TIC.Line_Position; 305 use type TIC.Column_Count; 306 center : constant TIC.Line_Position := viewheight / 2; 307 leftside : TIC.Column_Count; 308 begin 309 if viewable then 310 leftside := (app_width - 54) / 2; 311 else 312 leftside := (app_width - 52) / 2; 313 end if; 314 TIC.Erase (Win => viewport); 315 TIC.Set_Color (Win => viewport, Pair => c_green); 316 TIC.Move_Cursor (Win => viewport, Line => center, Column => leftside); 317 TIC.Add (Win => viewport, Str => "Deleted version found: "); 318 TIC.Add (Win => viewport, Str => ScanData.history (1).timestamp); 319 if viewable then 320 TIC.Add (Win => viewport, Str => " (viewable)"); 321 else 322 TIC.Add (Win => viewport, Str => " (binary)"); 323 end if; 324 TIC.Change_Attributes (Win => viewport, 325 Line => center, 326 Column => leftside + 23, 327 Count => 19); 328 TIC.Refresh (Win => viewport); 329 end show_version; 330 331 332 ------------------------------ 333 -- show_directory_version -- 334 ------------------------------ 335 336 procedure show_directory_version (path : in String) 337 is 338 use type TIC.Line_Position; 339 use type TIC.Column_Count; 340 center : constant TIC.Line_Position := viewheight / 2; 341 leftside : TIC.Column_Count; 342 begin 343 leftside := (app_width - 44) / 2; 344 TIC.Erase (Win => viewport); 345 TIC.Set_Color (Win => viewport, Pair => c_green); 346 TIC.Move_Cursor (Win => viewport, Line => center, Column => leftside); 347 TIC.Add (Win => viewport, Str => "Deleted directory found: "); 348 349 TIC.Set_Color (Win => viewport, Pair => c_white); 350 TIC.Add (Win => viewport, Str => DHH.modification_timestamp (path)); 351 352 TIC.Refresh (Win => viewport); 353 end show_directory_version; 354 355 356 ------------------------ 357 -- indicate_success -- 358 ------------------------ 359 360 procedure indicate_success (destination : in String) is 361 use type TIC.Line_Position; 362 use type TIC.Column_Count; 363 msg1 : constant String := "Successfully restored file to"; 364 row1 : constant TIC.Line_Position := (viewheight / 2) + 2; 365 row2 : constant TIC.Line_Position := row1 + 1; 366 leftside : TIC.Column_Count; 367 sindex : Positive; 368 begin 369 leftside := (app_width - msg1'Length) / 2; 370 TIC.Set_Character_Attributes (Win => viewport, Attr => bright, 371 Color => TIC.Color_Pair (c_yellow)); 372 TIC.Move_Cursor (Win => viewport, Line => row1, Column => leftside); 373 TIC.Add (Win => viewport, Str => msg1); 374 TIC.Set_Character_Attributes (Win => viewport, 375 Attr => TIC.Normal_Video, Color => TIC.Color_Pair (c_white)); 376 if destination'Length < app_width then 377 leftside := (app_width - destination'Length) / 2; 378 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 379 TIC.Add (Win => viewport, Str => destination); 380 else 381 leftside := 1; 382 sindex := destination'Length - (Positive (app_width) - 6); 383 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 384 TIC.Add (Win => viewport, Str => "... " & 385 destination (sindex .. destination'Last)); 386 end if; 387 TIC.Refresh (Win => viewport); 388 end indicate_success; 389 390 391 ----------------------- 392 -- confirm_save_as -- 393 ----------------------- 394 395 function confirm_save_as (destination : in String) return Boolean is 396 use type TIC.Line_Position; 397 use type TIC.Column_Count; 398 msg1 : constant String := "Please confirm this should be " & 399 "restored to"; 400 msg2 : constant String := "Destination directory does not exist " & 401 "so restore is not possible:"; 402 row1 : constant TIC.Line_Position := (viewheight / 2) - 1; 403 row2 : constant TIC.Line_Position := row1 + 1; 404 leftside : TIC.Column_Count; 405 sindex : Positive; 406 result : Boolean := False; 407 KeyCode : TIC.Real_Key_Code; 408 valid : Boolean; 409 begin 410 TIC.Erase (Win => viewport); 411 TIC.Set_Color (Win => viewport, Pair => c_yellow); 412 declare 413 dirname : constant String := DIR.Containing_Directory (destination); 414 begin 415 valid := DIR.Exists (dirname); 416 end; 417 if valid then 418 leftside := (app_width - msg1'Length) / 2; 419 TIC.Move_Cursor (Win => viewport, Line => row1, Column => leftside); 420 TIC.Add (Win => viewport, Str => msg1); 421 else 422 leftside := (app_width - msg2'Length) / 2; 423 TIC.Move_Cursor (Win => viewport, Line => row1, Column => leftside); 424 TIC.Add (Win => viewport, Str => msg2); 425 TIC.Change_Attributes (Win => comwindow, 426 Attr => bright, 427 Color => c_black, 428 Line => 0, 429 Column => 0, 430 Count => 30); 431 TIC.Refresh (Win => comwindow); 432 end if; 433 434 TIC.Set_Color (Win => viewport, Pair => c_white); 435 if destination'Length < app_width then 436 leftside := (app_width - destination'Length) / 2; 437 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 438 TIC.Add (Win => viewport, Str => destination); 439 else 440 leftside := 1; 441 sindex := destination'Length - (Positive (app_width) - 6); 442 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 443 TIC.Add (Win => viewport, Str => "... " & 444 destination (sindex .. destination'Last)); 445 end if; 446 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 447 TIC.Refresh (Win => viewport); 448 loop 449 KeyCode := TIC.Get_Keystroke (inpwindow); 450 case KeyCode is 451 when TIC.Key_F1 | Key_Num1 => 452 if valid then 453 result := True; 454 exit; 455 end if; 456 when TIC.Key_F4 | Key_Num4 => exit; 457 when others => null; 458 end case; 459 end loop; 460 return result; 461 end confirm_save_as; 462 463 464 ---------------------------- 465 -- start_command_window -- 466 ---------------------------- 467 468 procedure start_command_window (path : in String) is 469 use type TIC.Column_Count; 470 bar : String (1 .. Integer (app_width)) := (others => ' '); 471 begin 472 comwindow := TIC.Create ( 473 Number_Of_Lines => 2, 474 Number_Of_Columns => app_width + 1, 475 First_Line_Position => 0, 476 First_Column_Position => 0); 477 478 TIC.Move_Cursor (Win => comwindow, Line => 1, Column => 0); 479 TIC.Set_Character_Attributes (Win => comwindow, 480 Attr => TIC.Normal_Video, Color => TIC.Color_Pair (c_path)); 481 if path'Length > bar'Length then 482 bar := path (path'First .. bar'Length); 483 else 484 bar (bar'First .. path'Length) := path; 485 end if; 486 TIC.Add (Win => comwindow, Str => bar); 487 end start_command_window; 488 489 490 ----------------- 491 -- show_menu -- 492 ----------------- 493 494 procedure show_menu ( 495 format : menu_format; 496 scrollup : in Boolean := False; 497 scrolldown : in Boolean := False) 498 is 499 use type TIC.Column_Count; 500 space : constant TIC.Attributed_Character := (Ch => ' ', 501 Color => TIC.Color_Pair'First, 502 Attr => (others => False)); 503 blank : String (1 .. Integer (app_width)) := (others => ' '); 504 topmenu : constant Boolean := format = found_text or 505 format = found_binary; 506 begin 507 TIC.Set_Character_Attributes (Win => comwindow, Attr => bright, 508 Color => TIC.Color_Pair (c_white)); 509 510 TIC.Move_Cursor (Win => comwindow, Line => 0, Column => 0); 511 TIC.Add (Win => comwindow, Str => blank); 512 TIC.Move_Cursor (Win => comwindow, Line => 0, Column => 0); 513 514 if topmenu then 515 if format = found_text then 516 TIC.Add (Win => comwindow, Str => "F1: "); 517 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 518 TIC.Add (Win => comwindow, Str => "View contents "); 519 end if; 520 if format = found_binary then 521 TIC.Set_Color (Win => comwindow, Pair => c_black); 522 TIC.Add (Win => comwindow, Str => "F1: View contents "); 523 end if; 524 TIC.Set_Color (Win => comwindow, Pair => c_white); 525 TIC.Add (Win => comwindow, Str => "F2: "); 526 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 527 TIC.Add (Win => comwindow, Str => "Undelete "); 528 TIC.Set_Color (Win => comwindow, Pair => c_white); 529 TIC.Add (Win => comwindow, Str => "F3: "); 530 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 531 TIC.Add (Win => comwindow, Str => "Save As "); 532 end if; 533 if format = view then 534 if scrollup then 535 TIC.Add (Win => comwindow, Str => "Up Arrow: "); 536 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 537 TIC.Add (Win => comwindow, Str => "view prev page "); 538 else 539 TIC.Set_Color (Win => comwindow, Pair => c_black); 540 TIC.Add (Win => comwindow, Str => "Up Arrow: view prev page "); 541 end if; 542 if scrolldown then 543 TIC.Set_Color (Win => comwindow, Pair => c_white); 544 TIC.Add (Win => comwindow, Str => "Down Arrow: "); 545 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 546 TIC.Add (Win => comwindow, Str => "view next page "); 547 else 548 TIC.Set_Color (Win => comwindow, Pair => c_black); 549 TIC.Add (Win => comwindow, Str => "Down Arrow: view next page "); 550 end if; 551 end if; 552 if format = saveas then 553 TIC.Set_Color (Win => comwindow, Pair => c_white); 554 TIC.Add (Win => comwindow, Str => "F1: "); 555 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 556 TIC.Add (Win => comwindow, Str => "Confirm file save "); 557 end if; 558 559 TIC.Move_Cursor (Win => comwindow, Line => 0, 560 Column => app_width - 8); 561 562 TIC.Set_Color (Win => comwindow, Pair => c_white); 563 TIC.Add (Win => comwindow, Str => "F4: "); 564 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 565 if topmenu then 566 TIC.Add (Win => comwindow, Str => "Quit"); 567 else 568 TIC.Add (Win => comwindow, Str => "Back"); 569 end if; 570 TIC.Refresh (Win => comwindow); 571 end show_menu; 572 573 574 --------------------- 575 -- error_message -- 576 --------------------- 577 578 procedure error_message (message : in String) is 579 msg : String (1 .. Integer (app_width) - 1) := (others => ' '); 580 begin 581 msg (msg'First .. message'Last) := message; 582 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 583 TIC.Set_Color (Win => inpwindow, Pair => c_red); 584 TIC.Add (Win => inpwindow, Str => msg); 585 TIC.Refresh (Win => inpwindow); 586 end error_message; 587 588 589 ---------------- 590 -- recreate -- 591 ---------------- 592 593 procedure recreate (origin : in String; destination : in String; 594 success : out Boolean) is 595 begin 596 success := False; 597 DIR.Copy_File ( 598 Source_Name => origin, 599 Target_Name => destination, 600 Form => "mode=overwrite"); 601 success := True; 602 exception 603 604 when TIO.Name_Error => 605 error_message ("FAILED! The target file name is invalid"); 606 607 when TIO.Use_Error => 608 error_message ("FAILED! You do not have permission to " & 609 "create the destination file."); 610 end recreate; 611 612 613 --------------------------- 614 -- duplicate_directory -- 615 --------------------------- 616 617 procedure duplicate_directory ( 618 origin : in String; 619 destination : in String; 620 success : out Boolean) 621 is 622 RC : Integer; 623 tmpfile : constant String := "/tmp/slider-cpdup-" & 624 DIR.Simple_Name (destination); 625 arg1 : constant String := "-VV"; 626 arg2 : constant String := "-i0"; 627 Args : GOS.Argument_List := ( 628 new String'(arg1), 629 new String'(arg2), 630 new String'(origin), 631 new String'(destination)); 632 begin 633 GOS.Spawn (Program_Name => "/bin/cpdup", 634 Args => Args, 635 Output_File => tmpfile, 636 Return_Code => RC, 637 Success => success); 638 for Index in Args'Range loop 639 GOS.Free (Args (Index)); 640 end loop; 641 if RC = 0 then 642 if DIR.Exists (tmpfile) then 643 DIR.Delete_File (tmpfile); 644 end if; 645 else 646 error_message ("CPDUP FAILED! see " & tmpfile); 647 success := False; 648 end if; 649 end duplicate_directory; 650 651 652 ------------------- 653 -- browse_file -- 654 ------------------- 655 656 procedure browse_file (path : in String) is 657 File_Size : Natural := Natural (Ada.Directories.Size (path)); 658 max_pages : constant Positive := 100; 659 max_size : constant Positive := Positive (app_width) * 660 Positive (viewheight) * max_pages; 661 offsets : array (1 .. max_pages) of Positive := (others => 1); 662 truncated : Boolean := False; 663 cutmsg : constant String := ASCII.LF & "--- View Truncated ---"; 664 665 procedure start_view_mode (File_Size : in Natural; 666 truncated : in Boolean); 667 668 procedure start_view_mode (File_Size : in Natural; 669 truncated : in Boolean) 670 is 671 use type TIC.Real_Key_Code; 672 subtype File_String is String (1 .. File_Size); 673 package File_String_IO is new Ada.Direct_IO (File_String); 674 package SIO renames File_String_IO; 675 676 KeyCode : TIC.Real_Key_Code; 677 File : File_String_IO.File_Type; 678 Contents : File_String; 679 numCR : Natural := 0; 680 page : Natural := 1; 681 lastpage : Natural := 1; 682 lastseen : Natural := 0; 683 begin 684 SIO.Open (File, Mode => SIO.In_File, Name => path); 685 SIO.Read (File, Item => Contents); 686 SIO.Close (File); 687 if truncated then 688 Contents (Contents'Last - cutmsg'Last + 1 .. Contents'Last) := 689 cutmsg; 690 end if; 691 for j in 1 .. File_Size loop 692 case Contents (j) is 693 when ASCII.NUL .. ASCII.BS | ASCII.VT .. ASCII.US => null; 694 when ASCII.LF => 695 numCR := numCR + 1; 696 if numCR = Natural (viewheight) then 697 numCR := 0; 698 page := page + 1; 699 if page > max_pages then 700 exit; 701 end if; 702 if j /= File_Size then 703 offsets (page) := j + 1; 704 lastpage := page; 705 end if; 706 end if; 707 when others => null; 708 end case; 709 end loop; 710 page := 1; 711 TIC.Set_Color (Win => viewport, Pair => c_white); 712 loop 713 if page /= lastseen then 714 show_menu ( 715 format => view, 716 scrollup => page > 1, 717 scrolldown => page < lastpage); 718 declare 719 use type TIC.Line_Position; 720 subtype blankStr is String (1 .. Positive (app_width)); 721 marker : Natural := offsets (page); 722 mline : TIC.Line_Position := 0; 723 mcol : Natural := 1; 724 matrix : array (0 .. viewheight - 1) of blankStr := 725 (others => (others => ' ')); 726 begin 727 loop 728 exit when marker > File_Size; 729 case Contents (marker) is 730 when ASCII.NUL .. ASCII.BS | ASCII.VT .. ASCII.US => 731 null; 732 when ASCII.LF => 733 mline := mline + 1; 734 mcol := 1; 735 when others => 736 if mcol <= Natural (app_width) then 737 matrix (mline) (mcol) := Contents (marker); 738 mcol := mcol + 1; 739 end if; 740 end case; 741 exit when mline = viewheight; 742 marker := marker + 1; 743 end loop; 744 for j in 0 .. viewheight - 1 loop 745 TIC.Move_Cursor (Win => viewport, Line => j, Column => 0); 746 TIC.Add (Win => viewport, Str => matrix (j)); 747 end loop; 748 end; 749 show_page_count (page, lastpage); 750 TIC.Refresh (Win => viewport); 751 lastseen := page; 752 end if; 753 KeyCode := TIC.Get_Keystroke (inpwindow); 754 case KeyCode is 755 when TIC.Key_Cursor_Up => 756 if page > 1 then 757 page := page - 1; 758 end if; 759 when TIC.Key_Cursor_Down => 760 if page < lastpage then 761 page := page + 1; 762 end if; 763 when TIC.Key_F4 | Key_Num4 => exit; 764 when others => null; 765 end case; 766 end loop; 767 768 end start_view_mode; 769 770 begin 771 if File_Size > max_size then 772 File_Size := max_size; 773 truncated := True; 774 end if; 775 start_view_mode (File_Size, truncated); 776 777 end browse_file; 778 779 780 ------------------------------------ 781 -- < operator for listing_entry -- 782 ------------------------------------ 783 784 function "<" (L, R : listing_entry) return Boolean 785 is 786 begin 787 return L.filename < R.filename; 788 end "<"; 789 790 791 ---------------------------------- 792 -- retrieve_directory_listing -- 793 ---------------------------------- 794 795 function retrieve_directory_listing (directory_path : in String) 796 return listing_array 797 is 798 search : DIR.Search_Type; 799 filter : DIR.Filter_Type := (others => True); 800 data : DIR.Directory_Entry_Type; 801 total : Natural := 0; 802 begin 803 DIR.Start_Search ( 804 Search => search, 805 Directory => directory_path, 806 Pattern => "", 807 Filter => filter); 808 while DIR.More_Entries (search) loop 809 DIR.Get_Next_Entry (search, data); 810 declare 811 sname : constant String := DIR.Simple_Name (data); 812 okay : constant Boolean := not (sname = "." or sname = ".."); 813 begin 814 if okay then 815 total := total + 1; 816 end if; 817 end; 818 end loop; 819 DIR.End_Search (search); 820 821 declare 822 result : listing_array (0 .. total - 1); 823 index : Natural := 0; 824 begin 825 DIR.Start_Search ( 826 Search => search, 827 Directory => directory_path, 828 Pattern => "", 829 Filter => filter); 830 while DIR.More_Entries (search) loop 831 DIR.Get_Next_Entry (search, data); 832 declare 833 use type DIR.File_Kind; 834 fname : String (1 .. 255) := (others => ' '); 835 sname : constant String := DIR.Simple_Name (data); 836 okay : constant Boolean := not (sname = "." or sname = ".."); 837 begin 838 if okay then 839 fname (fname'First .. sname'Last) := sname; 840 result (index).filename := fname; 841 result (index).filetype := DIR.Kind (data); 842 if result (index).filetype /= DIR.Ordinary_File then 843 result (index).filesize := 0; 844 else 845 result (index).filesize := DIR.Size (data); 846 end if; 847 result (index).modtime := DHH.modification_timestamp ( 848 directory_path & "/" & sname); 849 index := index + 1; 850 end if; 851 end; 852 end loop; 853 DIR.End_Search (search); 854 Sort (result); 855 return result; 856 end; 857 end retrieve_directory_listing; 858 859 860 --------------------------- 861 -- human_readable_size -- 862 --------------------------- 863 864 function human_readable_size (filesize : DIR.File_Size) return String 865 is 866 result : String := " 0"; 867 size : constant Natural := Natural (filesize); 868 raw : constant String := size'Img; 869 kilo : constant Positive := 1024; 870 mega : constant Positive := kilo * kilo; 871 giga : constant Positive := mega * kilo; 872 begin 873 if size < 10 then 874 result (5) := raw (2); 875 elsif size < 100 then 876 result (4 .. 5) := raw (2 .. 3); 877 elsif size < 1000 then 878 result (3 .. 5) := raw (2 .. 4); 879 elsif size < 10000 then 880 result (2 .. 5) := raw (2 .. 5); 881 elsif size < 100000 then 882 result (1 .. 5) := raw (2 .. 6); 883 elsif size < mega then 884 declare 885 K : constant Positive := size / kilo; 886 K_raw : constant String := K'Img; 887 begin 888 result := " " & K_raw (2 .. 4) & "K"; 889 end; 890 elsif size < mega * 10 then 891 declare 892 M10 : constant Positive := (10 * size) / mega; 893 M10_raw : constant String := M10'Img; 894 begin 895 result := " " & M10_raw (2) & "." & M10_raw (3) & "M"; 896 end; 897 elsif size < giga then 898 declare 899 M : constant Positive := size / mega; 900 M_raw : constant String := M'Img; 901 begin 902 if size < mega * 100 then 903 result := " " & M_raw (2 .. 3) & "M"; 904 else 905 result := " " & M_raw (2 .. 4) & "M"; 906 end if; 907 end; 908 else -- assume all files < 10G 909 declare 910 G10 : constant Positive := size / (giga / 10); 911 G10_raw : constant String := G10'Img; 912 begin 913 result := " " & G10_raw (2) & "." & G10_raw (3) & "G"; 914 end; 915 end if; 916 return result; 917 end human_readable_size; 918 919 920 ------------------------ 921 -- browse_directory -- 922 ------------------------ 923 924 procedure browse_directory (directory_path : in String) 925 is 926 contents : constant listing_array := 927 retrieve_directory_listing (directory_path); 928 listsize : constant Natural := contents'Length; 929 pages : constant Positive := 930 1 + ((listsize - 1) / Positive (viewheight)); 931 page : Positive := 1; 932 933 procedure display_page (page : Positive); 934 procedure display_nothing; 935 936 procedure display_nothing 937 is 938 begin 939 TIC.Erase (viewport); 940 TIC.Set_Character_Attributes ( 941 Win => viewport, 942 Attr => TIC.Normal_Video); 943 TIC.Add (Win => viewport, 944 Str => "This directory is completely empty!"); 945 TIC.Refresh (Win => viewport); 946 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 947 end display_nothing; 948 949 procedure display_page (page : Positive) 950 is 951 use type TIC.Line_Position; 952 minindex : Natural := (page - 1) * Positive (viewheight); 953 maxindex : Natural := (page * Positive (viewheight)) - 1; 954 line : TIC.Line_Position := 0; 955 displen : constant Positive := Positive (app_width) - 23; 956 begin 957 if maxindex >= listsize then 958 maxindex := listsize - 1; 959 end if; 960 TIC.Erase (viewport); 961 for index in minindex .. maxindex loop 962 TIC.Move_Cursor (Win => viewport, Line => line, Column => 0); 963 case contents (index).filetype is 964 when DIR.Directory => 965 TIC.Set_Character_Attributes (Win => viewport, 966 Attr => bright, Color => c_cyan); 967 when DIR.Special_File => null; 968 TIC.Set_Character_Attributes (Win => viewport, 969 Attr => bright, Color => c_magenta); 970 when DIR.Ordinary_File => null; 971 TIC.Set_Character_Attributes (Win => viewport, 972 Attr => TIC.Normal_Video); 973 end case; 974 TIC.Add (Win => viewport, 975 Str => contents (index).filename (1 .. displen)); 976 TIC.Move_Cursor (Win => viewport, Line => line, 977 Column => TIC.Column_Position (displen + 1)); 978 TIC.Set_Character_Attributes (Win => viewport, 979 Attr => TIC.Normal_Video); 980 TIC.Add (Win => viewport, Str => human_readable_size ( 981 contents (index).filesize) & " "); 982 TIC.Set_Color (Win => viewport, Pair => c_yellow); 983 TIC.Add (Win => viewport, 984 Str => contents (index).modtime (1 .. 16)); 985 line := line + 1; 986 end loop; 987 TIC.Refresh (Win => viewport); 988 end display_page; 989 begin 990 declare 991 KeyCode : TIC.Real_Key_Code; 992 begin 993 loop 994 show_menu ( 995 format => view, 996 scrollup => page > 1, 997 scrolldown => page < pages 998 ); 999 if listsize > 0 then 1000 show_page_count (page, pages); 1001 display_page (page); 1002 else 1003 display_nothing; 1004 end if; 1005 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 1006 KeyCode := TIC.Get_Keystroke (inpwindow); 1007 case KeyCode is 1008 when TIC.Key_Cursor_Up => 1009 if page > 1 then 1010 page := page - 1; 1011 end if; 1012 when TIC.Key_Cursor_Down => 1013 if page < pages then 1014 page := page + 1; 1015 end if; 1016 when TIC.Key_F4 | Key_Num4 => 1017 clear_input_window; 1018 exit; 1019 when others => 1020 null; 1021 end case; 1022 end loop; 1023 end; 1024 end browse_directory; 1025 1026end Transactions.Delete; 1027