aboutsummaryrefslogtreecommitdiffstats
path: root/test/indent
diff options
context:
space:
mode:
authorStefan Monnier2012-03-25 16:37:21 -0400
committerStefan Monnier2012-03-25 16:37:21 -0400
commit699c782b7668c44d0fa4446331b0590a6d5dac82 (patch)
tree5dcce364741d0761920a3d274b0fc8aba4103d45 /test/indent
parent98fb480ee31bf74cf554044f60f21df16566dd7f (diff)
parente99a9b8bdccadded1f6fae88ee7a2a93dfd4eacf (diff)
downloademacs-pending.tar.gz
emacs-pending.zip
Merge from trunkpending
Diffstat (limited to 'test/indent')
-rw-r--r--test/indent/octave.m168
-rw-r--r--test/indent/pascal.pas1088
-rw-r--r--test/indent/prolog.prolog2
3 files changed, 1173 insertions, 85 deletions
diff --git a/test/indent/octave.m b/test/indent/octave.m
index 768f3d85e01..4c2fa6c8435 100644
--- a/test/indent/octave.m
+++ b/test/indent/octave.m
@@ -3,7 +3,7 @@
3function res = tcomp (fn) 3function res = tcomp (fn)
4 %% res = tcomp (fn) 4 %% res = tcomp (fn)
5 %% imports components and rearranges them. 5 %% imports components and rearranges them.
6 6
7 if nargin ~= 1 7 if nargin ~= 1
8 print_usage() 8 print_usage()
9 end 9 end
@@ -19,7 +19,7 @@ function res = tcomp (fn)
19 pop = x(:,1:10)(:); 19 pop = x(:,1:10)(:);
20 ## Here and below, we test if the indentation aligns with a previous 20 ## Here and below, we test if the indentation aligns with a previous
21 ## fixindented line. This is important so as to make it easier for the 21 ## fixindented line. This is important so as to make it easier for the
22 ## user to verride some indentation somewhere, and also because it 22 ## user to override some indentation somewhere, and also because it
23 ## reflects the fact that the indentation decision is taken with a minimum 23 ## reflects the fact that the indentation decision is taken with a minimum
24 ## amount of work (i.e. in the present case, without having to walk back 24 ## amount of work (i.e. in the present case, without having to walk back
25 ## until the `function' line). 25 ## until the `function' line).
@@ -36,7 +36,7 @@ function res = tcomp (fn)
36endfunction 36endfunction
37 37
38## Copyright (C) 2005, 2006, 2007, 2008, 2009 S�ren Hauberg 38## Copyright (C) 2005, 2006, 2007, 2008, 2009 S�ren Hauberg
39## 39##
40## This file is part of Octave. 40## This file is part of Octave.
41## 41##
42## Octave is free software; you can redistribute it and/or modify it 42## Octave is free software; you can redistribute it and/or modify it
@@ -73,16 +73,16 @@ endfunction
73## 73##
74## @table @code 74## @table @code
75## @item -nodeps 75## @item -nodeps
76## The package manager will disable the dependency checking. That way it 76## The package manager will disable the dependency checking. That way it
77## is possible to install a package even if it depends on another package 77## is possible to install a package even if it depends on another package
78## that's not installed on the system. @strong{Use this option with care.} 78## that's not installed on the system. @strong{Use this option with care.}
79## 79##
80## @item -noauto 80## @item -noauto
81## The package manager will not automatically load the installed package 81## The package manager will not automatically load the installed package
82## when starting Octave, even if the package requests that it is. 82## when starting Octave, even if the package requests that it is.
83## 83##
84## @item -auto 84## @item -auto
85## The package manager will automatically load the installed package when 85## The package manager will automatically load the installed package when
86## starting Octave, even if the package requests that it isn't. 86## starting Octave, even if the package requests that it isn't.
87## 87##
88## @item -local 88## @item -local
@@ -93,7 +93,7 @@ endfunction
93## system privileges 93## system privileges
94## 94##
95## @item -verbose 95## @item -verbose
96## The package manager will print the output of all of the commands that are 96## The package manager will print the output of all of the commands that are
97## performed. 97## performed.
98## @end table 98## @end table
99## 99##
@@ -205,7 +205,7 @@ endfunction
205## pkg global_list 205## pkg global_list
206## @end example 206## @end example
207## @item rebuild 207## @item rebuild
208## Rebuilds the package database from the installed directories. This can 208## Rebuilds the package database from the installed directories. This can
209## be used in cases where for some reason the package database is corrupted. 209## be used in cases where for some reason the package database is corrupted.
210## It can also take the @code{-auto} and @code{-noauto} options to allow the 210## It can also take the @code{-auto} and @code{-noauto} options to allow the
211## autoloading state of a package to be changed. For example 211## autoloading state of a package to be changed. For example
@@ -227,7 +227,7 @@ endfunction
227## @noindent 227## @noindent
228## where @code{builddir} is the name of a directory where the temporary 228## where @code{builddir} is the name of a directory where the temporary
229## installation will be produced and the binary packages will be found. 229## installation will be produced and the binary packages will be found.
230## The options @code{-verbose} and @code{-nodeps} are respected, while 230## The options @code{-verbose} and @code{-nodeps} are respected, while
231## the other options are ignored. 231## the other options are ignored.
232## @end table 232## @end table
233## @end deftypefn 233## @end deftypefn
@@ -259,7 +259,7 @@ function [local_packages, global_packages] = pkg (varargin)
259 259
260 available_actions = {"list", "install", "uninstall", "load", ... 260 available_actions = {"list", "install", "uninstall", "load", ...
261 "unload", "prefix", "local_list", ... 261 "unload", "prefix", "local_list", ...
262 "global_list", "rebuild", "build","describe"}; 262 "global_list", "rebuild", "build","describe"};
263 ## Handle input 263 ## Handle input
264 if (length (varargin) == 0 || ! iscellstr (varargin)) 264 if (length (varargin) == 0 || ! iscellstr (varargin))
265 print_usage (); 265 print_usage ();
@@ -321,14 +321,14 @@ function [local_packages, global_packages] = pkg (varargin)
321 if (length (files) == 0) 321 if (length (files) == 0)
322 error ("you must specify at least one filename when calling 'pkg install'"); 322 error ("you must specify at least one filename when calling 'pkg install'");
323 endif 323 endif
324 install (files, deps, auto, prefix, archprefix, verbose, local_list, 324 install (files, deps, auto, prefix, archprefix, verbose, local_list,
325 global_list, global_install); 325 global_list, global_install);
326 326
327 case "uninstall" 327 case "uninstall"
328 if (length (files) == 0) 328 if (length (files) == 0)
329 error ("you must specify at least one package when calling 'pkg uninstall'"); 329 error ("you must specify at least one package when calling 'pkg uninstall'");
330 endif 330 endif
331 uninstall (files, deps, verbose, local_list, 331 uninstall (files, deps, verbose, local_list,
332 global_list, global_install); 332 global_list, global_install);
333 333
334 case "load" 334 case "load"
@@ -406,7 +406,7 @@ function [local_packages, global_packages] = pkg (varargin)
406 406
407 case "rebuild" 407 case "rebuild"
408 if (global_install) 408 if (global_install)
409 global_packages = rebuild (prefix, archprefix, global_list, files, 409 global_packages = rebuild (prefix, archprefix, global_list, files,
410 auto, verbose); 410 auto, verbose);
411 global_packages = save_order (global_packages); 411 global_packages = save_order (global_packages);
412 save (global_list, "global_packages"); 412 save (global_list, "global_packages");
@@ -414,7 +414,7 @@ function [local_packages, global_packages] = pkg (varargin)
414 local_packages = global_packages; 414 local_packages = global_packages;
415 endif 415 endif
416 else 416 else
417 local_packages = rebuild (prefix, archprefix, local_list, files, auto, 417 local_packages = rebuild (prefix, archprefix, local_list, files, auto,
418 verbose); 418 verbose);
419 local_packages = save_order (local_packages); 419 local_packages = save_order (local_packages);
420 save (local_list, "local_packages"); 420 save (local_list, "local_packages");
@@ -450,7 +450,7 @@ function [local_packages, global_packages] = pkg (varargin)
450 otherwise 450 otherwise
451 error ("you can request at most two outputs when calling 'pkg describe'"); 451 error ("you can request at most two outputs when calling 'pkg describe'");
452 endswitch 452 endswitch
453 453
454 otherwise 454 otherwise
455 error ("you must specify a valid action for 'pkg'. See 'help pkg' for details"); 455 error ("you must specify a valid action for 'pkg'. See 'help pkg' for details");
456 endswitch 456 endswitch
@@ -529,7 +529,7 @@ function descriptions = rebuild (prefix, archprefix, list, files, auto, verbose)
529 endfor 529 endfor
530 if (! isempty (dup)) 530 if (! isempty (dup))
531 descriptions (dup) = []; 531 descriptions (dup) = [];
532 endif 532 endif
533 endif 533 endif
534endfunction 534endfunction
535 535
@@ -555,7 +555,7 @@ function build (files, handle_deps, autoload, verbose)
555 endif 555 endif
556 files(1) = []; 556 files(1) = [];
557 buildlist = fullfile (builddir, "octave_packages"); 557 buildlist = fullfile (builddir, "octave_packages");
558 install (files, handle_deps, autoload, installdir, installdir, verbose, 558 install (files, handle_deps, autoload, installdir, installdir, verbose,
559 buildlist, "", false); 559 buildlist, "", false);
560 unwind_protect 560 unwind_protect
561 repackage (builddir, buildlist); 561 repackage (builddir, buildlist);
@@ -570,7 +570,7 @@ function build (files, handle_deps, autoload, verbose)
570 end_unwind_protect 570 end_unwind_protect
571endfunction 571endfunction
572 572
573function install (files, handle_deps, autoload, prefix, archprefix, verbose, 573function install (files, handle_deps, autoload, prefix, archprefix, verbose,
574 local_list, global_list, global_install) 574 local_list, global_list, global_install)
575 575
576 ## Check that the directory in prefix exist. If it doesn't: create it! 576 ## Check that the directory in prefix exist. If it doesn't: create it!
@@ -583,10 +583,10 @@ function install (files, handle_deps, autoload, prefix, archprefix, verbose,
583 endif 583 endif
584 584
585 ## Get the list of installed packages. 585 ## Get the list of installed packages.
586 [local_packages, global_packages] = installed_packages (local_list, 586 [local_packages, global_packages] = installed_packages (local_list,
587 global_list); 587 global_list);
588 588
589 installed_pkgs_lst = {local_packages{:}, global_packages{:}}; 589 installed_pkgs_lst = {local_packages{:}, global_packages{:}};
590 590
591 if (global_install) 591 if (global_install)
592 packages = global_packages; 592 packages = global_packages;
@@ -599,7 +599,7 @@ function install (files, handle_deps, autoload, prefix, archprefix, verbose,
599 try 599 try
600 ## Warn about non existent files. 600 ## Warn about non existent files.
601 for i = 1:length (files) 601 for i = 1:length (files)
602 if (isempty (glob(files{i}))) 602 if (isempty (glob(files{i})))
603 warning ("file %s does not exist", files{i}); 603 warning ("file %s does not exist", files{i});
604 endif 604 endif
605 endfor 605 endfor
@@ -652,32 +652,32 @@ function install (files, handle_deps, autoload, prefix, archprefix, verbose,
652 packdir = fullfile (pwd(), dirlist{3}); 652 packdir = fullfile (pwd(), dirlist{3});
653 endif 653 endif
654 packdirs{end+1} = packdir; 654 packdirs{end+1} = packdir;
655 655
656 ## Make sure the package contains necessary files. 656 ## Make sure the package contains necessary files.
657 verify_directory (packdir); 657 verify_directory (packdir);
658 658
659 ## Read the DESCRIPTION file. 659 ## Read the DESCRIPTION file.
660 filename = fullfile (packdir, "DESCRIPTION"); 660 filename = fullfile (packdir, "DESCRIPTION");
661 desc = get_description (filename); 661 desc = get_description (filename);
662 662
663 ## Verify that package name corresponds with filename. 663 ## Verify that package name corresponds with filename.
664 [dummy, nm] = fileparts (tgz); 664 [dummy, nm] = fileparts (tgz);
665 if ((length (nm) >= length (desc.name)) 665 if ((length (nm) >= length (desc.name))
666 && ! strcmp (desc.name, nm(1:length(desc.name)))) 666 && ! strcmp (desc.name, nm(1:length(desc.name))))
667 error ("package name '%s' doesn't correspond to its filename '%s'", 667 error ("package name '%s' doesn't correspond to its filename '%s'",
668 desc.name, nm); 668 desc.name, nm);
669 endif 669 endif
670 670
671 ## Set default installation directory. 671 ## Set default installation directory.
672 desc.dir = fullfile (prefix, cstrcat (desc.name, "-", desc.version)); 672 desc.dir = fullfile (prefix, cstrcat (desc.name, "-", desc.version));
673 673
674 ## Set default architectire dependent installation directory. 674 ## Set default architecture dependent installation directory.
675 desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-", 675 desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-",
676 desc.version)); 676 desc.version));
677 677
678 ## Save desc. 678 ## Save desc.
679 descriptions{end+1} = desc; 679 descriptions{end+1} = desc;
680 680
681 ## Are any of the new packages already installed? 681 ## Are any of the new packages already installed?
682 ## If so we'll remove the old version. 682 ## If so we'll remove the old version.
683 for j = 1:length (packages) 683 for j = 1:length (packages)
@@ -705,14 +705,14 @@ function install (files, handle_deps, autoload, prefix, archprefix, verbose,
705 if (global_install) 705 if (global_install)
706 ## Global installation is not allowed to have dependencies on locally 706 ## Global installation is not allowed to have dependencies on locally
707 ## installed packages. 707 ## installed packages.
708 idx1 = complement (packages_to_uninstall, 708 idx1 = complement (packages_to_uninstall,
709 1:length(global_packages)); 709 1:length(global_packages));
710 pseudo_installed_packages = {global_packages{idx1}, ... 710 pseudo_installed_packages = {global_packages{idx1}, ...
711 descriptions{idx2}}; 711 descriptions{idx2}};
712 else 712 else
713 idx1 = complement (packages_to_uninstall, 713 idx1 = complement (packages_to_uninstall,
714 1:length(local_packages)); 714 1:length(local_packages));
715 pseudo_installed_packages = {local_packages{idx1}, ... 715 pseudo_installed_packages = {local_packages{idx1}, ...
716 global_packages{:}, ... 716 global_packages{:}, ...
717 descriptions{idx2}}; 717 descriptions{idx2}};
718 endif 718 endif
@@ -755,10 +755,10 @@ function install (files, handle_deps, autoload, prefix, archprefix, verbose,
755 try 755 try
756 for i = packages_to_uninstall 756 for i = packages_to_uninstall
757 if (global_install) 757 if (global_install)
758 uninstall ({global_packages{i}.name}, false, verbose, local_list, 758 uninstall ({global_packages{i}.name}, false, verbose, local_list,
759 global_list, global_install); 759 global_list, global_install);
760 else 760 else
761 uninstall ({local_packages{i}.name}, false, verbose, local_list, 761 uninstall ({local_packages{i}.name}, false, verbose, local_list,
762 global_list, global_install); 762 global_list, global_install);
763 endif 763 endif
764 endfor 764 endfor
@@ -809,7 +809,7 @@ function install (files, handle_deps, autoload, prefix, archprefix, verbose,
809 ## requested that it is, then mark the package as autoloaded. 809 ## requested that it is, then mark the package as autoloaded.
810 for i = length (descriptions):-1:1 810 for i = length (descriptions):-1:1
811 if (autoload > 0 || (autoload == 0 && isautoload (descriptions(i)))) 811 if (autoload > 0 || (autoload == 0 && isautoload (descriptions(i))))
812 fclose (fopen (fullfile (descriptions{i}.dir, "packinfo", 812 fclose (fopen (fullfile (descriptions{i}.dir, "packinfo",
813 ".autoload"), "wt")); 813 ".autoload"), "wt"));
814 descriptions{i}.autoload = 1; 814 descriptions{i}.autoload = 1;
815 endif 815 endif
@@ -872,10 +872,10 @@ function install (files, handle_deps, autoload, prefix, archprefix, verbose,
872 endif 872 endif
873endfunction 873endfunction
874 874
875function uninstall (pkgnames, handle_deps, verbose, local_list, 875function uninstall (pkgnames, handle_deps, verbose, local_list,
876 global_list, global_install) 876 global_list, global_install)
877 ## Get the list of installed packages. 877 ## Get the list of installed packages.
878 [local_packages, global_packages] = installed_packages(local_list, 878 [local_packages, global_packages] = installed_packages(local_list,
879 global_list); 879 global_list);
880 if (global_install) 880 if (global_install)
881 installed_pkgs_lst = {local_packages{:}, global_packages{:}}; 881 installed_pkgs_lst = {local_packages{:}, global_packages{:}};
@@ -996,13 +996,13 @@ function uninstall (pkgnames, handle_deps, verbose, local_list,
996 996
997endfunction 997endfunction
998 998
999function [pkg_desc_list, flag] = describe (pkgnames, verbose, 999function [pkg_desc_list, flag] = describe (pkgnames, verbose,
1000 local_list, global_list) 1000 local_list, global_list)
1001 1001
1002 ## Get the list of installed packages. 1002 ## Get the list of installed packages.
1003 installed_pkgs_lst = installed_packages(local_list, global_list); 1003 installed_pkgs_lst = installed_packages(local_list, global_list);
1004 num_packages = length (installed_pkgs_lst); 1004 num_packages = length (installed_pkgs_lst);
1005 1005
1006 1006
1007 describe_all = false; 1007 describe_all = false;
1008 if (any (strcmp ("all", pkgnames))) 1008 if (any (strcmp ("all", pkgnames)))
@@ -1043,7 +1043,7 @@ function [pkg_desc_list, flag] = describe (pkgnames, verbose,
1043 non_inst_str = sprintf (" %s ", pkgnames{non_inst}); 1043 non_inst_str = sprintf (" %s ", pkgnames{non_inst});
1044 error ("some packages are not installed: %s", non_inst_str); 1044 error ("some packages are not installed: %s", non_inst_str);
1045 else 1045 else
1046 pkg_desc_list{non_inst} = struct ("name", {}, "description", 1046 pkg_desc_list{non_inst} = struct ("name", {}, "description",
1047 {}, "provides", {}); 1047 {}, "provides", {});
1048 endif 1048 endif
1049 endif 1049 endif
@@ -1052,7 +1052,7 @@ function [pkg_desc_list, flag] = describe (pkgnames, verbose,
1052 for i = 1:num_pkgnames 1052 for i = 1:num_pkgnames
1053 print_package_description (pkg_desc_list{i}.name, 1053 print_package_description (pkg_desc_list{i}.name,
1054 pkg_desc_list{i}.version, 1054 pkg_desc_list{i}.version,
1055 pkg_desc_list{i}.provides, 1055 pkg_desc_list{i}.provides,
1056 pkg_desc_list{i}.description, 1056 pkg_desc_list{i}.description,
1057 flag{i}, verbose); 1057 flag{i}, verbose);
1058 endfor 1058 endfor
@@ -1069,12 +1069,12 @@ function [pkg_idx_struct] = parse_pkg_idx (packdir)
1069 1069
1070 if (! exist (index_file, "file")) 1070 if (! exist (index_file, "file"))
1071 error ("could not find any INDEX file in directory %s, try 'pkg rebuild all' to generate missing INDEX files", packdir); 1071 error ("could not find any INDEX file in directory %s, try 'pkg rebuild all' to generate missing INDEX files", packdir);
1072 endif 1072 endif
1073
1073 1074
1074
1075 [fid, msg] = fopen (index_file, "r"); 1075 [fid, msg] = fopen (index_file, "r");
1076 if (fid == -1) 1076 if (fid == -1)
1077 error ("the INDEX file %s could not be read: %s", 1077 error ("the INDEX file %s could not be read: %s",
1078 index_file, msg); 1078 index_file, msg);
1079 endif 1079 endif
1080 1080
@@ -1089,7 +1089,7 @@ function [pkg_idx_struct] = parse_pkg_idx (packdir)
1089 1089
1090 while (! feof (fid) || line != -1) 1090 while (! feof (fid) || line != -1)
1091 if (! any (! isspace (line)) || line(1) == "#" || any (line == "=")) 1091 if (! any (! isspace (line)) || line(1) == "#" || any (line == "="))
1092 ## Comments, blank lines or comments about unimplemented 1092 ## Comments, blank lines or comments about unimplemented
1093 ## functions: do nothing 1093 ## functions: do nothing
1094 ## FIXME: probably comments and pointers to external functions 1094 ## FIXME: probably comments and pointers to external functions
1095 ## could be treated better when printing to screen? 1095 ## could be treated better when printing to screen?
@@ -1114,7 +1114,7 @@ function [pkg_idx_struct] = parse_pkg_idx (packdir)
1114 fclose (fid); 1114 fclose (fid);
1115endfunction 1115endfunction
1116 1116
1117function print_package_description (pkg_name, pkg_ver, pkg_idx_struct, 1117function print_package_description (pkg_name, pkg_ver, pkg_idx_struct,
1118 pkg_desc, status, verbose) 1118 pkg_desc, status, verbose)
1119 1119
1120 printf ("---\nPackage name:\n\t%s\n", pkg_name); 1120 printf ("---\nPackage name:\n\t%s\n", pkg_name);
@@ -1122,7 +1122,7 @@ function print_package_description (pkg_name, pkg_ver, pkg_idx_struct,
1122 printf ("Short description:\n\t%s\n", pkg_desc); 1122 printf ("Short description:\n\t%s\n", pkg_desc);
1123 printf ("Status:\n\t%s\n", status); 1123 printf ("Status:\n\t%s\n", status);
1124 if (verbose) 1124 if (verbose)
1125 printf ("---\nProvides:\n"); 1125 printf ("---\nProvides:\n");
1126 for i = 1:length(pkg_idx_struct) 1126 for i = 1:length(pkg_idx_struct)
1127 if (! isempty (pkg_idx_struct{i}.functions)) 1127 if (! isempty (pkg_idx_struct{i}.functions))
1128 printf ("%s\n", pkg_idx_struct{i}.category); 1128 printf ("%s\n", pkg_idx_struct{i}.category);
@@ -1177,26 +1177,26 @@ function repackage (builddir, buildlist)
1177 unlink (fullfile (pack.name, "inst", "PKG_DEL")); 1177 unlink (fullfile (pack.name, "inst", "PKG_DEL"));
1178 endif 1178 endif
1179 if (exist (fullfile (archdir, "PKG_ADD"), "file")) 1179 if (exist (fullfile (archdir, "PKG_ADD"), "file"))
1180 movefile (fullfile (archdir, "PKG_ADD"), 1180 movefile (fullfile (archdir, "PKG_ADD"),
1181 fullfile (pack.name, "PKG_ADD")); 1181 fullfile (pack.name, "PKG_ADD"));
1182 endif 1182 endif
1183 if (exist (fullfile (archdir, "PKG_DEL"), "file")) 1183 if (exist (fullfile (archdir, "PKG_DEL"), "file"))
1184 movefile (fullfile (archdir, "PKG_DEL"), 1184 movefile (fullfile (archdir, "PKG_DEL"),
1185 fullfile (pack.name, "PKG_DEL")); 1185 fullfile (pack.name, "PKG_DEL"));
1186 endif 1186 endif
1187 else 1187 else
1188 if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file")) 1188 if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file"))
1189 movefile (fullfile (pack.name, "inst", "PKG_ADD"), 1189 movefile (fullfile (pack.name, "inst", "PKG_ADD"),
1190 fullfile (pack.name, "PKG_ADD")); 1190 fullfile (pack.name, "PKG_ADD"));
1191 endif 1191 endif
1192 if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file")) 1192 if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file"))
1193 movefile (fullfile (pack.name, "inst", "PKG_DEL"), 1193 movefile (fullfile (pack.name, "inst", "PKG_DEL"),
1194 fullfile (pack.name, "PKG_DEL")); 1194 fullfile (pack.name, "PKG_DEL"));
1195 endif 1195 endif
1196 endif 1196 endif
1197 tfile = cstrcat (pack.name, "-", pack.version, ".tar"); 1197 tfile = cstrcat (pack.name, "-", pack.version, ".tar");
1198 tar (tfile, pack.name); 1198 tar (tfile, pack.name);
1199 try 1199 try
1200 gzip (tfile); 1200 gzip (tfile);
1201 unlink (tfile); 1201 unlink (tfile);
1202 catch 1202 catch
@@ -1231,7 +1231,7 @@ function prepare_installation (desc, packdir)
1231 wd = pwd (); 1231 wd = pwd ();
1232 try 1232 try
1233 cd (packdir); 1233 cd (packdir);
1234 pre_install (desc); 1234 pre_install (desc);
1235 cd (wd); 1235 cd (wd);
1236 catch 1236 catch
1237 cd (wd); 1237 cd (wd);
@@ -1245,13 +1245,13 @@ function prepare_installation (desc, packdir)
1245 [status, msg] = mkdir (inst_dir); 1245 [status, msg] = mkdir (inst_dir);
1246 if (status != 1) 1246 if (status != 1)
1247 rm_rf (desc.dir); 1247 rm_rf (desc.dir);
1248 error ("the 'inst' directory did not exist and could not be created: %s", 1248 error ("the 'inst' directory did not exist and could not be created: %s",
1249 msg); 1249 msg);
1250 endif 1250 endif
1251 endif 1251 endif
1252endfunction 1252endfunction
1253 1253
1254function configure_make (desc, packdir, verbose) 1254function configure_make (desc, packdir, verbose)
1255 ## Perform ./configure, make, make install in "src". 1255 ## Perform ./configure, make, make install in "src".
1256 if (exist (fullfile (packdir, "src"), "dir")) 1256 if (exist (fullfile (packdir, "src"), "dir"))
1257 src = fullfile (packdir, "src"); 1257 src = fullfile (packdir, "src");
@@ -1362,7 +1362,7 @@ function configure_make (desc, packdir, verbose)
1362 printf (" %s", archdependent{:}); 1362 printf (" %s", archdependent{:});
1363 printf (" %s\n", archdir); 1363 printf (" %s\n", archdir);
1364 endif 1364 endif
1365 if (! exist (archdir, "dir")) 1365 if (! exist (archdir, "dir"))
1366 mkdir (archdir); 1366 mkdir (archdir);
1367 endif 1367 endif
1368 [status, output] = copyfile (archdependent, archdir); 1368 [status, output] = copyfile (archdependent, archdir);
@@ -1398,8 +1398,8 @@ endfunction
1398function create_pkgadddel (desc, packdir, nm, global_install) 1398function create_pkgadddel (desc, packdir, nm, global_install)
1399 instpkg = fullfile (desc.dir, nm); 1399 instpkg = fullfile (desc.dir, nm);
1400 instfid = fopen (instpkg, "wt"); 1400 instfid = fopen (instpkg, "wt");
1401 ## If it is exists, most of the PKG_* file should go into the 1401 ## If it is exists, most of the PKG_* file should go into the
1402 ## architecture dependent directory so that the autoload/mfilename 1402 ## architecture dependent directory so that the autoload/mfilename
1403 ## commands work as expected. The only part that doesn't is the 1403 ## commands work as expected. The only part that doesn't is the
1404 ## part in the main directory. 1404 ## part in the main directory.
1405 archdir = fullfile (getarchprefix (desc), cstrcat (desc.name, "-", 1405 archdir = fullfile (getarchprefix (desc), cstrcat (desc.name, "-",
@@ -1465,7 +1465,7 @@ function copy_files (desc, packdir, global_install)
1465 if (! exist (desc.dir, "dir")) 1465 if (! exist (desc.dir, "dir"))
1466 [status, output] = mkdir (desc.dir); 1466 [status, output] = mkdir (desc.dir);
1467 if (status != 1) 1467 if (status != 1)
1468 error ("couldn't create installation directory %s : %s", 1468 error ("couldn't create installation directory %s : %s",
1469 desc.dir, output); 1469 desc.dir, output);
1470 endif 1470 endif
1471 endif 1471 endif
@@ -1493,32 +1493,32 @@ function copy_files (desc, packdir, global_install)
1493 [status, output] = mkdir (octm3); 1493 [status, output] = mkdir (octm3);
1494 if (status != 1) 1494 if (status != 1)
1495 rm_rf (desc.dir); 1495 rm_rf (desc.dir);
1496 error ("couldn't create installation directory %s : %s", 1496 error ("couldn't create installation directory %s : %s",
1497 octm3, output); 1497 octm3, output);
1498 endif 1498 endif
1499 endif 1499 endif
1500 [status, output] = mkdir (octm2); 1500 [status, output] = mkdir (octm2);
1501 if (status != 1) 1501 if (status != 1)
1502 rm_rf (desc.dir); 1502 rm_rf (desc.dir);
1503 error ("couldn't create installation directory %s : %s", 1503 error ("couldn't create installation directory %s : %s",
1504 octm2, output); 1504 octm2, output);
1505 endif 1505 endif
1506 endif 1506 endif
1507 [status, output] = mkdir (octm1); 1507 [status, output] = mkdir (octm1);
1508 if (status != 1) 1508 if (status != 1)
1509 rm_rf (desc.dir); 1509 rm_rf (desc.dir);
1510 error ("couldn't create installation directory %s : %s", 1510 error ("couldn't create installation directory %s : %s",
1511 octm1, output); 1511 octm1, output);
1512 endif 1512 endif
1513 endif 1513 endif
1514 [status, output] = mkdir (octfiledir); 1514 [status, output] = mkdir (octfiledir);
1515 if (status != 1) 1515 if (status != 1)
1516 rm_rf (desc.dir); 1516 rm_rf (desc.dir);
1517 error ("couldn't create installation directory %s : %s", 1517 error ("couldn't create installation directory %s : %s",
1518 octfiledir, output); 1518 octfiledir, output);
1519 endif 1519 endif
1520 endif 1520 endif
1521 [status, output] = movefile (fullfile (desc.dir, getarch (), "*"), 1521 [status, output] = movefile (fullfile (desc.dir, getarch (), "*"),
1522 octfiledir); 1522 octfiledir);
1523 rm_rf (fullfile (desc.dir, getarch ())); 1523 rm_rf (fullfile (desc.dir, getarch ()));
1524 1524
@@ -1753,7 +1753,7 @@ function deps_cell = fix_depends (depends)
1753 version = fix_version (parts{2}); 1753 version = fix_version (parts{2});
1754 1754
1755 ## If no version is specified for the dependency 1755 ## If no version is specified for the dependency
1756 ## we say that the version should be greater than 1756 ## we say that the version should be greater than
1757 ## or equal to "0.0.0". 1757 ## or equal to "0.0.0".
1758 else 1758 else
1759 package = tolower (strip (dep)); 1759 package = tolower (strip (dep));
@@ -1813,7 +1813,7 @@ function write_index (desc, dir, index_file, global_install)
1813 if (err) 1813 if (err)
1814 error ("couldn't read directory %s: %s", tmpdir, msg); 1814 error ("couldn't read directory %s: %s", tmpdir, msg);
1815 endif 1815 endif
1816 files = [files; files2]; 1816 files = [files; files2];
1817 endif 1817 endif
1818 1818
1819 functions = {}; 1819 functions = {};
@@ -1910,7 +1910,7 @@ function [out1, out2] = installed_packages (local_list, global_list)
1910 endfor 1910 endfor
1911 if (! isempty(dup)) 1911 if (! isempty(dup))
1912 installed_pkgs_lst(dup) = []; 1912 installed_pkgs_lst(dup) = [];
1913 endif 1913 endif
1914 1914
1915 ## Now check if the package is loaded. 1915 ## Now check if the package is loaded.
1916 tmppath = strrep (path(), "\\", "/"); 1916 tmppath = strrep (path(), "\\", "/");
@@ -1957,9 +1957,9 @@ function [out1, out2] = installed_packages (local_list, global_list)
1957 h1 = "Package Name"; 1957 h1 = "Package Name";
1958 h2 = "Version"; 1958 h2 = "Version";
1959 h3 = "Installation directory"; 1959 h3 = "Installation directory";
1960 max_name_length = length (h1); 1960 max_name_length = length (h1);
1961 max_version_length = length (h2); 1961 max_version_length = length (h2);
1962 names = cell (num_packages, 1); 1962 names = cell (num_packages, 1);
1963 for i = 1:num_packages 1963 for i = 1:num_packages
1964 max_name_length = max (max_name_length, 1964 max_name_length = max (max_name_length,
1965 length (installed_pkgs_lst{i}.name)); 1965 length (installed_pkgs_lst{i}.name));
@@ -1996,7 +1996,7 @@ function [out1, out2] = installed_packages (local_list, global_list)
1996 first_char = length (cur_dir) - max_dir_length + 4; 1996 first_char = length (cur_dir) - max_dir_length + 4;
1997 first_filesep = strfind (cur_dir(first_char:end), filesep()); 1997 first_filesep = strfind (cur_dir(first_char:end), filesep());
1998 if (! isempty (first_filesep)) 1998 if (! isempty (first_filesep))
1999 cur_dir = cstrcat ("...", 1999 cur_dir = cstrcat ("...",
2000 cur_dir((first_char + first_filesep(1) - 1):end)); 2000 cur_dir((first_char + first_filesep(1) - 1):end));
2001 else 2001 else
2002 cur_dir = cstrcat ("...", cur_dir(first_char:end)); 2002 cur_dir = cstrcat ("...", cur_dir(first_char:end));
@@ -2026,7 +2026,7 @@ function load_packages (files, handle_deps, local_list, global_list)
2026 if (length (files) == 1 && strcmp (files{1}, "all")) 2026 if (length (files) == 1 && strcmp (files{1}, "all"))
2027 idx = [1:length(installed_pkgs_lst)]; 2027 idx = [1:length(installed_pkgs_lst)];
2028 ## Load auto. 2028 ## Load auto.
2029 elseif (length (files) == 1 && strcmp (files{1}, "auto")) 2029 elseif (length (files) == 1 && strcmp (files{1}, "auto"))
2030 idx = []; 2030 idx = [];
2031 for i = 1:length (installed_pkgs_lst) 2031 for i = 1:length (installed_pkgs_lst)
2032 if (exist (fullfile (pdirs{i}, "packinfo", ".autoload"), "file")) 2032 if (exist (fullfile (pdirs{i}, "packinfo", ".autoload"), "file"))
@@ -2162,7 +2162,7 @@ endfunction
2162 2162
2163function archprefix = getarchprefix (desc, global_install) 2163function archprefix = getarchprefix (desc, global_install)
2164 if ((nargin == 2 && global_install) || (nargin < 2 && issuperuser ())) 2164 if ((nargin == 2 && global_install) || (nargin < 2 && issuperuser ()))
2165 archprefix = fullfile (octave_config_info ("libexecdir"), "octave", 2165 archprefix = fullfile (octave_config_info ("libexecdir"), "octave",
2166 "packages", cstrcat(desc.name, "-", desc.version)); 2166 "packages", cstrcat(desc.name, "-", desc.version));
2167 else 2167 else
2168 archprefix = desc.dir; 2168 archprefix = desc.dir;
@@ -2207,7 +2207,7 @@ function newdesc = save_order (desc)
2207 newdesc = {}; 2207 newdesc = {};
2208 for i = 1 : length(desc) 2208 for i = 1 : length(desc)
2209 deps = desc{i}.depends; 2209 deps = desc{i}.depends;
2210 if (isempty (deps) || (length (deps) == 1 && 2210 if (isempty (deps) || (length (deps) == 1 &&
2211 strcmp(deps{1}.package, "octave"))) 2211 strcmp(deps{1}.package, "octave")))
2212 newdesc {end + 1} = desc{i}; 2212 newdesc {end + 1} = desc{i};
2213 else 2213 else
@@ -2220,7 +2220,7 @@ function newdesc = save_order (desc)
2220 endif 2220 endif
2221 endfor 2221 endfor
2222 endfor 2222 endfor
2223 if (! isempty (tmpdesc)) 2223 if (! isempty (tmpdesc))
2224 newdesc = {newdesc{:}, save_order(tmpdesc){:}, desc{i}}; 2224 newdesc = {newdesc{:}, save_order(tmpdesc){:}, desc{i}};
2225 else 2225 else
2226 newdesc{end+1} = desc{i}; 2226 newdesc{end+1} = desc{i};
@@ -2278,7 +2278,7 @@ function idx = load_package_dirs (lidx, idx, handle_deps, installed_pkgs_lst)
2278 else 2278 else
2279 if (handle_deps) 2279 if (handle_deps)
2280 deps = installed_pkgs_lst{i}.depends; 2280 deps = installed_pkgs_lst{i}.depends;
2281 if ((length (deps) > 1) || (length (deps) == 1 && 2281 if ((length (deps) > 1) || (length (deps) == 1 &&
2282 ! strcmp(deps{1}.package, "octave"))) 2282 ! strcmp(deps{1}.package, "octave")))
2283 tmplidx = []; 2283 tmplidx = [];
2284 for k = 1 : length (deps) 2284 for k = 1 : length (deps)
@@ -2289,7 +2289,7 @@ function idx = load_package_dirs (lidx, idx, handle_deps, installed_pkgs_lst)
2289 endif 2289 endif
2290 endfor 2290 endfor
2291 endfor 2291 endfor
2292 idx = load_package_dirs (tmplidx, idx, handle_deps, 2292 idx = load_package_dirs (tmplidx, idx, handle_deps,
2293 installed_pkgs_lst); 2293 installed_pkgs_lst);
2294 endif 2294 endif
2295 endif 2295 endif
diff --git a/test/indent/pascal.pas b/test/indent/pascal.pas
new file mode 100644
index 00000000000..07a21f23c3c
--- /dev/null
+++ b/test/indent/pascal.pas
@@ -0,0 +1,1088 @@
1{ GPC demo program for the CRT unit.
2
3Copyright (C) 1999-2006 Free Software Foundation, Inc.
4
5Author: Frank Heckenbach <frank@pascal.gnu.de>
6
7This program is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public License as
9published by the Free Software Foundation, version 2.
10
11This program is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with this program; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA.
20
21As a special exception, if you incorporate even large parts of the
22code of this demo program into another program with substantially
23different functionality, this does not cause the other program to
24be covered by the GNU General Public License. This exception does
25not however invalidate any other reasons why it might be covered
26by the GNU General Public License. }
27
28{$gnu-pascal,I+}
29
30program CRTDemo;
31
32uses GPC, CRT;
33
34type
35 TFrameChars = array [1 .. 8] of Char;
36 TSimulateBlockCursorKind = (bc_None, bc_Blink, bc_Static);
37
38const
39 SingleFrame: TFrameChars = (chCornerTLS, chLineHS, chCornerTRS, chLineVS, chLineVS, chCornerBLS, chLineHS, chCornerBRS);
40 DoubleFrame: TFrameChars = (chCornerTLD, chLineHD, chCornerTRD, chLineVD, chLineVD, chCornerBLD, chLineHD, chCornerBRD);
41
42var
43 ScrollState: Boolean = True;
44 SimulateBlockCursorKind: TSimulateBlockCursorKind = bc_None;
45 CursorShape: TCursorShape = CursorNormal;
46 MainPanel: TPanel;
47 OrigScreenSize: TPoint;
48
49procedure FrameWin (const Title: String; const Frame: TFrameChars; TitleInverse: Boolean);
50var
51 w, h, y, Color: Integer;
52 Attr: TTextAttr;
53begin
54 HideCursor;
55 SetPCCharSet (True);
56 ClrScr;
57 w := GetXMax;
58 h := GetYMax;
59 WriteCharAt (1, 1, 1, Frame[1], TextAttr);
60 WriteCharAt (2, 1, w - 2, Frame[2], TextAttr);
61 WriteCharAt (w, 1, 1, Frame[3], TextAttr);
62 for y := 2 to h - 1 do
63 begin
64 WriteCharAt (1, y, 1, Frame[4], TextAttr);
65 WriteCharAt (w, y, 1, Frame[5], TextAttr)
66 end;
67 WriteCharAt (1, h, 1, Frame[6], TextAttr);
68 WriteCharAt (2, h, w - 2, Frame[7], TextAttr);
69 WriteCharAt (w, h, 1, Frame[8], TextAttr);
70 SetPCCharSet (False);
71 Attr := TextAttr;
72 if TitleInverse then
73 begin
74 Color := GetTextColor;
75 TextColor (GetTextBackground);
76 TextBackground (Color)
77 end;
78 WriteStrAt ((w - Length (Title)) div 2 + 1, 1, Title, TextAttr);
79 TextAttr := Attr
80end;
81
82function GetKey (TimeOut: Integer) = Key: TKey; forward;
83
84procedure ClosePopUpWindow;
85begin
86 PanelDelete (GetActivePanel);
87 PanelDelete (GetActivePanel)
88end;
89
90function PopUpConfirm (XSize, YSize: Integer; const Msg: String): Boolean;
91var
92 ax, ay: Integer;
93 Key: TKey;
94 SSize: TPoint;
95begin
96 repeat
97 SSize := ScreenSize;
98 ax := (SSize.x - XSize - 4) div 2 + 1;
99 ay := (SSize.y - YSize - 4) div 2 + 1;
100 PanelNew (ax, ay, ax + XSize + 3, ay + YSize + 1, False);
101 TextBackground (Black);
102 TextColor (Yellow);
103 SetControlChars (True);
104 FrameWin ('', DoubleFrame, False);
105 NormalCursor;
106 PanelNew (ax + 2, ay + 1, ax + XSize + 2, ay + YSize, False);
107 ClrScr;
108 Write (Msg);
109 Key := GetKey (-1);
110 if Key = kbScreenSizeChanged then ClosePopUpWindow
111 until Key <> kbScreenSizeChanged;
112 PopUpConfirm := not (Key in [kbEsc, kbAltEsc])
113end;
114
115procedure MainDraw;
116begin
117 WriteLn ('3, F3 : Open a window');
118 WriteLn ('4, F4 : Close window');
119 WriteLn ('5, F5 : Previous window');
120 WriteLn ('6, F6 : Next window');
121 WriteLn ('7, F7 : Move window');
122 WriteLn ('8, F8 : Resize window');
123 Write ('q, Esc: Quit')
124end;
125
126procedure StatusDraw;
127const
128 YesNo: array [Boolean] of String [3] = ('No', 'Yes');
129 SimulateBlockCursorIDs: array [TSimulateBlockCursorKind] of String [8] = ('Off', 'Blinking', 'Static');
130 CursorShapeIDs: array [TCursorShape] of String [7] = ('Ignored', 'Hidden', 'Normal', 'Fat', 'Block');
131var
132 SSize: TPoint;
133begin
134 WriteLn ('You can change some of the following');
135 WriteLn ('settings by pressing the key shown');
136 WriteLn ('in parentheses. Naturally, color and');
137 WriteLn ('changing the cursor shape or screen');
138 WriteLn ('size does not work on all terminals.');
139 WriteLn;
140 WriteLn ('XCurses version: ', YesNo[XCRT]);
141 WriteLn ('CRTSavePreviousScreen: ', YesNo[CRTSavePreviousScreenWorks]);
142 WriteLn ('(M)onochrome: ', YesNo[IsMonochrome]);
143 SSize := ScreenSize;
144 WriteLn ('Screen (C)olumns: ', SSize.x);
145 WriteLn ('Screen (L)ines: ', SSize.y);
146 WriteLn ('(R)estore screen size');
147 WriteLn ('(B)reak checking: ', YesNo[CheckBreak]);
148 WriteLn ('(S)crolling: ', YesNo[ScrollState]);
149 WriteLn ('S(i)mulated block cursor: ', SimulateBlockCursorIDs[SimulateBlockCursorKind]);
150 Write ('C(u)rsor shape: ', CursorShapeIDs[CursorShape]);
151 GotoXY (36, WhereY)
152end;
153
154procedure RedrawAll; forward;
155procedure CheckScreenSize; forward;
156
157procedure StatusKey (Key: TKey);
158var SSize, NewSize: TPoint;
159begin
160 case LoCase (Key2Char (Key)) of
161 'm': begin
162 SetMonochrome (not IsMonochrome);
163 RedrawAll
164 end;
165 'c': begin
166 SSize := ScreenSize;
167 if SSize.x > 40 then
168 NewSize.x := 40
169 else
170 NewSize.x := 80;
171 if SSize.y > 25 then
172 NewSize.y := 50
173 else
174 NewSize.y := 25;
175 SetScreenSize (NewSize.x, NewSize.y);
176 CheckScreenSize
177 end;
178 'l': begin
179 SSize := ScreenSize;
180 if SSize.x > 40 then
181 NewSize.x := 80
182 else
183 NewSize.x := 40;
184 if SSize.y > 25 then
185 NewSize.y := 25
186 else
187 NewSize.y := 50;
188 SetScreenSize (NewSize.x, NewSize.y);
189 CheckScreenSize
190 end;
191 'r': begin
192 SetScreenSize (OrigScreenSize.x, OrigScreenSize.y);
193 CheckScreenSize
194 end;
195 'b': CheckBreak := not CheckBreak;
196 's': ScrollState := not ScrollState;
197 'i': if SimulateBlockCursorKind = High (SimulateBlockCursorKind) then
198 SimulateBlockCursorKind := Low (SimulateBlockCursorKind)
199 else
200 Inc (SimulateBlockCursorKind);
201 'u': case CursorShape of
202 CursorNormal: CursorShape := CursorBlock;
203 CursorFat,
204 CursorBlock : CursorShape := CursorHidden;
205 else CursorShape := CursorNormal
206 end;
207 end;
208 ClrScr;
209 StatusDraw
210end;
211
212procedure TextAttrDemo;
213var f, b, y, x1, y1, x2, y2, Fill, n1, n2, n3: Integer;
214begin
215 GetWindow (x1, y1, x2, y2);
216 Window (x1 - 1, y1, x2, y2);
217 TextColor (White);
218 TextBackground (Blue);
219 ClrScr;
220 SetScroll (False);
221 Fill := GetXMax - 32;
222 for y := 1 to GetYMax do
223 begin
224 GotoXY (1, y);
225 b := (y - 1) mod 16;
226 n1 := 0;
227 for f := 0 to 15 do
228 begin
229 TextAttr := f + 16 * b;
230 n2 := (Fill * (1 + 2 * f) + 16) div 32;
231 n3 := (Fill * (2 + 2 * f) + 16) div 32;
232 Write ('' : n2 - n1, NumericBaseDigitsUpper[b], NumericBaseDigitsUpper[f], '' : n3 - n2);
233 n1 := n3
234 end
235 end
236end;
237
238procedure CharSetDemo (UsePCCharSet: Boolean);
239var h, l, y, x1, y1, x2, y2, Fill, n1, n2: Integer;
240begin
241 GetWindow (x1, y1, x2, y2);
242 Window (x1 - 1, y1, x2, y2);
243 ClrScr;
244 SetScroll (False);
245 SetPCCharSet (UsePCCharSet);
246 SetControlChars (False);
247 Fill := GetXMax - 35;
248 for y := 1 to GetYMax do
249 begin
250 GotoXY (1, y);
251 h := (y - 2) mod 16;
252 n1 := (Fill + 9) div 18;
253 if y = 1 then
254 Write ('' : 3 + n1)
255 else
256 Write (16 * h : 3 + n1);
257 for l := 0 to 15 do
258 begin
259 n2 := (Fill * (2 + l) + 9) div 18;
260 if y = 1 then
261 Write ('' : n2 - n1, l : 2)
262 else
263 Write ('' : n2 - n1 + 1, Chr (16 * h + l));
264 n1 := n2
265 end
266 end
267end;
268
269procedure NormalCharSetDemo;
270begin
271 CharSetDemo (False)
272end;
273
274procedure PCCharSetDemo;
275begin
276 CharSetDemo (True)
277end;
278
279procedure FKeyDemoDraw;
280var x1, y1, x2, y2: Integer;
281begin
282 GetWindow (x1, y1, x2, y2);
283 Window (x1, y1, x2 - 1, y2);
284 ClrScr;
285 SetScroll (False);
286 WriteLn ('You can type the following keys');
287 WriteLn ('(function keys if present on the');
288 WriteLn ('terminal, letters as alternatives):');
289 GotoXY (1, 4);
290 WriteLn ('S, Left : left (wrap-around)');
291 WriteLn ('D, Right : right (wrap-around)');
292 WriteLn ('E, Up : up (wrap-around)');
293 WriteLn ('X, Down : down (wrap-around)');
294 WriteLn ('A, Home : go to first column');
295 WriteLn ('F, End : go to last column');
296 WriteLn ('R, Page Up : go to first line');
297 WriteLn ('C, Page Down: go to last line');
298 WriteLn ('Y, Ctrl-PgUp: first column and line');
299 GotoXY (1, 13);
300 WriteLn ('B, Ctrl-PgDn: last column and line');
301 WriteLn ('Z, Ctrl-Home: clear screen');
302 WriteLn ('N, Ctrl-End : clear to end of line');
303 WriteLn ('V, Insert : insert a line');
304 WriteLn ('T, Delete : delete a line');
305 WriteLn ('# : beep');
306 WriteLn ('* : flash');
307 WriteLn ('Tab, Enter, Backspace, other');
308 WriteLn (' normal characters: write text')
309end;
310
311procedure FKeyDemoKey (Key: TKey);
312const TabSize = 8;
313var
314 ch: Char;
315 NewX: Integer;
316begin
317 case LoCaseKey (Key) of
318 Ord ('s'), kbLeft : if WhereX = 1 then GotoXY (GetXMax, WhereY) else GotoXY (WhereX - 1, WhereY);
319 Ord ('d'), kbRight : if WhereX = GetXMax then GotoXY (1, WhereY) else GotoXY (WhereX + 1, WhereY);
320 Ord ('e'), kbUp : if WhereY = 1 then GotoXY (WhereX, GetYMax) else GotoXY (WhereX, WhereY - 1);
321 Ord ('x'), kbDown : if WhereY = GetYMax then GotoXY (WhereX, 1) else GotoXY (WhereX, WhereY + 1);
322 Ord ('a'), kbHome : Write (chCR);
323 Ord ('f'), kbEnd : GotoXY (GetXMax, WhereY);
324 Ord ('r'), kbPgUp : GotoXY (WhereX, 1);
325 Ord ('c'), kbPgDn : GotoXY (WhereX, GetYMax);
326 Ord ('y'), kbCtrlPgUp: GotoXY (1, 1);
327 Ord ('b'), kbCtrlPgDn: GotoXY (GetXMax, GetYMax);
328 Ord ('z'), kbCtrlHome: ClrScr;
329 Ord ('n'), kbCtrlEnd : ClrEOL;
330 Ord ('v'), kbIns : InsLine;
331 Ord ('t'), kbDel : DelLine;
332 Ord ('#') : Beep;
333 Ord ('*') : Flash;
334 kbTab : begin
335 NewX := ((WhereX - 1) div TabSize + 1) * TabSize + 1;
336 if NewX <= GetXMax then GotoXY (NewX, WhereY) else WriteLn
337 end;
338 kbCR : WriteLn;
339 kbBkSp : Write (chBkSp, ' ', chBkSp);
340 else ch := Key2Char (Key);
341 if ch <> #0 then Write (ch)
342 end
343end;
344
345procedure KeyDemoDraw;
346begin
347 WriteLn ('Press some keys ...')
348end;
349
350procedure KeyDemoKey (Key: TKey);
351var ch: Char;
352begin
353 ch := Key2Char (Key);
354 if ch <> #0 then
355 begin
356 Write ('Normal key');
357 if IsPrintable (ch) then Write (' `', ch, '''');
358 WriteLn (', ASCII #', Ord (ch))
359 end
360 else
361 WriteLn ('Special key ', Ord (Key2Scan (Key)))
362end;
363
364procedure IOSelectPeriodical;
365var
366 CurrentTime: TimeStamp;
367 s: String (8);
368 i: Integer;
369begin
370 GetTimeStamp (CurrentTime);
371 with CurrentTime do
372 WriteStr (s, Hour : 2, ':', Minute : 2, ':', Second : 2);
373 for i := 1 to Length (s) do
374 if s[i] = ' ' then s[i] := '0';
375 GotoXY (1, 12);
376 Write ('The time is: ', s)
377end;
378
379procedure IOSelectDraw;
380begin
381 WriteLn ('IOSelect is a way to handle I/O from');
382 WriteLn ('or to several places simultaneously,');
383 WriteLn ('without having to use threads or');
384 WriteLn ('signal/interrupt handlers or waste');
385 WriteLn ('CPU time with busy waiting.');
386 WriteLn;
387 WriteLn ('This demo shows how IOSelect works');
388 WriteLn ('in connection with CRT. It displays');
389 WriteLn ('a clock, but still reacts to user');
390 WriteLn ('input immediately.');
391 IOSelectPeriodical
392end;
393
394procedure ModifierPeriodical;
395const
396 Pressed: array [Boolean] of String [8] = ('Released', 'Pressed');
397 ModifierNames: array [1 .. 7] of record
398 Modifier: Integer;
399 Name: String (17)
400 end =
401 ((shLeftShift, 'Left Shift'),
402 (shRightShift, 'Right Shift'),
403 (shLeftCtrl, 'Left Control'),
404 (shRightCtrl, 'Right Control'),
405 (shAlt, 'Alt (left)'),
406 (shAltGr, 'AltGr (right Alt)'),
407 (shExtra, 'Extra'));
408var
409 ShiftState, i: Integer;
410begin
411 ShiftState := GetShiftState;
412 for i := 1 to 7 do
413 with ModifierNames[i] do
414 begin
415 GotoXY (1, 4 + i);
416 ClrEOL;
417 Write (Name, ':');
418 GotoXY (20, WhereY);
419 Write (Pressed[(ShiftState and Modifier) <> 0])
420 end
421end;
422
423procedure ModifierDraw;
424begin
425 WriteLn ('Modifier keys (NOTE: only');
426 WriteLn ('available on some systems;');
427 WriteLn ('X11: only after key press):');
428 ModifierPeriodical
429end;
430
431procedure ChecksDraw;
432begin
433 WriteLn ('(O)S shell');
434 WriteLn ('OS shell with (C)learing');
435 WriteLn ('(R)efresh check');
436 Write ('(S)ound check')
437end;
438
439procedure ChecksKey (Key: TKey);
440var
441 i, j: Integer;
442 WasteTime: Real; attribute (volatile);
443
444 procedure DoOSShell;
445 var
446 Result: Integer;
447 Shell: TString;
448 begin
449 Shell := GetShellPath (Null);
450 {$I-}
451 Result := Execute (Shell);
452 {$I+}
453 if (InOutRes <> 0) or (Result <> 0) then
454 begin
455 ClrScr;
456 if InOutRes <> 0 then
457 WriteLn (GetIOErrorMessage, ' while trying to execute `', Shell, '''.')
458 else
459 WriteLn ('`', Shell, ''' returned status ', Result, '.');
460 Write ('Any key to continue.');
461 BlockCursor;
462 Discard (GetKey (-1))
463 end
464 end;
465
466begin
467 case LoCase (Key2Char (Key)) of
468 'o': begin
469 if PopUpConfirm (36, 12, 'You will now get an OS shell. Unless' + NewLine +
470 'CRTDemo is running in its own (GUI)' + NewLine +
471 'window, the shell will run on the' + NewLine +
472 'same screen as CRTDemo which is not' + NewLine +
473 'cleared before the shell is started.' + NewLine +
474 'If possible, the screen contents are' + NewLine +
475 'restored to the state before CRTDemo' + NewLine +
476 'was started. After leaving the shell' + NewLine +
477 'in the usual way (usually by enter-' + NewLine +
478 'ing `exit''), you will get back to' + NewLine +
479 'the demo. <ESC> to abort, any other' + NewLine +
480 'key to start.') then
481 begin
482 RestoreTerminal (True);
483 DoOSShell
484 end;
485 ClosePopUpWindow
486 end;
487 'c': begin
488 if PopUpConfirm (36, 9, 'You will now get an OS shell. Unless' + NewLine +
489 'CRTDemo is running in its own (GUI)' + NewLine +
490 'window, the screen will be cleared,' + NewLine +
491 'and the cursor will be moved to the' + NewLine +
492 'top before the shell is started.' + NewLine +
493 'After leaving the shell in the usual' + NewLine +
494 'way (usually by entering `exit''),' + NewLine +
495 'you will get back to the demo. <ESC>' + NewLine +
496 'to abort, any other key to start.') then
497 begin
498 RestoreTerminalClearCRT;
499 DoOSShell
500 end;
501 ClosePopUpWindow
502 end;
503 'r': begin
504 if PopUpConfirm (36, 11, 'The program will now get busy with' + NewLine +
505 'some dummy computations. However,' + NewLine +
506 'CRT output in the form of dots will' + NewLine +
507 'still appear continuously one by one' + NewLine +
508 '(rather than the whole line at once' + NewLine +
509 'in the end). While running, the test' + NewLine +
510 'cannot be interrupted. <ESC> to' + NewLine +
511 'abort, any other key to start.') then
512 begin
513 SetCRTUpdate (UpdateRegularly);
514 BlockCursor;
515 WriteLn;
516 WriteLn;
517 for i := 1 to GetXMax - 2 do
518 begin
519 Write ('.');
520 for j := 1 to 400000 do WasteTime := Random
521 end;
522 SetCRTUpdate (UpdateInput);
523 WriteLn;
524 Write ('Press any key.');
525 Discard (GetKey (-1))
526 end;
527 ClosePopUpWindow
528 end;
529 's': begin
530 if PopUpConfirm (32, 4, 'You will now hear some sounds if' + NewLine +
531 'supported (otherwise there will' + NewLine +
532 'just be a short pause). <ESC> to' + NewLine +
533 'abort, any other key to start.') then
534 begin
535 BlockCursor;
536 for i := 0 to 7 do
537 begin
538 Sound (Round (440 * 2 ** (Round (i * 12 / 7 + 0.3) / 12)));
539 if GetKey (400000) in [kbEsc, kbAltEsc] then Break
540 end;
541 NoSound
542 end;
543 ClosePopUpWindow
544 end;
545 end
546end;
547
548type
549 PWindowList = ^TWindowList;
550 TWindowList = record
551 Next, Prev: PWindowList;
552 Panel, FramePanel: TPanel;
553 WindowType: Integer;
554 x1, y1, xs, ys: Integer;
555 State: (ws_None, ws_Moving, ws_Resizing);
556 end;
557
558TKeyProc = procedure (Key: TKey);
559TProcedure = procedure;
560
561const
562 MenuNameLength = 16;
563 WindowTypes: array [0 .. 9] of record
564 DrawProc,
565 PeriodicalProc: procedure;
566 KeyProc : TKeyProc;
567 Name : String (MenuNameLength);
568 Color,
569 Background,
570 MinSizeX,
571 MinSizeY,
572 PrefSizeX,
573 PrefSizeY : Integer;
574 RedrawAlways,
575 WantCursor : Boolean
576 end =
577((MainDraw , nil , nil , 'CRT Demo' , LightGreen, Blue , 26, 7, 0, 0, False, False),
578 (StatusDraw , nil , StatusKey , 'Status' , White , Red , 38, 16, 0, 0, True, True),
579 (TextAttrDemo , nil , nil , 'Text Attributes' , White , Blue , 32, 16, 64, 16, False, False),
580 (NormalCharSetDemo, nil , nil , 'Character Set' , Black , Green , 35, 17, 53, 17, False, False),
581 (PCCharSetDemo , nil , nil , 'PC Character Set', Black , Brown , 35, 17, 53, 17, False, False),
582 (KeyDemoDraw , nil , KeyDemoKey , 'Keys' , Blue , LightGray, 29, 5, -1, -1, False, True),
583 (FKeyDemoDraw , nil , FKeyDemoKey, 'Function Keys' , Blue , LightGray, 37, 22, -1, -1, False, True),
584 (ModifierDraw , ModifierPeriodical, nil , 'Modifier Keys' , Black , Cyan , 29, 11, 0, 0, True, False),
585 (IOSelectDraw , IOSelectPeriodical, nil , 'IOSelect Demo' , White , Magenta , 38, 12, 0, 0, False, False),
586 (ChecksDraw , nil , ChecksKey , 'Various Checks' , Black , Red , 26, 4, 0, 0, False, False));
587
588MenuMax = High (WindowTypes);
589MenuXSize = MenuNameLength + 4;
590MenuYSize = MenuMax + 2;
591
592var
593 WindowList: PWindowList = nil;
594
595 procedure RedrawFrame (p: PWindowList);
596 begin
597 with p^, WindowTypes[WindowType] do
598 begin
599 PanelActivate (FramePanel);
600 Window (x1, y1, x1 + xs - 1, y1 + ys - 1);
601 ClrScr;
602 case State of
603 ws_None : if p = WindowList then
604 FrameWin (' ' + Name + ' ', DoubleFrame, True)
605 else
606 FrameWin (' ' + Name + ' ', SingleFrame, False);
607 ws_Moving : FrameWin (' Move Window ', SingleFrame, True);
608 ws_Resizing: FrameWin (' Resize Window ', SingleFrame, True);
609 end
610 end
611 end;
612
613 procedure DrawWindow (p: PWindowList);
614 begin
615 with p^, WindowTypes[WindowType] do
616 begin
617 RedrawFrame (p);
618 PanelActivate (Panel);
619 Window (x1 + 2, y1 + 1, x1 + xs - 2, y1 + ys - 2);
620 ClrScr;
621 DrawProc
622 end
623 end;
624
625 procedure RedrawAll;
626 var
627 LastPanel: TPanel;
628 p: PWindowList;
629 x2, y2: Integer;
630 begin
631 LastPanel := GetActivePanel;
632 PanelActivate (MainPanel);
633 TextBackground (Blue);
634 ClrScr;
635 p := WindowList;
636 if p <> nil then
637 repeat
638 with p^ do
639 begin
640 PanelActivate (FramePanel);
641 GetWindow (x1, y1, x2, y2); { updated automatically by CRT }
642 xs := x2 - x1 + 1;
643 ys := y2 - y1 + 1
644 end;
645 DrawWindow (p);
646 p := p^.Next
647 until p = WindowList;
648 PanelActivate (LastPanel)
649 end;
650
651 procedure CheckScreenSize;
652 var
653 LastPanel: TPanel;
654 MinScreenSizeX, MinScreenSizeY, i: Integer;
655 SSize: TPoint;
656 begin
657 LastPanel := GetActivePanel;
658 PanelActivate (MainPanel);
659 HideCursor;
660 MinScreenSizeX := MenuXSize;
661 MinScreenSizeY := MenuYSize;
662 for i := Low (WindowTypes) to High (WindowTypes) do
663 with WindowTypes[i] do
664 begin
665 MinScreenSizeX := Max (MinScreenSizeX, MinSizeX + 2);
666 MinScreenSizeY := Max (MinScreenSizeY, MinSizeY + 2)
667 end;
668 SSize := ScreenSize;
669 Window (1, 1, SSize.x, SSize.y);
670 if (SSize.x < MinScreenSizeX) or (SSize.y < MinScreenSizeY) then
671 begin
672 NormVideo;
673 ClrScr;
674 RestoreTerminal (True);
675 WriteLn (StdErr, 'Sorry, your screen is too small for this demo (', SSize.x, 'x', SSize.y, ').');
676 WriteLn (StdErr, 'You need at least ', MinScreenSizeX, 'x', MinScreenSizeY, ' characters.');
677 Halt (2)
678 end;
679 PanelActivate (LastPanel);
680 RedrawAll
681 end;
682
683 procedure Die; attribute (noreturn);
684 begin
685 NoSound;
686 RestoreTerminalClearCRT;
687 WriteLn (StdErr, 'You''re trying to kill me. Since I have break checking turned off,');
688 WriteLn (StdErr, 'I''m not dying, but I''ll do you a favour and terminate now.');
689 Halt (3)
690 end;
691
692 function GetKey (TimeOut: Integer) = Key: TKey;
693 var
694 NeedSelect, SelectValue: Integer;
695 SimulateBlockCursorCurrent: TSimulateBlockCursorKind;
696 SelectInput: array [1 .. 1] of PAnyFile = (@Input);
697 NextSelectTime: MicroSecondTimeType = 0; attribute (static);
698 TimeOutTime: MicroSecondTimeType;
699 LastPanel: TPanel;
700 p: PWindowList;
701 begin
702 LastPanel := GetActivePanel;
703 if TimeOut < 0 then
704 TimeOutTime := High (TimeOutTime)
705 else
706 TimeOutTime := GetMicroSecondTime + TimeOut;
707 NeedSelect := 0;
708 if TimeOut >= 0 then
709 Inc (NeedSelect);
710 SimulateBlockCursorCurrent := SimulateBlockCursorKind;
711 if SimulateBlockCursorCurrent <> bc_None then
712 Inc (NeedSelect);
713 p := WindowList;
714 repeat
715 if @WindowTypes[p^.WindowType].PeriodicalProc <> nil then
716 Inc (NeedSelect);
717 p := p^.Next
718 until p = WindowList;
719 p := WindowList;
720 repeat
721 with p^, WindowTypes[WindowType] do
722 if RedrawAlways then
723 begin
724 PanelActivate (Panel);
725 ClrScr;
726 DrawProc
727 end;
728 p := p^.Next
729 until p = WindowList;
730 if NeedSelect <> 0 then
731 repeat
732 CRTUpdate;
733 SelectValue := IOSelectRead (SelectInput, Max (0, Min (NextSelectTime, TimeOutTime) - GetMicroSecondTime));
734 if SelectValue = 0 then
735 begin
736 case SimulateBlockCursorCurrent of
737 bc_None : ;
738 bc_Blink : SimulateBlockCursor;
739 bc_Static: begin
740 SimulateBlockCursor;
741 SimulateBlockCursorCurrent := bc_None;
742 Dec (NeedSelect)
743 end
744 end;
745 NextSelectTime := GetMicroSecondTime + 120000;
746 p := WindowList;
747 repeat
748 with p^, WindowTypes[WindowType] do
749 if @PeriodicalProc <> nil then
750 begin
751 PanelActivate (Panel);
752 PeriodicalProc
753 end;
754 p := p^.Next
755 until p = WindowList
756 end;
757 until (NeedSelect = 0) or (SelectValue <> 0) or ((TimeOut >= 0) and (GetMicroSecondTime >= TimeOutTime));
758 if NeedSelect = 0 then
759 SelectValue := 1;
760 if SelectValue = 0 then
761 Key := 0
762 else
763 Key := ReadKeyWord;
764 if SimulateBlockCursorKind <> bc_None then
765 SimulateBlockCursorOff;
766 if IsDeadlySignal (Key) then Die;
767 if Key = kbScreenSizeChanged then CheckScreenSize;
768 PanelActivate (LastPanel)
769 end;
770
771 function Menu = n: Integer;
772 var
773 i, ax, ay: Integer;
774 Key: TKey;
775 Done: Boolean;
776 SSize: TPoint;
777 begin
778 n := 1;
779 repeat
780 SSize := ScreenSize;
781 ax := (SSize.x - MenuXSize) div 2 + 1;
782 ay := (SSize.y - MenuYSize) div 2 + 1;
783 PanelNew (ax, ay, ax + MenuXSize - 1, ay + MenuYSize - 1, False);
784 SetControlChars (True);
785 TextColor (Blue);
786 TextBackground (LightGray);
787 FrameWin (' Select Window ', DoubleFrame, True);
788 IgnoreCursor;
789 PanelNew (ax + 1, ay + 1, ax + MenuXSize - 2, ay + MenuYSize - 2, False);
790 ClrScr;
791 TextColor (Black);
792 SetScroll (False);
793 Done := False;
794 repeat
795 for i := 1 to MenuMax do
796 begin
797 GotoXY (1, i);
798 if i = n then
799 TextBackground (Green)
800 else
801 TextBackground (LightGray);
802 ClrEOL;
803 Write (' ', WindowTypes[i].Name);
804 ChangeTextAttr (2, i, 1, Red + $10 * GetTextBackground)
805 end;
806 Key := GetKey (-1);
807 case LoCaseKey (Key) of
808 kbUp : if n = 1 then n := MenuMax else Dec (n);
809 kbDown : if n = MenuMax then n := 1 else Inc (n);
810 kbHome,
811 kbPgUp,
812 kbCtrlPgUp,
813 kbCtrlHome : n := 1;
814 kbEnd,
815 kbPgDn,
816 kbCtrlPgDn,
817 kbCtrlEnd : n := MenuMax;
818 kbCR : Done := True;
819 kbEsc, kbAltEsc : begin
820 n := -1;
821 Done := True
822 end;
823 Ord ('a') .. Ord ('z'): begin
824 i := MenuMax;
825 while (i > 0) and (LoCase (Key2Char (Key)) <> LoCase (WindowTypes[i].Name[1])) do Dec (i);
826 if i > 0 then
827 begin
828 n := i;
829 Done := True
830 end
831 end;
832 end
833 until Done or (Key = kbScreenSizeChanged);
834 ClosePopUpWindow
835 until Key <> kbScreenSizeChanged
836 end;
837
838 procedure NewWindow (WindowType, ax, ay: Integer);
839 var
840 p, LastWindow: PWindowList;
841 MaxX1, MaxY1: Integer;
842 SSize: TPoint;
843 begin
844 New (p);
845 if WindowList = nil then
846 begin
847 p^.Prev := p;
848 p^.Next := p
849 end
850 else
851 begin
852 p^.Prev := WindowList;
853 p^.Next := WindowList^.Next;
854 p^.Prev^.Next := p;
855 p^.Next^.Prev := p;
856 end;
857 p^.WindowType := WindowType;
858 with p^, WindowTypes[WindowType] do
859 begin
860 SSize := ScreenSize;
861 if PrefSizeX > 0 then xs := PrefSizeX else xs := MinSizeX;
862 if PrefSizeY > 0 then ys := PrefSizeY else ys := MinSizeY;
863 xs := Min (xs + 2, SSize.x);
864 ys := Min (ys + 2, SSize.y);
865 MaxX1 := SSize.x - xs + 1;
866 MaxY1 := SSize.y - ys + 1;
867 if ax = 0 then x1 := Random (MaxX1) + 1 else x1 := Min (ax, MaxX1);
868 if ay = 0 then y1 := Random (MaxY1) + 1 else y1 := Min (ay, MaxY1);
869 if (ax = 0) and (PrefSizeX < 0) then Inc (xs, Random (SSize.x - x1 - xs + 2));
870 if (ax = 0) and (PrefSizeY < 0) then Inc (ys, Random (SSize.y - y1 - ys + 2));
871 State := ws_None;
872 PanelNew (1, 1, 1, 1, False);
873 FramePanel := GetActivePanel;
874 SetControlChars (True);
875 TextColor (Color);
876 TextBackground (Background);
877 PanelNew (1, 1, 1, 1, False);
878 SetPCCharSet (False);
879 Panel := GetActivePanel;
880 end;
881 LastWindow := WindowList;
882 WindowList := p;
883 if LastWindow <> nil then RedrawFrame (LastWindow);
884 DrawWindow (p)
885 end;
886
887 procedure OpenWindow;
888 var WindowType: Integer;
889 begin
890 WindowType := Menu;
891 if WindowType >= 0 then NewWindow (WindowType, 0, 0)
892 end;
893
894 procedure NextWindow;
895 var LastWindow: PWindowList;
896 begin
897 LastWindow := WindowList;
898 WindowList := WindowList^.Next;
899 PanelTop (WindowList^.FramePanel);
900 PanelTop (WindowList^.Panel);
901 RedrawFrame (LastWindow);
902 RedrawFrame (WindowList)
903 end;
904
905 procedure PreviousWindow;
906 var LastWindow: PWindowList;
907 begin
908 PanelMoveAbove (WindowList^.Panel, MainPanel);
909 PanelMoveAbove (WindowList^.FramePanel, MainPanel);
910 LastWindow := WindowList;
911 WindowList := WindowList^.Prev;
912 RedrawFrame (LastWindow);
913 RedrawFrame (WindowList)
914 end;
915
916 procedure CloseWindow;
917 var p: PWindowList;
918 begin
919 if WindowList^.WindowType <> 0 then
920 begin
921 p := WindowList;
922 NextWindow;
923 PanelDelete (p^.FramePanel);
924 PanelDelete (p^.Panel);
925 p^.Next^.Prev := p^.Prev;
926 p^.Prev^.Next := p^.Next;
927 Dispose (p)
928 end
929 end;
930
931 procedure MoveWindow;
932 var
933 Done, Changed: Boolean;
934 SSize: TPoint;
935 begin
936 with WindowList^ do
937 begin
938 Done := False;
939 Changed := True;
940 State := ws_Moving;
941 repeat
942 if Changed then DrawWindow (WindowList);
943 Changed := True;
944 case LoCaseKey (GetKey (-1)) of
945 Ord ('s'), kbLeft : if x1 > 1 then Dec (x1);
946 Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (x1);
947 Ord ('e'), kbUp : if y1 > 1 then Dec (y1);
948 Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (y1);
949 Ord ('a'), kbHome : x1 := 1;
950 Ord ('f'), kbEnd : x1 := ScreenSize.x - xs + 1;
951 Ord ('r'), kbPgUp : y1 := 1;
952 Ord ('c'), kbPgDn : y1 := ScreenSize.y - ys + 1;
953 Ord ('y'), kbCtrlPgUp: begin
954 x1 := 1;
955 y1 := 1
956 end;
957 Ord ('b'), kbCtrlPgDn: begin
958 SSize := ScreenSize;
959 x1 := SSize.x - xs + 1;
960 y1 := SSize.y - ys + 1
961 end;
962 kbCR,
963 kbEsc, kbAltEsc : Done := True;
964 else Changed := False
965 end
966 until Done;
967 State := ws_None;
968 DrawWindow (WindowList)
969 end
970 end;
971
972 procedure ResizeWindow;
973 var
974 Done, Changed: Boolean;
975 SSize: TPoint;
976 begin
977 with WindowList^, WindowTypes[WindowType] do
978 begin
979 Done := False;
980 Changed := True;
981 State := ws_Resizing;
982 repeat
983 if Changed then DrawWindow (WindowList);
984 Changed := True;
985 case LoCaseKey (GetKey (-1)) of
986 Ord ('s'), kbLeft : if xs > MinSizeX + 2 then Dec (xs);
987 Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (xs);
988 Ord ('e'), kbUp : if ys > MinSizeY + 2 then Dec (ys);
989 Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (ys);
990 Ord ('a'), kbHome : xs := MinSizeX + 2;
991 Ord ('f'), kbEnd : xs := ScreenSize.x - x1 + 1;
992 Ord ('r'), kbPgUp : ys := MinSizeY + 2;
993 Ord ('c'), kbPgDn : ys := ScreenSize.y - y1 + 1;
994 Ord ('y'), kbCtrlPgUp: begin
995 xs := MinSizeX + 2;
996 ys := MinSizeY + 2
997 end;
998 Ord ('b'), kbCtrlPgDn: begin
999 SSize := ScreenSize;
1000 xs := SSize.x - x1 + 1;
1001 ys := SSize.y - y1 + 1
1002 end;
1003 kbCR,
1004 kbEsc, kbAltEsc : Done := True;
1005 else Changed := False
1006 end
1007 until Done;
1008 State := ws_None;
1009 DrawWindow (WindowList)
1010 end
1011 end;
1012
1013 procedure ActivateCursor;
1014 begin
1015 with WindowList^, WindowTypes[WindowType] do
1016 begin
1017 PanelActivate (Panel);
1018 if WantCursor then
1019 SetCursorShape (CursorShape)
1020 else
1021 HideCursor
1022 end;
1023 SetScroll (ScrollState)
1024 end;
1025
1026var
1027 Key: TKey;
1028 ScreenShot, Done: Boolean;
1029
1030begin
1031 ScreenShot := ParamStr (1) = '--screenshot';
1032 if ParamCount <> Ord (ScreenShot) then
1033 begin
1034 RestoreTerminal (True);
1035 WriteLn (StdErr, ParamStr (0), ': invalid argument `', ParamStr (Ord (ScreenShot) + 1), '''');
1036 Halt (1)
1037 end;
1038 CRTSavePreviousScreen (True);
1039 SetCRTUpdate (UpdateInput);
1040 MainPanel := GetActivePanel;
1041 CheckScreenSize;
1042 OrigScreenSize := ScreenSize;
1043 if ScreenShot then
1044 begin
1045 CursorShape := CursorBlock;
1046 NewWindow (6, 1, 1);
1047 NewWindow (2, 1, MaxInt);
1048 NewWindow (8, MaxInt, 1);
1049 NewWindow (5, 1, 27);
1050 KeyDemoKey (Ord ('f'));
1051 KeyDemoKey (246);
1052 KeyDemoKey (kbDown);
1053 NewWindow (3, MaxInt, 13);
1054 NewWindow (4, MaxInt, 31);
1055 NewWindow (7, MaxInt, MaxInt);
1056 NewWindow (9, MaxInt, 33);
1057 NewWindow (0, 1, 2);
1058 NewWindow (1, 1, 14);
1059 ActivateCursor;
1060 OpenWindow
1061 end
1062 else
1063 NewWindow (0, 3, 2);
1064 Done := False;
1065 repeat
1066 ActivateCursor;
1067 Key := GetKey (-1);
1068 case LoCaseKey (Key) of
1069 Ord ('3'), kbF3 : OpenWindow;
1070 Ord ('4'), kbF4 : CloseWindow;
1071 Ord ('5'), kbF5 : PreviousWindow;
1072 Ord ('6'), kbF6 : NextWindow;
1073 Ord ('7'), kbF7 : MoveWindow;
1074 Ord ('8'), kbF8 : ResizeWindow;
1075 Ord ('q'), kbEsc,
1076 kbAltEsc: Done := True;
1077 else
1078 if WindowList <> nil then
1079 with WindowList^, WindowTypes[WindowType] do
1080 if @KeyProc <> nil then
1081 begin
1082 TextColor (Color);
1083 TextBackground (Background);
1084 KeyProc (Key)
1085 end
1086 end
1087 until Done
1088end.
diff --git a/test/indent/prolog.prolog b/test/indent/prolog.prolog
index 6cb5535fe8d..8af21877b59 100644
--- a/test/indent/prolog.prolog
+++ b/test/indent/prolog.prolog
@@ -200,7 +200,7 @@ elaborate(fix(F,T,B,E), Env, Ee) :-
200 elaborate(let(F,T,app(fix,lambda(F,T,B)),E), Env, Ee). 200 elaborate(let(F,T,app(fix,lambda(F,T,B)),E), Env, Ee).
201 201
202%% elab_bindings(+TS, +Env, -TS). 202%% elab_bindings(+TS, +Env, -TS).
203%% Applique `elaborate' sur l'environnment de type TS. 203%% Applique `elaborate' sur l'environnement de type TS.
204elab_tenv([], _, []). 204elab_tenv([], _, []).
205elab_tenv([(X,T)|TS], Env, [(X, Tg)|TSe]) :- 205elab_tenv([(X,T)|TS], Env, [(X, Tg)|TSe]) :-
206 elaborate(T, Env, Te), 206 elaborate(T, Env, Te),
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-01 09:35:28 +0000