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.Directories; 22with GNAT.OS_Lib; 23 24package body Transactions.Slide is 25 26 package TIO renames Ada.Text_IO; 27 package TTS renames Ada.Text_IO.Text_Streams; 28 package DIR renames Ada.Directories; 29 package GOS renames GNAT.OS_Lib; 30 31 procedure launch_slide (path : in String; newpath : in String) 32 is 33 use type TIC.Column_Position; 34 viewable : Boolean; 35 onpage : Positive := 1; 36 begin 37 TIC.Init_Screen; 38 if not TIC.Has_Colors then 39 TIC.End_Windows; 40 TIO.Put_Line (msg_mono1); 41 TIO.Put_Line (msg_mono2); 42 return; 43 end if; 44 TIC.Set_Echo_Mode (False); 45 TIC.Set_Raw_Mode (True); 46 TIC.Set_Cbreak_Mode (True); 47 if TIC.Columns > app_width then 48 app_width := TIC.Columns; 49 end if; 50 TIC.Start_Color; 51 TIC.Init_Pair (TIC.Color_Pair (1), TIC.Cyan, TIC.Black); 52 TIC.Init_Pair (TIC.Color_Pair (2), TIC.White, TIC.Black); 53 TIC.Init_Pair (TIC.Color_Pair (3), TIC.Black, TIC.Black); 54 TIC.Init_Pair (TIC.Color_Pair (4), TIC.Black, TIC.White); 55 TIC.Init_Pair (TIC.Color_Pair (5), TIC.Green, TIC.Black); 56 TIC.Init_Pair (TIC.Color_Pair (6), TIC.Red, TIC.Black); 57 TIC.Init_Pair (TIC.Color_Pair (7), TIC.Yellow, TIC.Black); 58 TIC.Init_Pair (TIC.Color_Pair (8), TIC.White, TIC.Blue); 59 c_cyan := TIC.Color_Pair (1); 60 c_white := TIC.Color_Pair (2); 61 c_black := TIC.Color_Pair (3); 62 c_path := TIC.Color_Pair (4); 63 c_green := TIC.Color_Pair (5); 64 c_red := TIC.Color_Pair (6); 65 c_yellow := TIC.Color_Pair (7); 66 c_cursor := TIC.Color_Pair (8); 67 68 start_command_window (path); 69 start_view_window; 70 start_input_window; 71 TIC.Set_KeyPad_Mode (Win => inpwindow, SwitchOn => True); 72 73 declare 74 KeyCode : TIC.Real_Key_Code; 75 maxhist : constant Positive := Positive (ScanData.history.Length); 76 zero : constant TIC.Key_Code := Character'Pos ('0'); 77 fdiff : constant TIC.Key_Code := Character'Pos ('>'); 78 rdiff : constant TIC.Key_Code := Character'Pos ('<'); 79 block : constant Positive := Positive (viewheight) - 1; 80 origin : String := path & ScanData.history (maxhist).trax_id; 81 mformat : menu_format; 82 begin 83 ScanData.diff_old := maxhist; 84 ScanData.diff_new := maxhist - 1; 85 viewable := textfile (origin); 86 mformat := set_menu_format (viewable); 87 show_menu (format => mformat); 88 pick_version (viewable); 89 loop 90 KeyCode := TIC.Get_Keystroke (inpwindow); 91 case KeyCode is 92 when TIC.Key_Cursor_Up => 93 -- history is stored oldest to newests, so reverse logic 94 if ScanData.diff_new < maxhist then 95 ScanData.diff_new := ScanData.diff_new + 1; 96 else 97 ScanData.diff_new := 1; 98 end if; 99 show_menu (format => mformat); 100 pick_version (viewable); 101 when TIC.Key_Cursor_Down => 102 -- history is stored oldest to newests, so reverse logic 103 if ScanData.diff_new > 1 then 104 ScanData.diff_new := ScanData.diff_new - 1; 105 else 106 ScanData.diff_new := maxhist; 107 end if; 108 show_menu (format => mformat); 109 pick_version (viewable); 110 when TIC.Key_Cursor_Left => 111 -- history is stored oldest to newests, so reverse logic 112 if ScanData.diff_new <= maxhist - block then 113 ScanData.diff_new := ScanData.diff_new + block; 114 show_menu (format => mformat); 115 pick_version (viewable); 116 end if; 117 when TIC.Key_Cursor_Right => 118 -- history is stored oldest to newests, so reverse logic 119 if ScanData.diff_new > block then 120 ScanData.diff_new := ScanData.diff_new - block; 121 show_menu (format => mformat); 122 pick_version (viewable); 123 end if; 124 when zero => 125 if ScanData.diff_old /= ScanData.diff_new then 126 ScanData.diff_old := ScanData.diff_new; 127 origin := path & 128 ScanData.history (ScanData.diff_old).trax_id; 129 viewable := textfile (origin); 130 mformat := set_menu_format (viewable); 131 show_menu (format => mformat); 132 pick_version (viewable); 133 end if; 134 when fdiff => 135 if viewable and ScanData.diff_old /= ScanData.diff_new then 136 view_diff (path, ScanData.diff_old, ScanData.diff_new); 137 show_menu (format => mformat); 138 pick_version (viewable); 139 clear_input_window; 140 end if; 141 when rdiff => 142 if viewable and ScanData.diff_old /= ScanData.diff_new then 143 view_diff (path, ScanData.diff_new, ScanData.diff_old); 144 show_menu (format => mformat); 145 pick_version (viewable); 146 clear_input_window; 147 end if; 148 when TIC.Key_F1 | Key_Num1 => 149 if viewable then 150 declare 151 seepath : constant String := path & ScanData.history 152 (ScanData.diff_new).trax_id; 153 stamp : constant DHH.TraxTime := ScanData.history 154 (ScanData.diff_new).timestamp; 155 begin 156 browse_file (path => seepath, timestamp => stamp); 157 end; 158 show_menu (format => mformat); 159 pick_version (viewable); 160 clear_input_window; 161 end if; 162 when TIC.Key_F2 | Key_Num2 => 163 if ScanData.diff_old /= ScanData.diff_new then 164 show_menu (format => saveas); 165 declare 166 confirmed : Boolean; 167 success : Boolean; 168 seepath : constant String := path & ScanData.history 169 (ScanData.diff_new).trax_id; 170 begin 171 confirmed := confirm_save_as (path); 172 if confirmed then 173 recreate (seepath, path, success); 174 if success then 175 indicate_success (path); 176 clear_input_window; 177 exit; 178 end if; 179 end if; 180 show_menu (format => mformat); 181 pick_version (viewable); 182 clear_input_window; 183 end; 184 end if; 185 when TIC.Key_F3 | Key_Num3 => 186 show_menu (format => saveas); 187 declare 188 confirmed : Boolean; 189 success : Boolean; 190 seepath : constant String := path & ScanData.history 191 (ScanData.diff_new).trax_id; 192 begin 193 confirmed := confirm_save_as (newpath); 194 if confirmed then 195 recreate (seepath, newpath, success); 196 if success then 197 indicate_success (newpath); 198 clear_input_window; 199 exit; 200 end if; 201 end if; 202 show_menu (format => mformat); 203 pick_version (viewable); 204 clear_input_window; 205 end; 206 207 when TIC.Key_F4 | Key_Num4 => 208 exit; 209 when others => 210 null; 211 end case; 212 end loop; 213 end; 214 TIC.Delete (inpwindow); 215 TIC.Delete (viewport); 216 TIC.Delete (comwindow); 217 TIC.End_Windows; 218 219 end launch_slide; 220 221 222 -------------------------- 223 -- start_input_window -- 224 -------------------------- 225 226 procedure start_input_window is 227 use type TIC.Line_Position; 228 use type TIC.Column_Count; 229 begin 230 inpwindow := TIC.Create ( 231 Number_Of_Lines => 1, 232 Number_Of_Columns => app_width + 1, 233 First_Line_Position => viewheight + 3, 234 First_Column_Position => 0); 235 TIC.Set_Character_Attributes (Win => inpwindow, Attr => bright); 236 end start_input_window; 237 238 239 ----------------------- 240 -- show_page_count -- 241 ----------------------- 242 243 procedure show_page_count ( 244 page : in Positive; 245 total_pages : in Positive; 246 timestamp : in DHH.TraxTime) 247 is 248 use type TIC.Column_Count; 249 len : constant Positive := Positive (app_width); 250 whole_line : String (1 .. len) := (others => ' '); 251 info : constant String := "page" & page'Img & " of" & total_pages'Img; 252 leftside : constant Positive := len - info'Length + 1; 253 begin 254 whole_line (3 .. DHH.TraxTime'Length + 2) := timestamp; 255 whole_line (leftside .. whole_line'Last) := info; 256 TIC.Set_Color (Win => inpwindow, Pair => c_yellow); 257 TIC.Add (Win => inpwindow, 258 Line => 0, 259 Column => 0, 260 Str => whole_line); 261 TIC.Refresh (Win => inpwindow); 262 end show_page_count; 263 264 265 -------------------------- 266 -- clear_input_window -- 267 -------------------------- 268 269 procedure clear_input_window is 270 blank_line : String (1 .. Natural (app_width)) := (others => ' '); 271 begin 272 TIC.Erase (Win => inpwindow); 273 TIC.Refresh (Win => inpwindow); 274 end clear_input_window; 275 276 277 ---------------------------- 278 -- start_command_window -- 279 ---------------------------- 280 281 procedure start_command_window (path : in String) is 282 use type TIC.Column_Count; 283 bar : String (1 .. Integer (app_width)) := (others => ' '); 284 begin 285 comwindow := TIC.Create ( 286 Number_Of_Lines => 3, 287 Number_Of_Columns => app_width + 1, 288 First_Line_Position => 0, 289 First_Column_Position => 0); 290 291 TIC.Move_Cursor (Win => comwindow, Line => 2, Column => 0); 292 TIC.Set_Character_Attributes (Win => comwindow, 293 Attr => TIC.Normal_Video, Color => TIC.Color_Pair (c_path)); 294 if path'Length < bar'Length then 295 bar (bar'First .. path'Length) := path; 296 else 297 declare 298 sindex : constant Positive := 299 path'Length - Integer (app_width) - 6; 300 begin 301 bar (bar'First + 1 .. bar'Last - 1) := "... " & 302 path (sindex .. path'Last); 303 end; 304 end if; 305 TIC.Add (Win => comwindow, Str => bar); 306 end start_command_window; 307 308 309 ------------------------- 310 -- start_view_window -- 311 ------------------------- 312 313 procedure start_view_window is 314 use type TIC.Line_Position; 315 use type TIC.Column_Count; 316 begin 317 viewheight := TIC.Lines - 4; 318 if viewheight < 7 then 319 viewheight := 7; 320 end if; 321 viewport := TIC.Create ( 322 Number_Of_Lines => viewheight, 323 Number_Of_Columns => app_width + 1, 324 First_Line_Position => 3, 325 First_Column_Position => 0); 326 end start_view_window; 327 328 329 ----------------- 330 -- show_menu -- 331 ----------------- 332 333 procedure show_menu ( 334 format : menu_format; 335 scrollup : in Boolean := False; 336 scrolldown : in Boolean := False) 337 is 338 use type TIC.Column_Position; 339 blank : String (1 .. Integer (app_width)) := (others => ' '); 340 topmenu : constant Boolean := format = found_text or 341 format = found_binary; 342 samefile : constant Boolean := ScanData.diff_old = ScanData.diff_new; 343 begin 344 TIC.Set_Character_Attributes (Win => comwindow, 345 Color => c_white, 346 Attr => bright); 347 TIC.Move_Cursor (Win => comwindow, Line => 0, Column => 0); 348 TIC.Add (Win => comwindow, Str => blank); 349 TIC.Move_Cursor (Win => comwindow, Line => 1, Column => 0); 350 TIC.Add (Win => comwindow, Str => blank); 351 TIC.Move_Cursor (Win => comwindow, Line => 0, Column => 0); 352 if topmenu then 353 TIC.Set_Color (Win => comwindow, Pair => c_white); 354 TIC.Add (Win => comwindow, Str => "Arrows: "); 355 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 356 TIC.Add (Win => comwindow, Str => "move "); 357 if format = found_text then 358 TIC.Set_Color (Win => comwindow, Pair => c_white); 359 TIC.Add (Win => comwindow, Str => "F1: "); 360 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 361 TIC.Add (Win => comwindow, Str => "View contents "); 362 end if; 363 if format = found_binary then 364 TIC.Set_Color (Win => comwindow, Pair => c_black); 365 TIC.Add (Win => comwindow, Str => "F1: View contents "); 366 end if; 367 if samefile then 368 TIC.Set_Color (Win => comwindow, Pair => c_black); 369 TIC.Add (Win => comwindow, Str => "F2: Replace "); 370 else 371 TIC.Set_Color (Win => comwindow, Pair => c_white); 372 TIC.Add (Win => comwindow, Str => "F2: "); 373 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 374 TIC.Add (Win => comwindow, Str => "Replace "); 375 end if; 376 TIC.Set_Color (Win => comwindow, Pair => c_white); 377 TIC.Add (Win => comwindow, Str => "F3: "); 378 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 379 TIC.Add (Win => comwindow, Str => "Save As "); 380 end if; 381 if format = view then 382 if scrollup then 383 TIC.Add (Win => comwindow, Str => "Up Arrow: "); 384 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 385 TIC.Add (Win => comwindow, Str => "view prev page "); 386 else 387 TIC.Set_Color (Win => comwindow, Pair => c_black); 388 TIC.Add (Win => comwindow, Str => "Up Arrow: view prev page "); 389 end if; 390 if scrolldown then 391 TIC.Set_Color (Win => comwindow, Pair => c_white); 392 TIC.Add (Win => comwindow, Str => "Down Arrow: "); 393 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 394 TIC.Add (Win => comwindow, Str => "view next page "); 395 else 396 TIC.Set_Color (Win => comwindow, Pair => c_black); 397 TIC.Add (Win => comwindow, Str => "Down Arrow: view next page "); 398 end if; 399 end if; 400 if format = saveas then 401 TIC.Set_Color (Win => comwindow, Pair => c_white); 402 TIC.Add (Win => comwindow, Str => "F1: "); 403 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 404 TIC.Add (Win => comwindow, Str => "Confirm file save "); 405 end if; 406 TIC.Move_Cursor (Win => comwindow, Line => 0, 407 Column => app_width - 8); 408 409 TIC.Set_Color (Win => comwindow, Pair => c_white); 410 TIC.Add (Win => comwindow, Str => "F4: "); 411 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 412 if topmenu then 413 TIC.Add (Win => comwindow, Str => "Quit"); 414 else 415 TIC.Add (Win => comwindow, Str => "Back"); 416 end if; 417 if topmenu then 418 TIC.Move_Cursor (Win => comwindow, Line => 1, Column => 0); 419 if samefile then 420 TIC.Set_Color (Win => comwindow, Pair => c_black); 421 TIC.Add (Win => comwindow, Str => "0: mark origin "); 422 else 423 TIC.Set_Color (Win => comwindow, Pair => c_white); 424 TIC.Add (Win => comwindow, Str => "0: "); 425 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 426 TIC.Add (Win => comwindow, Str => "mark origin "); 427 end if; 428 if not samefile and format = found_text then 429 TIC.Set_Color (Win => comwindow, Pair => c_white); 430 TIC.Add (Win => comwindow, Str => "<: "); 431 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 432 TIC.Add (Win => comwindow, Str => "view reverse diff "); 433 TIC.Set_Color (Win => comwindow, Pair => c_white); 434 TIC.Add (Win => comwindow, Str => ">: "); 435 TIC.Set_Color (Win => comwindow, Pair => c_cyan); 436 TIC.Add (Win => comwindow, Str => "view diff from origin"); 437 end if; 438 if samefile or format = found_binary then 439 TIC.Set_Color (Win => comwindow, Pair => c_black); 440 TIC.Add (Win => comwindow, Str => 441 "<: view reverse diff >: view diff from origin"); 442 end if; 443 end if; 444 TIC.Refresh (Win => comwindow); 445 446 end show_menu; 447 448 449 -------------------- 450 -- number_label -- 451 -------------------- 452 453 function number_label (nindex : in Natural) return String is 454 Raw_Image : constant String := Integer'Image (nindex); 455 result : String := " 000) "; 456 begin 457 if nindex < 1000 then 458 if nindex < 10 then 459 result (4) := Raw_Image (2); 460 elsif nindex < 100 then 461 result (3 .. 4) := Raw_Image (2 .. 3); 462 else 463 result (2 .. 4) := Raw_Image (2 .. 4); 464 end if; 465 end if; 466 return result; 467 end number_label; 468 469 470 ---------------- 471 -- location -- 472 ---------------- 473 474 procedure location (nindex : in Natural; ncolumn : out Natural; 475 nrow : out Natural; max_columns : in Positive; total : in Positive) 476 is 477 rowoffset : constant Natural := 1; 478 height : constant Positive := Positive (viewheight) - rowoffset; 479 pagesize : constant Positive := max_columns * height; 480 modpage : Natural; 481 page : Natural; 482 usedcols : Positive; 483 coloffset : Positive; 484 begin 485 modpage := nindex mod pagesize; 486 page := (nindex / pagesize) + 1; 487 declare 488 tpages : constant Positive := ((total - 1) / pagesize) + 1; 489 lpage : constant Natural := ((total - 1) mod pagesize); 490 begin 491 if page < tpages then 492 usedcols := max_columns; 493 else 494 usedcols := (lpage / height) + 1; 495 end if; 496 end; 497 498 coloffset := (Positive (app_width) - (26 * usedcols)) / 2; 499 ncolumn := coloffset + ((modpage / height) * 26); 500 nrow := (modpage mod height) + rowoffset; 501 end location; 502 503 -------------------- 504 -- pick_version -- 505 -------------------- 506 507 procedure pick_version (viewable : in Boolean) 508 is 509 maxCol : Positive := 1; 510 maxhist : constant Positive := Positive (ScanData.history.Length); 511 ncolumn : array (1 .. maxhist) of Natural; 512 nrow : array (1 .. maxhist) of Natural; 513 onpage : Positive; 514 perPage : Positive; 515 516 procedure list_page (page : in Positive); 517 518 procedure list_page (page : in Positive) is 519 head : Positive := ((page - 1) * perPage) + 1; 520 tail : Positive := (page * perPage); 521 n : Positive; 522 begin 523 if tail > maxhist then 524 tail := maxhist; 525 end if; 526 for nn in head .. tail loop 527 n := maxhist + 1 - nn; 528 TIC.Move_Cursor (Win => viewport, 529 Line => TIC.Line_Position (nrow (n)), 530 Column => TIC.Column_Position (ncolumn (n))); 531 if ScanData.diff_old = n then 532 TIC.Set_Character_Attributes (Win => viewport, Attr => bright); 533 else 534 TIC.Set_Character_Attributes (Win => viewport, 535 Attr => TIC.Normal_Video); 536 end if; 537 TIC.Set_Color (Win => viewport, Pair => c_yellow); 538 TIC.Add (Win => viewport, Str => number_label (nn - 1)); 539 if ScanData.diff_new = n then 540 TIC.Set_Color (Win => viewport, Pair => c_cursor); 541 else 542 TIC.Set_Color (Win => viewport, Pair => c_white); 543 end if; 544 TIC.Add (Win => viewport, Str => ScanData.history (n).timestamp); 545 end loop; 546 end list_page; 547 548 begin 549 maxCol := Positive (app_width) / 26; 550 perPage := maxCol * (Positive (viewheight) - 1); 551 onpage := ((maxhist - ScanData.diff_new) / perPage) + 1; 552 553 for j in 1 .. maxhist loop 554 location (nindex => maxhist - j, nrow => nrow (j), 555 ncolumn => ncolumn (j), max_columns => maxCol, total => maxhist); 556 end loop; 557 558 TIC.Erase (Win => viewport); 559 list_page (onpage); 560 TIC.Refresh (Win => viewport); 561 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 562 563 end pick_version; 564 565 566 ----------------------- 567 -- set_menu_format -- 568 ----------------------- 569 570 function set_menu_format (viewable : Boolean) return menu_format is 571 result : menu_format := found_binary; 572 begin 573 if viewable then 574 result := found_text; 575 end if; 576 return result; 577 end set_menu_format; 578 579 580 ------------------- 581 -- browse_file -- 582 ------------------- 583 584 procedure browse_file (path : in String; 585 timestamp : in DHH.TraxTime := (others => ' '); 586 differential : in Boolean := False) 587 is 588 File_Size : Natural := Natural (Ada.Directories.Size (path)); 589 max_pages : constant Positive := 100; 590 max_size : constant Positive := Positive (app_width) * 591 Positive (viewheight) * max_pages; 592 offsets : array (1 .. max_pages) of Positive := (others => 1); 593 truncated : Boolean := False; 594 cutmsg : constant String := ASCII.LF & "--- View Truncated ---"; 595 596 procedure start_view_mode (File_Size : in Natural; 597 truncated : in Boolean); 598 599 procedure start_view_mode (File_Size : in Natural; 600 truncated : in Boolean) 601 is 602 use type TIC.Real_Key_Code; 603 subtype File_String is String (1 .. File_Size); 604 package File_String_IO is new Ada.Direct_IO (File_String); 605 package SIO renames File_String_IO; 606 607 KeyCode : TIC.Real_Key_Code; 608 File : File_String_IO.File_Type; 609 Contents : File_String; 610 numCR : Natural := 0; 611 page : Natural := 1; 612 lastpage : Natural := 1; 613 lastseen : Natural := 0; 614 begin 615 SIO.Open (File, Mode => SIO.In_File, Name => path); 616 SIO.Read (File, Item => Contents); 617 SIO.Close (File); 618 if truncated then 619 Contents (Contents'Last - cutmsg'Last + 1 .. Contents'Last) := 620 cutmsg; 621 end if; 622 for j in 1 .. File_Size loop 623 case Contents (j) is 624 when ASCII.NUL .. ASCII.BS | ASCII.VT .. ASCII.US => null; 625 when ASCII.LF => 626 numCR := numCR + 1; 627 if numCR = Natural (viewheight) then 628 numCR := 0; 629 page := page + 1; 630 if page > max_pages then 631 exit; 632 end if; 633 if j /= File_Size then 634 offsets (page) := j + 1; 635 lastpage := page; 636 end if; 637 end if; 638 when others => null; 639 end case; 640 end loop; 641 page := 1; 642 TIC.Set_Color (Win => viewport, Pair => c_white); 643 loop 644 if page /= lastseen then 645 show_menu ( 646 format => view, 647 scrollup => page > 1, 648 scrolldown => page < lastpage); 649 declare 650 use type TIC.Line_Position; 651 subtype blankStr is String (1 .. Positive (app_width)); 652 marker : Natural := offsets (page); 653 mline : TIC.Line_Position := 0; 654 mcol : Natural := 1; 655 matrix : array (0 .. viewheight - 1) of blankStr := 656 (others => (others => ' ')); 657 begin 658 loop 659 exit when marker > File_Size; 660 case Contents (marker) is 661 when ASCII.NUL .. ASCII.BS | ASCII.VT .. ASCII.US => 662 null; 663 when ASCII.LF => 664 mline := mline + 1; 665 mcol := 1; 666 when others => 667 if mcol <= Natural (app_width) then 668 matrix (mline) (mcol) := Contents (marker); 669 mcol := mcol + 1; 670 end if; 671 end case; 672 exit when mline = viewheight; 673 marker := marker + 1; 674 end loop; 675 for j in 0 .. viewheight - 2 loop 676 TIC.Move_Cursor (Win => viewport, Line => j, Column => 0); 677 TIC.Add (Win => viewport, Str => matrix (j)); 678 end loop; 679 declare 680 use type TIC.Line_Position; 681 use type TIC.Column_Position; 682 lastline : TIC.Line_Position := viewheight - 1; 683 begin 684 for x in 1 .. app_width loop 685 TIC.Add (Win => viewport, 686 Line => lastline, 687 Column => x - 1, 688 Ch => matrix (lastline)(Positive (x))); 689 end loop; 690 end; 691 end; 692 693 if differential then 694 declare 695 use type TIC.Line_Position; 696 FirstLine : TIC.Line_Position := 0; 697 peekchar : TIC.Attributed_Character; 698 len : Integer := Integer (app_width); 699 begin 700 if page = 1 then 701 for line in TIC.Line_Position range 0 .. 1 loop 702 TIC.Change_Attributes (Win => viewport, 703 Attr => bright, Color => c_white, Line => line, 704 Column => 0, Count => len); 705 end loop; 706 FirstLine := 2; 707 end if; 708 for line in FirstLine .. viewheight - 1 loop 709 peekchar := TIC.Peek (Win => viewport, 710 Line => line, Column => 0); 711 if peekchar.Ch = '+' then 712 TIC.Change_Attributes (Win => viewport, 713 Attr => TIC.Normal_Video, Color => c_green, 714 Line => line, Column => 0, Count => len); 715 elsif peekchar.Ch = '-' then 716 TIC.Change_Attributes (Win => viewport, 717 Attr => TIC.Normal_Video, Color => c_red, 718 Line => line, Column => 0, Count => len); 719 end if; 720 end loop; 721 end; 722 end if; 723 724 TIC.Refresh (Win => viewport); 725 show_page_count (page, lastpage, timestamp); 726 lastseen := page; 727 end if; 728 KeyCode := TIC.Get_Keystroke (inpwindow); 729 case KeyCode is 730 when TIC.Key_Cursor_Up => 731 if page > 1 then 732 page := page - 1; 733 end if; 734 when TIC.Key_Cursor_Down => 735 if page < lastpage then 736 page := page + 1; 737 end if; 738 when TIC.Key_F4 | Key_Num4 => exit; 739 when others => null; 740 end case; 741 end loop; 742 743 end start_view_mode; 744 745 begin 746 if File_Size > max_size then 747 File_Size := max_size; 748 truncated := True; 749 end if; 750 start_view_mode (File_Size, truncated); 751 752 end browse_file; 753 754 755 ------------------------------ 756 -- indicate_no_difference -- 757 ------------------------------ 758 759 procedure indicate_no_difference (temporary_file : in String; 760 older_version, newer_version : in String) 761 is 762 tmpfile : TIO.File_Type; 763 begin 764 TIO.Open (File => tmpfile, 765 Mode => TIO.Append_File, 766 Name => temporary_file); 767 TIO.Put_Line (tmpfile, "--- " & older_version); 768 TIO.Put_Line (tmpfile, "+++ " & newer_version); 769 TIO.New_Line (tmpfile); 770 TIO.Put_Line (tmpfile, " There is no difference between these " & 771 "two versions of the file."); 772 TIO.Close (tmpfile); 773 exception 774 when TIO.End_Error => 775 if TIO.Is_Open (tmpfile) then 776 TIO.Close (tmpfile); 777 end if; 778 end indicate_no_difference; 779 780 781 ----------------- 782 -- view_diff -- 783 ----------------- 784 785 procedure view_diff (path : in String; orig, dest : in Positive) is 786 RC : Integer; 787 arg1 : constant String := "-upa"; 788 arg2 : constant String := path & ScanData.history (orig).trax_id; 789 arg3 : constant String := path & ScanData.history (dest).trax_id; 790 Args : GOS.Argument_List := ( 791 new String'(arg1), 792 new String'(arg2), 793 new String'(arg3)); 794 tmpfile : constant String := "/tmp/slider-" & 795 ScanData.history (orig).trax_id & "-" & 796 ScanData.history (dest).trax_id; 797 success : Boolean; 798 begin 799 GOS.Spawn (Program_Name => "/usr/bin/diff", 800 Args => Args, 801 Output_File => tmpfile, 802 Return_Code => RC, 803 Success => success); 804 for Index in Args'Range loop 805 GOS.Free (Args (Index)); 806 end loop; 807 if success then 808 declare 809 File_Size : Natural := Natural (Ada.Directories.Size (tmpfile)); 810 begin 811 if File_Size = 0 then 812 indicate_no_difference (temporary_file => tmpfile, 813 older_version => arg2, newer_version => arg3); 814 end if; 815 end; 816 817 browse_file (path => tmpfile, differential => True); 818 end if; 819 if DIR.Exists (tmpfile) then 820 DIR.Delete_File (tmpfile); 821 end if; 822 end view_diff; 823 824 825 ----------------------- 826 -- confirm_save_as -- 827 ----------------------- 828 829 function confirm_save_as (destination : in String) return Boolean is 830 use type TIC.Line_Position; 831 use type TIC.Column_Count; 832 msg1 : constant String := "Please confirm file should be " & 833 "restored to"; 834 msg2 : constant String := "Destination directory does not exist " & 835 "so restore is not possible:"; 836 row1 : constant TIC.Line_Position := (viewheight / 2) - 1; 837 row2 : constant TIC.Line_Position := row1 + 1; 838 leftside : TIC.Column_Count; 839 sindex : Positive; 840 result : Boolean := False; 841 KeyCode : TIC.Real_Key_Code; 842 valid : Boolean; 843 begin 844 TIC.Erase (Win => viewport); 845 TIC.Set_Character_Attributes (Win => viewport, 846 Color => c_yellow, 847 Attr => bright); 848 declare 849 dirname : constant String := DIR.Containing_Directory (destination); 850 begin 851 valid := DIR.Exists (dirname); 852 end; 853 if valid then 854 leftside := (app_width - msg1'Length) / 2; 855 TIC.Move_Cursor (Win => viewport, Line => row1, Column => leftside); 856 TIC.Add (Win => viewport, Str => msg1); 857 else 858 leftside := (app_width - msg2'Length) / 2; 859 TIC.Move_Cursor (Win => viewport, Line => row1, Column => leftside); 860 TIC.Add (Win => viewport, Str => msg2); 861 TIC.Change_Attributes (Win => comwindow, 862 Attr => bright, 863 Color => c_black, 864 Line => 0, 865 Column => 0, 866 Count => 30); 867 TIC.Refresh (Win => comwindow); 868 end if; 869 870 TIC.Set_Character_Attributes (Win => viewport, 871 Color => c_white, 872 Attr => TIC.Normal_Video); 873 if destination'Length < app_width then 874 leftside := (app_width - destination'Length) / 2; 875 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 876 TIC.Add (Win => viewport, Str => destination); 877 else 878 leftside := 1; 879 sindex := destination'Length - (Positive (app_width) - 6); 880 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 881 TIC.Add (Win => viewport, Str => "... " & 882 destination (sindex .. destination'Last)); 883 end if; 884 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 885 TIC.Refresh (Win => viewport); 886 loop 887 KeyCode := TIC.Get_Keystroke (inpwindow); 888 case KeyCode is 889 when TIC.Key_F1 | Key_Num1 => 890 if valid then 891 result := True; 892 exit; 893 end if; 894 when TIC.Key_F4 | Key_Num4 => exit; 895 when others => null; 896 end case; 897 end loop; 898 return result; 899 end confirm_save_as; 900 901 902 ---------------- 903 -- recreate -- 904 ---------------- 905 906 procedure recreate (origin : in String; destination : in String; 907 success : out Boolean) is 908 909 procedure error_message (message : in String); 910 911 procedure error_message (message : in String) is 912 msg : String (1 .. Integer (app_width) - 1) := (others => ' '); 913 begin 914 msg (msg'First .. message'Last) := message; 915 TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0); 916 TIC.Set_Color (Win => inpwindow, Pair => c_red); 917 TIC.Add (Win => inpwindow, Str => msg); 918 TIC.Refresh (Win => inpwindow); 919 end error_message; 920 921 begin 922 success := False; 923 DIR.Copy_File ( 924 Source_Name => origin, 925 Target_Name => destination, 926 Form => "mode=overwrite"); 927 success := True; 928 exception 929 930 when TIO.Name_Error => 931 error_message ("FAILED! The target file name is invalid"); 932 933 when TIO.Use_Error => 934 error_message ("FAILED! You do not have permission to " & 935 "create the destination file."); 936 end recreate; 937 938 939 ------------------------ 940 -- indicate_success -- 941 ------------------------ 942 943 procedure indicate_success (destination : in String) is 944 use type TIC.Line_Position; 945 use type TIC.Column_Count; 946 msg1 : constant String := "Successfully restored file to"; 947 row1 : constant TIC.Line_Position := (viewheight / 2) - 1; 948 row2 : constant TIC.Line_Position := row1 + 1; 949 leftside : TIC.Column_Count; 950 sindex : Positive; 951 begin 952 TIC.Erase (viewport); 953 leftside := (app_width - msg1'Length) / 2; 954 TIC.Set_Character_Attributes (Win => viewport, Attr => bright, 955 Color => TIC.Color_Pair (c_yellow)); 956 TIC.Move_Cursor (Win => viewport, Line => row1, Column => leftside); 957 TIC.Add (Win => viewport, Str => msg1); 958 TIC.Set_Character_Attributes (Win => viewport, 959 Attr => TIC.Normal_Video, Color => TIC.Color_Pair (c_white)); 960 if destination'Length < app_width then 961 leftside := (app_width - destination'Length) / 2; 962 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 963 TIC.Add (Win => viewport, Str => destination); 964 else 965 leftside := 1; 966 sindex := destination'Length - (Positive (app_width) - 6); 967 TIC.Move_Cursor (Win => viewport, Line => row2, Column => leftside); 968 TIC.Add (Win => viewport, Str => "... " & 969 destination (sindex .. destination'Last)); 970 end if; 971 TIC.Refresh (Win => viewport); 972 end indicate_success; 973 974end Transactions.Slide; 975