summaryrefslogtreecommitdiff
path: root/test/manual/indent
diff options
context:
space:
mode:
Diffstat (limited to 'test/manual/indent')
-rw-r--r--test/manual/indent/Makefile16
-rw-r--r--test/manual/indent/css-mode.css45
-rw-r--r--test/manual/indent/js-indent-init-dynamic.js30
-rw-r--r--test/manual/indent/js-indent-init-t.js21
-rw-r--r--test/manual/indent/js-jsx.js85
-rw-r--r--test/manual/indent/js.js96
-rw-r--r--test/manual/indent/latex-mode.tex11
-rw-r--r--test/manual/indent/modula2.mod53
-rw-r--r--test/manual/indent/nxml.xml10
-rw-r--r--test/manual/indent/octave.m2370
-rw-r--r--test/manual/indent/pascal.pas1092
-rwxr-xr-xtest/manual/indent/perl.perl69
-rw-r--r--test/manual/indent/prolog.prolog290
-rw-r--r--test/manual/indent/ps-mode.ps14
-rw-r--r--test/manual/indent/ruby.rb418
-rw-r--r--test/manual/indent/scheme.scm9
-rw-r--r--test/manual/indent/scss-mode.scss67
-rw-r--r--test/manual/indent/sgml-mode-attribute.html14
-rwxr-xr-xtest/manual/indent/shell.rc37
-rwxr-xr-xtest/manual/indent/shell.sh183
20 files changed, 4930 insertions, 0 deletions
diff --git a/test/manual/indent/Makefile b/test/manual/indent/Makefile
new file mode 100644
index 00000000000..83162681d72
--- /dev/null
+++ b/test/manual/indent/Makefile
@@ -0,0 +1,16 @@
+RM=rm
+EMACS=../../src/emacs
+
+all: clean $(addsuffix .test,$(wildcard *.*))
+
+clean:
+ -$(RM) -f *.new
+
+# TODO:
+# - mark the places where the indentation is known to be incorrect,
+# and allow either ignoring those errors or not.
+%.test: %
+ $(EMACS) --batch $< \
+ --eval '(indent-region (point-min) (point-max) nil)' \
+ --eval '(write-region (point-min) (point-max) "$<.new")'
+ diff -u -B $< $<.new
diff --git a/test/manual/indent/css-mode.css b/test/manual/indent/css-mode.css
new file mode 100644
index 00000000000..24166b00282
--- /dev/null
+++ b/test/manual/indent/css-mode.css
@@ -0,0 +1,45 @@
+/* asdfasdf */
+
+.xxx
+{
+}
+
+article[role="main"] {
+ width: 60%;
+}
+
+a, b:hover, c {
+ color: black;
+}
+
+a, b:hover { /* bug:20282 */
+ c {
+ color: black;
+ }
+ color: black;
+}
+
+a.b:c,d.e:f,g[h]:i,j[k]:l,.m.n:o,.p.q:r,.s[t]:u,.v[w]:x { /* bug:20282 */
+ background-color: white;
+}
+
+/* asdfasdf */
+@foo x2 {
+ bla:toto;
+}
+.x2
+{
+ /* foo: bar; */ foo2: bar2;
+ bar1: url("http://toto/titi");
+ bar2: url('http://toto/titi');
+ bar3: url(http://toto/titi);
+}
+
+div.x3
+{
+}
+
+article:hover
+{
+ color: black;
+}
diff --git a/test/manual/indent/js-indent-init-dynamic.js b/test/manual/indent/js-indent-init-dynamic.js
new file mode 100644
index 00000000000..536a976e86e
--- /dev/null
+++ b/test/manual/indent/js-indent-init-dynamic.js
@@ -0,0 +1,30 @@
+var foo = function() {
+ return 7;
+};
+
+var foo = function() {
+ return 7;
+ },
+ bar = 8;
+
+var foo = function() {
+ return 7;
+ },
+ bar = function() {
+ return 8;
+ };
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// js-indent-first-init: dynamic
+// End:
+
+// The following test intentionally produces a scan error and should
+// be placed below all other tests to prevent awkward indentation.
+// (It still thinks it's within the body of a function.)
+
+var foo = function() {
+ return 7;
+ ,
+ bar = 8;
diff --git a/test/manual/indent/js-indent-init-t.js b/test/manual/indent/js-indent-init-t.js
new file mode 100644
index 00000000000..bb755420ba7
--- /dev/null
+++ b/test/manual/indent/js-indent-init-t.js
@@ -0,0 +1,21 @@
+var foo = function() {
+ return 7;
+ };
+
+var foo = function() {
+ return 7;
+ },
+ bar = 8;
+
+var foo = function() {
+ return 7;
+ },
+ bar = function() {
+ return 8;
+ };
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// js-indent-first-init: t
+// End:
diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js
new file mode 100644
index 00000000000..7401939d282
--- /dev/null
+++ b/test/manual/indent/js-jsx.js
@@ -0,0 +1,85 @@
+// -*- mode: js-jsx; -*-
+
+var foo = <div></div>;
+
+return (
+ <div>
+ </div>
+ <div>
+ <div></div>
+ <div>
+ <div></div>
+ </div>
+ </div>
+);
+
+React.render(
+ <div>
+ <div></div>
+ </div>,
+ {
+ a: 1
+ },
+ <div>
+ <div></div>
+ </div>
+);
+
+return (
+ // Sneaky!
+ <div></div>
+);
+
+return (
+ <div></div>
+ // Sneaky!
+);
+
+React.render(
+ <input
+ />,
+ {
+ a: 1
+ }
+);
+
+return (
+ <div>
+ {array.map(function () {
+ return {
+ a: 1
+ };
+ })}
+ </div>
+);
+
+return (
+ <div attribute={array.map(function () {
+ return {
+ a: 1
+ };
+
+ return {
+ a: 1
+ };
+
+ return {
+ a: 1
+ };
+ })}>
+ </div>
+);
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
+
+// The following test has intentionally unclosed elements and should
+// be placed below all other tests to prevent awkward indentation.
+
+return (
+ <div>
+ {array.map(function () {
+ return {
+ a: 1
diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js
new file mode 100644
index 00000000000..9a1e0dc7ad5
--- /dev/null
+++ b/test/manual/indent/js.js
@@ -0,0 +1,96 @@
+var a = 1;
+b = 2;
+
+let c = 1,
+ d = 2;
+
+var e = 100500,
+ + 1;
+
+function test ()
+{
+ return /[/]/.test ('/') // (bug#19397)
+}
+
+var f = bar('/protocols/')
+baz();
+
+var h = 100500
+1;
+
+const i = 1,
+ j = 2;
+
+var k = 1,
+ l = [
+ 1, 2,
+ 3, 4
+ ],
+ m = 5;
+
+var n = function() {
+ return 7;
+},
+ o = 8;
+
+foo(bar, function() {
+ return 2;
+});
+
+switch (b) {
+case "a":
+ 2;
+default:
+ 3;
+}
+
+var p = {
+ case: 'zzzz',
+ default: 'donkey',
+ tee: 'ornery'
+};
+
+var evens = [e for each (e in range(0, 21))
+ if (ed % 2 == 0)];
+
+!b
+ !=b
+ !==b
+
+a++
+b +=
+ c
+
+baz(`http://foo.bar/${tee}`)
+ .qux();
+
+`multiline string
+ contents
+ are kept
+ unchanged!`
+
+class A {
+ * x() {
+ return 1
+ * 2;
+ }
+}
+
+if (true)
+ 1
+else
+ 2
+
+Foobar
+ .find()
+ .catch((err) => {
+ return 2;
+ })
+ .then((num) => {
+ console.log(num);
+ });
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
diff --git a/test/manual/indent/latex-mode.tex b/test/manual/indent/latex-mode.tex
new file mode 100644
index 00000000000..55c8e7033bd
--- /dev/null
+++ b/test/manual/indent/latex-mode.tex
@@ -0,0 +1,11 @@
+\documentclass{article} % -*- eval: (bug-reference-mode 1) -*-
+
+\usepackage[utf8]{inputenc}
+
+\begin{document}
+
+To fix this, remove the \url{sn9c102.ko} from where it appears in
+\url{/lib/modules/$(uname -r)}, %bug#11953.
+and install the appropriate \url{gspca-modules} package.
+
+\end{document}
diff --git a/test/manual/indent/modula2.mod b/test/manual/indent/modula2.mod
new file mode 100644
index 00000000000..f8fbcb7f4e5
--- /dev/null
+++ b/test/manual/indent/modula2.mod
@@ -0,0 +1,53 @@
+(* -*- mode: modula-2; m2-indent:3 -*- *)
+
+IMPLEMENTATION MODULE Indent ;
+
+(* This is (* a nested comment *) *)
+// This is a single-line comment.
+
+FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD ;
+
+CONST
+ c1 = 2;
+
+TYPE
+ t = POINTER TO ARRAY [0..10] OF LONGINT;
+
+VAR x: t;
+ y:LONGINT;
+
+
+PROCEDURE f1 (f: File) : INTEGER ;
+ VAR
+ fd: FileDescriptor ;
+ PROCEDURE foo (a:CARDINAL) : INTEGER;
+ BEGIN
+ END foo;
+BEGIN
+ IF f#Error
+ THEN
+ fd := GetIndice(FileInfo, f) ;
+ IF fd#NIL THEN
+ RETURN( fd^.unixfd )
+ ELSE
+ CASE z OF
+ 1: do1();
+ | 2: do2();
+ toto(x);
+ | 3: ;
+ | 4: do4();
+ ELSE do5();
+ END ; (* CASE selection *)
+
+ END
+ END ;
+ FormatError1('file %d has not been opened or is out of range\n', f) ;
+ RETURN( -1 )
+END f1 ;
+
+
+BEGIN
+ init
+FINALLY
+ done
+END Indent.
diff --git a/test/manual/indent/nxml.xml b/test/manual/indent/nxml.xml
new file mode 100644
index 00000000000..61b84f270b0
--- /dev/null
+++ b/test/manual/indent/nxml.xml
@@ -0,0 +1,10 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<spocosy version="1.0" responsetime="2011-03-15 13:53:12" exec="0.171">
+ <!--
+ <query-response requestid="" service="objectquery">
+ <sport name="Soccer" enetSportCode="s" del="no" n="1" ut="2009-12-29
+ 15:36:24" id="1">
+ </sport>
+ </query-response>
+ -->
+</spocosy>
diff --git a/test/manual/indent/octave.m b/test/manual/indent/octave.m
new file mode 100644
index 00000000000..4758f9933cb
--- /dev/null
+++ b/test/manual/indent/octave.m
@@ -0,0 +1,2370 @@
+## -*- mode: octave; coding: utf-8 -*-
+0; # Don't make this a function file
+function res = tcomp (fn)
+
+ global x y ...
+ z1 z2
+ persistent x y ...
+ z1 z2
+ global x y = 2 ...
+ z1 z2 # FIXME
+
+ do
+ something
+ until x = ...
+ y
+
+ %% res = tcomp (fn)
+ %% imports components and rearranges them.
+
+ if nargin ~= 1
+ print_usage()
+ end
+
+ data = dlmread(fn, 3, 0);
+
+ enumeration
+ first (1)
+ second (2)
+ end
+
+ y = enumeration (x); #Beware: "enumeration" can also be a function!
+ y = foo(enumeration (x),
+ 2); #Beware: "enumeration" can also be a function!
+
+ x = data(:,2:end);
+ y = 'hello';
+ z = y';
+
+ ## Bug#14399.
+ vec = [...
+ one;...
+ two;...
+ three];
+
+ cnty = repmat(x(:,1)(:), 10, 1);
+ x = ...
+ 12
+
+ pop = x(:,1:10)(:);
+ ## Here and below, we test if the indentation aligns with a previous
+ ## fixindented line. This is important so as to make it easier for the
+ ## user to override some indentation somewhere, and also because it
+ ## reflects the fact that the indentation decision is taken with a minimum
+ ## amount of work (i.e. in the present case, without having to walk back
+ ## until the `function' line).
+ bir = x(:,11:20)(:); # fixindent
+ dth = x(:,21:30)(:);
+ imig = x(:,31:40)(:);
+ dmig = x(:,41:50)(:);
+ gq = x(:,51:60)(:);
+
+ yrs = repmat(2000:2009, 39, 1)(:);
+
+ res = [yrs, cnty, pop, bir, dth, imig, dmig, gq];
+
+endfunction
+
+## Copyright (C) 2005, 2006, 2007, 2008, 2009 Søren Hauberg
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or (at
+## your option) any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn {Command} pkg @var{command} @var{pkg_name}
+## @deftypefnx {Command} pkg @var{command} @var{option} @var{pkg_name}
+## This command interacts with the package manager. Different actions will
+## be taken depending on the value of @var{command}.
+##
+## @table @samp
+## @item install
+## Install named packages. For example,
+## @example
+## pkg install image-1.0.0.tar.gz
+## @end example
+## @noindent
+## installs the package found in the file @file{image-1.0.0.tar.gz}.
+##
+## The @var{option} variable can contain options that affect the manner
+## in which a package is installed. These options can be one or more of
+##
+## @table @code
+## @item -nodeps
+## The package manager will disable the dependency checking. That way it
+## is possible to install a package even if it depends on another package
+## that's not installed on the system. @strong{Use this option with care.}
+##
+## @item -noauto
+## The package manager will not automatically load the installed package
+## when starting Octave, even if the package requests that it is.
+##
+## @item -auto
+## The package manager will automatically load the installed package when
+## starting Octave, even if the package requests that it isn't.
+##
+## @item -local
+## A local installation is forced, even if the user has system privileges.
+##
+## @item -global
+## A global installation is forced, even if the user doesn't normally have
+## system privileges
+##
+## @item -verbose
+## The package manager will print the output of all of the commands that are
+## performed.
+## @end table
+##
+## @item uninstall
+## Uninstall named packages. For example,
+## @example
+## pkg uninstall image
+## @end example
+## @noindent
+## removes the @code{image} package from the system. If another installed
+## package depends on the @code{image} package an error will be issued.
+## The package can be uninstalled anyway by using the @code{-nodeps} option.
+## @item load
+## Add named packages to the path. After loading a package it is
+## possible to use the functions provided by the package. For example,
+## @example
+## pkg load image
+## @end example
+## @noindent
+## adds the @code{image} package to the path. It is possible to load all
+## installed packages at once with the command
+## @example
+## pkg load all
+## @end example
+## @item unload
+## Removes named packages from the path. After unloading a package it is
+## no longer possible to use the functions provided by the package.
+## This command behaves like the @code{load} command.
+## @item list
+## Show a list of the currently installed packages. By requesting one or two
+## output argument it is possible to get a list of the currently installed
+## packages. For example,
+## @example
+## installed_packages = pkg list;
+## @end example
+## @noindent
+## returns a cell array containing a structure for each installed package.
+## The command
+## @example
+## [@var{user_packages}, @var{system_packages}] = pkg list
+## @end example
+## @noindent
+## splits the list of installed packages into those who are installed by
+## the current user, and those installed by the system administrator.
+## @item describe
+## Show a short description of the named installed packages, with the option
+## '-verbose' also list functions provided by the package, e.g.:
+## @example
+## pkg describe -verbose all
+## @end example
+## @noindent
+## will describe all installed packages and the functions they provide.
+## If one output is requested a cell of structure containing the
+## description and list of functions of each package is returned as
+## output rather than printed on screen:
+## @example
+## desc = pkg ("describe", "secs1d", "image")
+## @end example
+## @noindent
+## If any of the requested packages is not installed, pkg returns an
+## error, unless a second output is requested:
+## @example
+## [ desc, flag] = pkg ("describe", "secs1d", "image")
+## @end example
+## @noindent
+## @var{flag} will take one of the values "Not installed", "Loaded" or
+## "Not loaded" for each of the named packages.
+## @item prefix
+## Set the installation prefix directory. For example,
+## @example
+## pkg prefix ~/my_octave_packages
+## @end example
+## @noindent
+## sets the installation prefix to @file{~/my_octave_packages}.
+## Packages will be installed in this directory.
+##
+## It is possible to get the current installation prefix by requesting an
+## output argument. For example,
+## @example
+## p = pkg prefix
+## @end example
+##
+## The location in which to install the architecture dependent files can be
+## independent specified with an addition argument. For example
+##
+## @example
+## pkg prefix ~/my_octave_packages ~/my_arch_dep_pkgs
+## @end example
+## @item local_list
+## Set the file in which to look for information on the locally
+## installed packages. Locally installed packages are those that are
+## typically available only to the current user. For example
+## @example
+## pkg local_list ~/.octave_packages
+## @end example
+## It is possible to get the current value of local_list with the following
+## @example
+## pkg local_list
+## @end example
+## @item global_list
+## Set the file in which to look for, for information on the globally
+## installed packages. Globally installed packages are those that are
+## typically available to all users. For example
+## @example
+## pkg global_list /usr/share/octave/octave_packages
+## @end example
+## It is possible to get the current value of global_list with the following
+## @example
+## pkg global_list
+## @end example
+## @item rebuild
+## Rebuilds the package database from the installed directories. This can
+## be used in cases where for some reason the package database is corrupted.
+## It can also take the @code{-auto} and @code{-noauto} options to allow the
+## autoloading state of a package to be changed. For example
+##
+## @example
+## pkg rebuild -noauto image
+## @end example
+##
+## will remove the autoloading status of the image package.
+## @item build
+## Builds a binary form of a package or packages. The binary file produced
+## will itself be an Octave package that can be installed normally with
+## @code{pkg}. The form of the command to build a binary package is
+##
+## @example
+## pkg build builddir image-1.0.0.tar.gz @dots{}
+## @end example
+##
+## @noindent
+## where @code{builddir} is the name of a directory where the temporary
+## installation will be produced and the binary packages will be found.
+## The options @code{-verbose} and @code{-nodeps} are respected, while
+## the other options are ignored.
+## @end table
+## @end deftypefn
+
+function [local_packages, global_packages] = pkg (varargin)
+ ## Installation prefix (FIXME: what should these be on windows?)
+ persistent user_prefix = false;
+ persistent prefix = -1;
+ persistent archprefix = -1;
+ persistent local_list = tilde_expand (fullfile ("~", ".octave_packages"));
+ persistent global_list = fullfile (OCTAVE_HOME (), "share", "octave",
+ "octave_packages");
+ mlock ();
+
+ global_install = issuperuser ();
+
+ if (prefix == -1)
+ if (global_install)
+ prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages");
+ archprefix = fullfile (octave_config_info ("libexecdir"),
+ "octave", "packages");
+ else
+ prefix = fullfile ("~", "octave");
+ archprefix = prefix;
+ endif
+ prefix = tilde_expand (prefix);
+ archprefix = tilde_expand (archprefix);
+ endif
+
+ available_actions = {"list", "install", "uninstall", "load", ...
+ "unload", "prefix", "local_list", ...
+ "global_list", "rebuild", "build","describe"};
+ ## Handle input
+ if (length (varargin) == 0 || ! iscellstr (varargin))
+ print_usage ();
+ endif
+ files = {};
+ deps = true;
+ auto = 0;
+ action = "none";
+ verbose = false;
+ for i = 1:length (varargin)
+ switch (varargin{i})
+ case "-nodeps"
+ deps = false;
+ case "-noauto"
+ auto = -1;
+ case "-auto"
+ auto = 1;
+ case "-verbose"
+ verbose = true;
+ case "-local"
+ global_install = false;
+ if (! user_prefix)
+ prefix = tilde_expand (fullfile ("~", "octave"));
+ archprefix = prefix;
+ endif
+ case "-global"
+ global_install = true;
+ if (! user_prefix)
+ prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages");
+ archprefix = fullfile (octave_config_info ("libexecdir"),
+ "octave", "packages");
+ endif
+ case available_actions
+ if (strcmp (action, "none"))
+ action = varargin{i};
+ else
+ error ("more than one action specified");
+ endif
+ otherwise
+ files{end+1} = varargin{i};
+ endswitch
+ endfor
+
+ ## Take action
+ switch (action)
+ case "list"
+ if (nargout == 0)
+ installed_packages (local_list, global_list);
+ elseif (nargout == 1)
+ local_packages = installed_packages (local_list, global_list);
+ elseif (nargout == 2)
+ [local_packages, global_packages] = installed_packages (local_list,
+ global_list);
+ else
+ error ("too many output arguments requested");
+ endif
+
+ case "install"
+ if (length (files) == 0)
+ error ("you must specify at least one filename when calling 'pkg install'");
+ endif
+ install (files, deps, auto, prefix, archprefix, verbose, local_list,
+ global_list, global_install);
+
+ case "uninstall"
+ if (length (files) == 0)
+ error ("you must specify at least one package when calling 'pkg uninstall'");
+ endif
+ uninstall (files, deps, verbose, local_list,
+ global_list, global_install);
+
+ case "load"
+ if (length (files) == 0)
+ error ("you must specify at least one package, 'all' or 'auto' when calling 'pkg load'");
+ endif
+ load_packages (files, deps, local_list, global_list);
+
+ case "unload"
+ if (length (files) == 0)
+ error ("you must specify at least one package or 'all' when calling 'pkg unload'");
+ endif
+ unload_packages (files, deps, local_list, global_list);
+
+ case "prefix"
+ if (length (files) == 0 && nargout == 0)
+ printf ("Installation prefix: %s\n", prefix);
+ printf ("Architecture dependent prefix: %s\n", archprefix);
+ elseif (length (files) == 0 && nargout >= 1)
+ local_packages = prefix;
+ global_packages = archprefix;
+ elseif (length (files) >= 1 && nargout <= 2 && ischar (files{1}))
+ prefix = files{1};
+ prefix = absolute_pathname (prefix);
+ local_packages = prefix;
+ user_prefix = true;
+ if (length (files) >= 2 && ischar (files{2}))
+ archprefix = files{2};
+ try
+ archprefix = absolute_pathname (archprefix);
+ catch
+ mkdir (archprefix);
+ warning ("creating the directory %s\n", archprefix);
+ archprefix = absolute_pathname (archprefix);
+ end_try_catch
+ global_packages = archprefix;
+ endif
+ else
+ error ("you must specify a prefix directory, or request an output argument");
+ endif
+
+ case "local_list"
+ if (length (files) == 0 && nargout == 0)
+ disp (local_list);
+ elseif (length (files) == 0 && nargout == 1)
+ local_packages = local_list;
+ elseif (length (files) == 1 && nargout == 0 && ischar (files{1}))
+ try
+ local_list = absolute_pathname (files{1});
+ catch
+ ## Force file to be created
+ fclose (fopen (files{1}, "wt"));
+ local_list = absolute_pathname (files{1});
+ end_try_catch
+ else
+ error ("you must specify a local_list file, or request an output argument");
+ endif
+
+ case "global_list"
+ if (length (files) == 0 && nargout == 0)
+ disp(global_list);
+ elseif (length (files) == 0 && nargout == 1)
+ local_packages = global_list;
+ elseif (length (files) == 1 && nargout == 0 && ischar (files{1}))
+ try
+ global_list = absolute_pathname (files{1});
+ catch
+ ## Force file to be created
+ fclose (fopen (files{1}, "wt"));
+ global_list = absolute_pathname (files{1});
+ end_try_catch
+ else
+ error ("you must specify a global_list file, or request an output argument");
+ endif
+
+ case "rebuild"
+ if (global_install)
+ global_packages = rebuild (prefix, archprefix, global_list, files,
+ auto, verbose);
+ global_packages = save_order (global_packages);
+ save (global_list, "global_packages");
+ if (nargout > 0)
+ local_packages = global_packages;
+ endif
+ else
+ local_packages = rebuild (prefix, archprefix, local_list, files, auto,
+ verbose);
+ local_packages = save_order (local_packages);
+ save (local_list, "local_packages");
+ if (nargout == 0)
+ clear ("local_packages");
+ endif
+ endif
+
+ case "build"
+ if (length (files) < 2)
+ error ("you must specify at least the build directory and one filename\nwhen calling 'pkg build'");
+ endif
+ build (files, deps, auto, verbose);
+
+ case "describe"
+ if (length (files) == 0)
+ error ("you must specify at least one package or 'all' when calling 'pkg describe'");
+ endif
+ ## FIXME: the name of the output variables is inconsistent
+ ## with their content
+ switch (nargout)
+ case 0
+ describe (files, verbose, local_list, global_list);
+ case 1
+ pkg_desc_list = describe (files, verbose, local_list, ...
+ global_list);
+ local_packages = pkg_desc_list;
+ case 2
+ [pkg_desc_list, flag] = describe (files, verbose, local_list, ...
+ global_list);
+ local_packages = pkg_desc_list;
+ global_packages = flag;
+ otherwise
+ error ("you can request at most two outputs when calling 'pkg describe'");
+ endswitch
+
+ otherwise
+ error ("you must specify a valid action for 'pkg'. See 'help pkg' for details");
+ endswitch
+endfunction
+
+function descriptions = rebuild (prefix, archprefix, list, files, auto, verbose)
+ if (isempty (files))
+ [dirlist, err, msg] = readdir (prefix);
+ if (err)
+ error ("couldn't read directory %s: %s", prefix, msg);
+ endif
+ ## the two first entries of dirlist are "." and ".."
+ dirlist([1,2]) = [];
+ else
+ old_descriptions = installed_packages (list, list);
+ wd = pwd ();
+ unwind_protect
+ cd (prefix);
+ dirlist = glob (cellfun(@(x) cstrcat(x, '-*'), files, 'UniformOutput', 0));
+ unwind_protect_cleanup
+ cd (wd);
+ end_unwind_protect
+ endif
+ descriptions = {};
+ for k = 1:length (dirlist)
+ descfile = fullfile (prefix, dirlist{k}, "packinfo", "DESCRIPTION");
+ if (verbose)
+ printf ("recreating package description from %s\n", dirlist{k});
+ endif
+ if (exist (descfile, "file"))
+ desc = get_description (descfile);
+ desc.dir = fullfile (prefix, dirlist{k});
+ desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-",
+ desc.version));
+ if (auto != 0)
+ if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file"))
+ unlink (fullfile (desc.dir, "packinfo", ".autoload"));
+ endif
+ if (auto < 0)
+ desc.autoload = 0;
+ elseif (auto > 0)
+ desc.autoload = 1;
+ fclose (fopen (fullfile (desc.dir, "packinfo", ".autoload"), "wt"));
+ endif
+ else
+ if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file"))
+ desc.autoload = 1;
+ else
+ desc.autoload = 0;
+ endif
+ endif
+ descriptions{end + 1} = desc;
+ elseif (verbose)
+ warning ("directory %s is not a valid package", dirlist{k});
+ endif
+ endfor
+
+ if (! isempty (files))
+ ## We are rebuilding for a particular package(s) so we should take
+ ## care to keep the other untouched packages in the descriptions
+ descriptions = {descriptions{:}, old_descriptions{:}};
+
+ dup = [];
+ for i = 1:length (descriptions)
+ if (find (dup, i))
+ continue;
+ endif
+ for j = (i+1):length (descriptions)
+ if (find (dup, j))
+ continue;
+ endif
+ if (strcmp (descriptions{i}.name, descriptions{j}.name))
+ dup = [dup, j];
+ endif
+ endfor
+ endfor
+ if (! isempty (dup))
+ descriptions (dup) = [];
+ endif
+ endif
+endfunction
+
+function build (files, handle_deps, autoload, verbose)
+ if (length (files) < 1)
+ error ("insufficient number of files");
+ endif
+ builddir = files{1};
+ if (! exist (builddir, "dir"))
+ warning ("creating build directory %s", builddir);
+ [status, msg] = mkdir (builddir);
+ if (status != 1)
+ error ("could not create installation directory: %s", msg);
+ endif
+ endif
+ builddir = absolute_pathname (builddir);
+ installdir = fullfile (builddir, "install");
+ if (! exist (installdir, "dir"))
+ [status, msg] = mkdir (installdir);
+ if (status != 1)
+ error ("could not create installation directory: %s", msg);
+ endif
+ endif
+ files(1) = [];
+ buildlist = fullfile (builddir, "octave_packages");
+ install (files, handle_deps, autoload, installdir, installdir, verbose,
+ buildlist, "", false);
+ unwind_protect
+ repackage (builddir, buildlist);
+ unwind_protect_cleanup
+ unload_packages ({"all"}, handle_deps, buildlist, "");
+ if (exist (installdir, "dir"))
+ rm_rf (installdir);
+ endif
+ if (exist (buildlist, "file"))
+ unlink (buildlist);
+ endif
+ end_unwind_protect
+endfunction
+
+function install (files, handle_deps, autoload, prefix, archprefix, verbose,
+ local_list, global_list, global_install)
+
+ ## Check that the directory in prefix exist. If it doesn't: create it!
+ if (! exist (prefix, "dir"))
+ warning ("creating installation directory %s", prefix);
+ [status, msg] = mkdir (prefix);
+ if (status != 1)
+ error ("could not create installation directory: %s", msg);
+ endif
+ endif
+
+ ## Get the list of installed packages.
+ [local_packages, global_packages] = installed_packages (local_list,
+ global_list);
+
+ installed_pkgs_lst = {local_packages{:}, global_packages{:}};
+
+ if (global_install)
+ packages = global_packages;
+ else
+ packages = local_packages;
+ endif
+
+ ## Uncompress the packages and read the DESCRIPTION files.
+ tmpdirs = packdirs = descriptions = {};
+ try
+ ## Warn about non existent files.
+ for i = 1:length (files)
+ if (isempty (glob(files{i})))
+ warning ("file %s does not exist", files{i});
+ endif
+ endfor
+
+ ## Unpack the package files and read the DESCRIPTION files.
+ files = glob (files);
+ packages_to_uninstall = [];
+ for i = 1:length (files)
+ tgz = files{i};
+
+ if (exist (tgz, "file"))
+ ## Create a temporary directory.
+ tmpdir = tmpnam ();
+ tmpdirs{end+1} = tmpdir;
+ if (verbose)
+ printf ("mkdir (%s)\n", tmpdir);
+ endif
+ [status, msg] = mkdir (tmpdir);
+ if (status != 1)
+ error ("couldn't create temporary directory: %s", msg);
+ endif
+
+ ## Uncompress the package.
+ if (verbose)
+ printf ("untar (%s, %s)\n", tgz, tmpdir);
+ endif
+ untar (tgz, tmpdir);
+
+ ## Get the name of the directories produced by tar.
+ [dirlist, err, msg] = readdir (tmpdir);
+ if (err)
+ error ("couldn't read directory produced by tar: %s", msg);
+ endif
+
+ if (length (dirlist) > 3)
+ error ("bundles of packages are not allowed")
+ endif
+ endif
+
+ ## The filename pointed to an uncompressed package to begin with.
+ if (exist (tgz, "dir"))
+ dirlist = {".", "..", tgz};
+ endif
+
+ if (exist (tgz, "file") || exist (tgz, "dir"))
+ ## The two first entries of dirlist are "." and "..".
+ if (exist (tgz, "file"))
+ packdir = fullfile (tmpdir, dirlist{3});
+ else
+ packdir = fullfile (pwd(), dirlist{3});
+ endif
+ packdirs{end+1} = packdir;
+
+ ## Make sure the package contains necessary files.
+ verify_directory (packdir);
+
+ ## Read the DESCRIPTION file.
+ filename = fullfile (packdir, "DESCRIPTION");
+ desc = get_description (filename);
+
+ ## Verify that package name corresponds with filename.
+ [dummy, nm] = fileparts (tgz);
+ if ((length (nm) >= length (desc.name))
+ && ! strcmp (desc.name, nm(1:length(desc.name))))
+ error ("package name '%s' doesn't correspond to its filename '%s'",
+ desc.name, nm);
+ endif
+
+ ## Set default installation directory.
+ desc.dir = fullfile (prefix, cstrcat (desc.name, "-", desc.version));
+
+ ## Set default architecture dependent installation directory.
+ desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-",
+ desc.version));
+
+ ## Save desc.
+ descriptions{end+1} = desc;
+
+ ## Are any of the new packages already installed?
+ ## If so we'll remove the old version.
+ for j = 1:length (packages)
+ if (strcmp (packages{j}.name, desc.name))
+ packages_to_uninstall(end+1) = j;
+ endif
+ endfor
+ endif
+ endfor
+ catch
+ ## Something went wrong, delete tmpdirs.
+ for i = 1:length (tmpdirs)
+ rm_rf (tmpdirs{i});
+ endfor
+ rethrow (lasterror ());
+ end_try_catch
+
+ ## Check dependencies.
+ if (handle_deps)
+ ok = true;
+ error_text = "";
+ for i = 1:length (descriptions)
+ desc = descriptions{i};
+ idx2 = complement (i, 1:length(descriptions));
+ if (global_install)
+ ## Global installation is not allowed to have dependencies on locally
+ ## installed packages.
+ idx1 = complement (packages_to_uninstall,
+ 1:length(global_packages));
+ pseudo_installed_packages = {global_packages{idx1}, ...
+ descriptions{idx2}};
+ else
+ idx1 = complement (packages_to_uninstall,
+ 1:length(local_packages));
+ pseudo_installed_packages = {local_packages{idx1}, ...
+ global_packages{:}, ...
+ descriptions{idx2}};
+ endif
+ bad_deps = get_unsatisfied_deps (desc, pseudo_installed_packages);
+ ## Are there any unsatisfied dependencies?
+ if (! isempty (bad_deps))
+ ok = false;
+ for i = 1:length (bad_deps)
+ dep = bad_deps{i};
+ error_text = cstrcat (error_text, " ", desc.name, " needs ",
+ dep.package, " ", dep.operator, " ",
+ dep.version, "\n");
+ endfor
+ endif
+ endfor
+
+ ## Did we find any unsatisfied dependencies?
+ if (! ok)
+ error ("the following dependencies where unsatisfied:\n %s", error_text);
+ endif
+ endif
+
+ ## Prepare each package for installation.
+ try
+ for i = 1:length (descriptions)
+ desc = descriptions{i};
+ pdir = packdirs{i};
+ prepare_installation (desc, pdir);
+ configure_make (desc, pdir, verbose);
+ endfor
+ catch
+ ## Something went wrong, delete tmpdirs.
+ for i = 1:length (tmpdirs)
+ rm_rf (tmpdirs{i});
+ endfor
+ rethrow (lasterror ());
+ end_try_catch
+
+ ## Uninstall the packages that will be replaced.
+ try
+ for i = packages_to_uninstall
+ if (global_install)
+ uninstall ({global_packages{i}.name}, false, verbose, local_list,
+ global_list, global_install);
+ else
+ uninstall ({local_packages{i}.name}, false, verbose, local_list,
+ global_list, global_install);
+ endif
+ endfor
+ catch
+ ## Something went wrong, delete tmpdirs.
+ for i = 1:length (tmpdirs)
+ rm_rf (tmpdirs{i});
+ endfor
+ rethrow (lasterror ());
+ end_try_catch
+
+ ## Install each package.
+ try
+ for i = 1:length (descriptions)
+ desc = descriptions{i};
+ pdir = packdirs{i};
+ copy_files (desc, pdir, global_install);
+ create_pkgadddel (desc, pdir, "PKG_ADD", global_install);
+ create_pkgadddel (desc, pdir, "PKG_DEL", global_install);
+ finish_installation (desc, pdir, global_install);
+ generate_lookfor_cache (desc);
+ endfor
+ catch
+ ## Something went wrong, delete tmpdirs.
+ for i = 1:length (tmpdirs)
+ rm_rf (tmpdirs{i});
+ endfor
+ for i = 1:length (descriptions)
+ rm_rf (descriptions{i}.dir);
+ rm_rf (getarchdir (descriptions{i}));
+ endfor
+ rethrow (lasterror ());
+ end_try_catch
+
+ ## Check if the installed directory is empty. If it is remove it
+ ## from the list.
+ for i = length (descriptions):-1:1
+ if (dirempty (descriptions{i}.dir, {"packinfo", "doc"}) &&
+ dirempty (getarchdir (descriptions{i})))
+ warning ("package %s is empty\n", descriptions{i}.name);
+ rm_rf (descriptions{i}.dir);
+ rm_rf (getarchdir (descriptions{i}));
+ descriptions(i) = [];
+ endif
+ endfor
+
+ ## If the package requested that it is autoloaded, or the installer
+ ## requested that it is, then mark the package as autoloaded.
+ for i = length (descriptions):-1:1
+ if (autoload > 0 || (autoload == 0 && isautoload (descriptions(i))))
+ fclose (fopen (fullfile (descriptions{i}.dir, "packinfo",
+ ".autoload"), "wt"));
+ descriptions{i}.autoload = 1;
+ endif
+ endfor
+
+ ## Add the packages to the package list.
+ try
+ if (global_install)
+ idx = complement (packages_to_uninstall, 1:length(global_packages));
+ global_packages = save_order ({global_packages{idx}, descriptions{:}});
+ save (global_list, "global_packages");
+ installed_pkgs_lst = {local_packages{:}, global_packages{:}};
+ else
+ idx = complement (packages_to_uninstall, 1:length(local_packages));
+ local_packages = save_order ({local_packages{idx}, descriptions{:}});
+ save (local_list, "local_packages");
+ installed_pkgs_lst = {local_packages{:}, global_packages{:}};
+ endif
+ catch
+ ## Something went wrong, delete tmpdirs.
+ for i = 1:length (tmpdirs)
+ rm_rf (tmpdirs{i});
+ endfor
+ for i = 1:length (descriptions)
+ rm_rf (descriptions{i}.dir);
+ endfor
+ if (global_install)
+ printf ("error: couldn't append to %s\n", global_list);
+ else
+ printf ("error: couldn't append to %s\n", local_list);
+ endif
+ rethrow (lasterror ());
+ end_try_catch
+
+ ## All is well, let's clean up.
+ for i = 1:length (tmpdirs)
+ [status, msg] = rm_rf (tmpdirs{i});
+ if (status != 1)
+ warning ("couldn't clean up after my self: %s\n", msg);
+ endif
+ endfor
+
+ ## Add the newly installed packages to the path, so the user
+ ## can begin using them. Only load them if they are marked autoload.
+ if (length (descriptions) > 0)
+ idx = [];
+ for i = 1:length (descriptions)
+ if (isautoload (descriptions(i)))
+ nm = descriptions{i}.name;
+ for j = 1:length (installed_pkgs_lst)
+ if (strcmp (nm, installed_pkgs_lst{j}.name))
+ idx (end + 1) = j;
+ break;
+ endif
+ endfor
+ endif
+ endfor
+ load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst,
+ global_install);
+ endif
+endfunction
+
+function uninstall (pkgnames, handle_deps, verbose, local_list,
+ global_list, global_install)
+ ## Get the list of installed packages.
+ [local_packages, global_packages] = installed_packages(local_list,
+ global_list);
+ if (global_install)
+ installed_pkgs_lst = {local_packages{:}, global_packages{:}};
+ else
+ installed_pkgs_lst = local_packages;
+ endif
+
+ num_packages = length (installed_pkgs_lst);
+ delete_idx = [];
+ for i = 1:num_packages
+ cur_name = installed_pkgs_lst{i}.name;
+ if (any (strcmp (cur_name, pkgnames)))
+ delete_idx(end+1) = i;
+ endif
+ endfor
+
+ ## Are all the packages that should be uninstalled already installed?
+ if (length (delete_idx) != length (pkgnames))
+ if (global_install)
+ ## Try again for a locally installed package.
+ installed_pkgs_lst = local_packages;
+
+ num_packages = length (installed_pkgs_lst);
+ delete_idx = [];
+ for i = 1:num_packages
+ cur_name = installed_pkgs_lst{i}.name;
+ if (any (strcmp (cur_name, pkgnames)))
+ delete_idx(end+1) = i;
+ endif
+ endfor
+ if (length (delete_idx) != length (pkgnames))
+ ## FIXME: We should have a better error message.
+ warning ("some of the packages you want to uninstall are not installed");
+ endif
+ else
+ ## FIXME: We should have a better error message.
+ warning ("some of the packages you want to uninstall are not installed");
+ endif
+ endif
+
+ ## Compute the packages that will remain installed.
+ idx = complement (delete_idx, 1:num_packages);
+ remaining_packages = {installed_pkgs_lst{idx}};
+
+ ## Check dependencies.
+ if (handle_deps)
+ error_text = "";
+ for i = 1:length (remaining_packages)
+ desc = remaining_packages{i};
+ bad_deps = get_unsatisfied_deps (desc, remaining_packages);
+
+ ## Will the uninstallation break any dependencies?
+ if (! isempty (bad_deps))
+ for i = 1:length (bad_deps)
+ dep = bad_deps{i};
+ error_text = cstrcat (error_text, " ", desc.name, " needs ",
+ dep.package, " ", dep.operator, " ",
+ dep.version, "\n");
+ endfor
+ endif
+ endfor
+
+ if (! isempty (error_text))
+ error ("the following dependencies where unsatisfied:\n %s", error_text);
+ endif
+ endif
+
+ ## Delete the directories containing the packages.
+ for i = delete_idx
+ desc = installed_pkgs_lst{i};
+ ## If an 'on_uninstall.m' exist, call it!
+ if (exist (fullfile (desc.dir, "packinfo", "on_uninstall.m"), "file"))
+ wd = pwd ();
+ cd (fullfile (desc.dir, "packinfo"));
+ on_uninstall (desc);
+ cd (wd);
+ endif
+ ## Do the actual deletion.
+ if (desc.loaded)
+ rmpath (desc.dir);
+ if (exist (getarchdir (desc)))
+ rmpath (getarchdir (desc));
+ endif
+ endif
+ if (exist (desc.dir, "dir"))
+ [status, msg] = rm_rf (desc.dir);
+ if (status != 1)
+ error ("couldn't delete directory %s: %s", desc.dir, msg);
+ endif
+ [status, msg] = rm_rf (getarchdir (desc));
+ if (status != 1)
+ error ("couldn't delete directory %s: %s", getarchdir (desc), msg);
+ endif
+ if (dirempty (desc.archprefix))
+ rm_rf (desc.archprefix);
+ endif
+ else
+ warning ("directory %s previously lost", desc.dir);
+ endif
+ endfor
+
+ ## Write a new ~/.octave_packages.
+ if (global_install)
+ if (length (remaining_packages) == 0)
+ unlink (global_list);
+ else
+ global_packages = save_order (remaining_packages);
+ save (global_list, "global_packages");
+ endif
+ else
+ if (length (remaining_packages) == 0)
+ unlink (local_list);
+ else
+ local_packages = save_order (remaining_packages);
+ save (local_list, "local_packages");
+ endif
+ endif
+
+endfunction
+
+function [pkg_desc_list, flag] = describe (pkgnames, verbose,
+ local_list, global_list)
+
+ ## Get the list of installed packages.
+ installed_pkgs_lst = installed_packages(local_list, global_list);
+ num_packages = length (installed_pkgs_lst);
+
+
+ describe_all = false;
+ if (any (strcmp ("all", pkgnames)))
+ describe_all = true;
+ flag(1:num_packages) = {"Not Loaded"};
+ num_pkgnames = num_packages;
+ else
+ num_pkgnames = length (pkgnames);
+ flag(1:num_pkgnames) = {"Not installed"};
+ endif
+
+ for i = 1:num_packages
+ curr_name = installed_pkgs_lst{i}.name;
+ if (describe_all)
+ name_pos = i;
+ else
+ name_pos = find(strcmp (curr_name, pkgnames));
+ endif
+
+ if (! isempty (name_pos))
+ if (installed_pkgs_lst{i}.loaded)
+ flag{name_pos} = "Loaded";
+ else
+ flag{name_pos} = "Not loaded";
+ endif
+
+ pkg_desc_list{name_pos}.name = installed_pkgs_lst{i}.name;
+ pkg_desc_list{name_pos}.version = installed_pkgs_lst{i}.version;
+ pkg_desc_list{name_pos}.description = installed_pkgs_lst{i}.description;
+ pkg_desc_list{name_pos}.provides = parse_pkg_idx (installed_pkgs_lst{i}.dir);
+
+ endif
+ endfor
+
+ non_inst = find (strcmp (flag, "Not installed"));
+ if (! isempty (non_inst))
+ if (nargout < 2)
+ non_inst_str = sprintf (" %s ", pkgnames{non_inst});
+ error ("some packages are not installed: %s", non_inst_str);
+ else
+ pkg_desc_list{non_inst} = struct ("name", {}, "description",
+ {}, "provides", {});
+ endif
+ endif
+
+ if (nargout == 0)
+ for i = 1:num_pkgnames
+ print_package_description (pkg_desc_list{i}.name,
+ pkg_desc_list{i}.version,
+ pkg_desc_list{i}.provides,
+ pkg_desc_list{i}.description,
+ flag{i}, verbose);
+ endfor
+ endif
+
+endfunction
+
+## AUXILIARY FUNCTIONS
+
+## Read an INDEX file.
+function [pkg_idx_struct] = parse_pkg_idx (packdir)
+
+ index_file = fullfile (packdir, "packinfo", "INDEX");
+
+ if (! exist (index_file, "file"))
+ error ("could not find any INDEX file in directory %s, try 'pkg rebuild all' to generate missing INDEX files", packdir);
+ endif
+
+
+ [fid, msg] = fopen (index_file, "r");
+ if (fid == -1)
+ error ("the INDEX file %s could not be read: %s",
+ index_file, msg);
+ endif
+
+ cat_num = 1;
+ pkg_idx_struct{1}.category = "Uncategorized";
+ pkg_idx_struct{1}.functions = {};
+
+ line = fgetl (fid);
+ while (isempty (strfind (line, ">>")) && ! feof (fid))
+ line = fgetl (fid);
+ endwhile
+
+ while (! feof (fid) || line != -1)
+ if (! any (! isspace (line)) || line(1) == "#" || any (line == "="))
+ ## Comments, blank lines or comments about unimplemented
+ ## functions: do nothing
+ ## FIXME: probably comments and pointers to external functions
+ ## could be treated better when printing to screen?
+ elseif (! isempty (strfind (line, ">>")))
+ ## Skip package name and description as they are in DESCRIPTION
+ ## already.
+ elseif (! isspace (line(1)))
+ ## Category.
+ if (! isempty (pkg_idx_struct{cat_num}.functions))
+ pkg_idx_struct{++cat_num}.functions = {};
+ endif
+ pkg_idx_struct{cat_num}.category = deblank (line);
+ else
+ ## Function names.
+ while (any (! isspace (line)))
+ [fun_name, line] = strtok (line);
+ pkg_idx_struct{cat_num}.functions{end+1} = deblank (fun_name);
+ endwhile
+ endif
+ line = fgetl (fid);
+ endwhile
+ fclose (fid);
+endfunction
+
+function print_package_description (pkg_name, pkg_ver, pkg_idx_struct,
+ pkg_desc, status, verbose)
+
+ printf ("---\nPackage name:\n\t%s\n", pkg_name);
+ printf ("Version:\n\t%s\n", pkg_ver);
+ printf ("Short description:\n\t%s\n", pkg_desc);
+ printf ("Status:\n\t%s\n", status);
+ if (verbose)
+ printf ("---\nProvides:\n");
+ for i = 1:length(pkg_idx_struct)
+ if (! isempty (pkg_idx_struct{i}.functions))
+ printf ("%s\n", pkg_idx_struct{i}.category);
+ for j = 1:length(pkg_idx_struct{i}.functions)
+ printf ("\t%s\n", pkg_idx_struct{i}.functions{j});
+ endfor
+ endif
+ endfor
+ endif
+
+endfunction
+
+
+function pth = absolute_pathname (pth)
+ [status, msg, msgid] = fileattrib (pth);
+ if (status != 1)
+ error ("could not find the file or path %s", pth);
+ else
+ pth = msg.Name;
+ endif
+endfunction
+
+function repackage (builddir, buildlist)
+ packages = installed_packages (buildlist, buildlist);
+
+ wd = pwd();
+ for i = 1 : length(packages)
+ pack = packages{i};
+ unwind_protect
+ cd (builddir);
+ mkdir (pack.name);
+ mkdir (fullfile (pack.name, "inst"));
+ copyfile (fullfile (pack.dir, "*"), fullfile (pack.name, "inst"));
+ movefile (fullfile (pack.name, "inst","packinfo", "*"), pack.name);
+ if (exist (fullfile (pack.name, "inst","packinfo", ".autoload"), "file"))
+ unlink (fullfile (pack.name, "inst","packinfo", ".autoload"));
+ endif
+ rmdir (fullfile (pack.name, "inst", "packinfo"));
+ if (exist (fullfile (pack.name, "inst", "doc"), "dir"))
+ movefile (fullfile (pack.name, "inst", "doc"), pack.name);
+ endif
+ if (exist (fullfile (pack.name, "inst", "bin"), "dir"))
+ movefile (fullfile (pack.name, "inst", "bin"), pack.name);
+ endif
+ archdir = fullfile (pack.archprefix, cstrcat (pack.name, "-",
+ pack.version), getarch ());
+ if (exist (archdir, "dir"))
+ if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file"))
+ unlink (fullfile (pack.name, "inst", "PKG_ADD"));
+ endif
+ if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file"))
+ unlink (fullfile (pack.name, "inst", "PKG_DEL"));
+ endif
+ if (exist (fullfile (archdir, "PKG_ADD"), "file"))
+ movefile (fullfile (archdir, "PKG_ADD"),
+ fullfile (pack.name, "PKG_ADD"));
+ endif
+ if (exist (fullfile (archdir, "PKG_DEL"), "file"))
+ movefile (fullfile (archdir, "PKG_DEL"),
+ fullfile (pack.name, "PKG_DEL"));
+ endif
+ else
+ if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file"))
+ movefile (fullfile (pack.name, "inst", "PKG_ADD"),
+ fullfile (pack.name, "PKG_ADD"));
+ endif
+ if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file"))
+ movefile (fullfile (pack.name, "inst", "PKG_DEL"),
+ fullfile (pack.name, "PKG_DEL"));
+ endif
+ endif
+ tfile = cstrcat (pack.name, "-", pack.version, ".tar");
+ tar (tfile, pack.name);
+ try
+ gzip (tfile);
+ unlink (tfile);
+ catch
+ warning ("failed to compress %s", tfile);
+ end_try_catch
+ unwind_protect_cleanup
+ if (exist (pack.name, "dir"))
+ rm_rf (pack.name);
+ endif
+ cd (wd);
+ end_unwind_protect
+ endfor
+endfunction
+
+function auto = isautoload (desc)
+ auto = false;
+ if (isfield (desc{1}, "autoload"))
+ a = desc{1}.autoload;
+ if ((isnumeric (a) && a > 0)
+ || (ischar (a) && (strcmpi (a, "true")
+ || strcmpi (a, "on")
+ || strcmpi (a, "yes")
+ || strcmpi (a, "1"))))
+ auto = true;
+ endif
+ endif
+endfunction
+
+function prepare_installation (desc, packdir)
+ ## Is there a pre_install to call?
+ if (exist (fullfile (packdir, "pre_install.m"), "file"))
+ wd = pwd ();
+ try
+ cd (packdir);
+ pre_install (desc);
+ cd (wd);
+ catch
+ cd (wd);
+ rethrow (lasterror ());
+ end_try_catch
+ endif
+
+ ## If the directory "inst" doesn't exist, we create it.
+ inst_dir = fullfile (packdir, "inst");
+ if (! exist (inst_dir, "dir"))
+ [status, msg] = mkdir (inst_dir);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("the 'inst' directory did not exist and could not be created: %s",
+ msg);
+ endif
+ endif
+endfunction
+
+function configure_make (desc, packdir, verbose)
+ ## Perform ./configure, make, make install in "src".
+ if (exist (fullfile (packdir, "src"), "dir"))
+ src = fullfile (packdir, "src");
+ ## Configure.
+ if (exist (fullfile (src, "configure"), "file"))
+ flags = "";
+ if (isempty (getenv ("CC")))
+ flags = cstrcat (flags, " CC=\"", octave_config_info ("CC"), "\"");
+ endif
+ if (isempty (getenv ("CXX")))
+ flags = cstrcat (flags, " CXX=\"", octave_config_info ("CXX"), "\"");
+ endif
+ if (isempty (getenv ("AR")))
+ flags = cstrcat (flags, " AR=\"", octave_config_info ("AR"), "\"");
+ endif
+ if (isempty (getenv ("RANLIB")))
+ flags = cstrcat (flags, " RANLIB=\"", octave_config_info ("RANLIB"), "\"");
+ endif
+ [status, output] = shell (strcat ("cd '", src, "'; ./configure --prefix=\"",
+ desc.dir, "\"", flags));
+ if (status != 0)
+ rm_rf (desc.dir);
+ error ("the configure script returned the following error: %s", output);
+ elseif (verbose)
+ printf("%s", output);
+ endif
+
+ endif
+
+ ## Make.
+ if (exist (fullfile (src, "Makefile"), "file"))
+ [status, output] = shell (cstrcat ("export INSTALLDIR=\"", desc.dir,
+ "\"; make -C '", src, "'"));
+ if (status != 0)
+ rm_rf (desc.dir);
+ error ("'make' returned the following error: %s", output);
+ elseif (verbose)
+ printf("%s", output);
+ endif
+ endif
+
+ ## Copy files to "inst" and "inst/arch" (this is instead of 'make
+ ## install').
+ files = fullfile (src, "FILES");
+ instdir = fullfile (packdir, "inst");
+ archdir = fullfile (packdir, "inst", getarch ());
+
+ ## Get file names.
+ if (exist (files, "file"))
+ [fid, msg] = fopen (files, "r");
+ if (fid < 0)
+ error ("couldn't open %s: %s", files, msg);
+ endif
+ filenames = char (fread (fid))';
+ fclose (fid);
+ if (filenames(end) == "\n")
+ filenames(end) = [];
+ endif
+ filenames = split_by (filenames, "\n");
+ delete_idx = [];
+ for i = 1:length (filenames)
+ if (! all (isspace (filenames{i})))
+ filenames{i} = fullfile (src, filenames{i});
+ else
+ delete_idx(end+1) = i;
+ endif
+ endfor
+ filenames(delete_idx) = [];
+ else
+ m = dir (fullfile (src, "*.m"));
+ oct = dir (fullfile (src, "*.oct"));
+ mex = dir (fullfile (src, "*.mex"));
+
+ filenames = cellfun (@(x) fullfile (src, x),
+ {m.name, oct.name, mex.name},
+ "UniformOutput", false);
+ endif
+
+ ## Split into architecture dependent and independent files.
+ if (isempty (filenames))
+ idx = [];
+ else
+ idx = cellfun (@is_architecture_dependent, filenames);
+ endif
+ archdependent = filenames (idx);
+ archindependent = filenames (!idx);
+
+ ## Copy the files.
+ if (! all (isspace ([filenames{:}])))
+ if (! exist (instdir, "dir")) # fixindent
+ mkdir (instdir);
+ endif
+ if (! all (isspace ([archindependent{:}])))
+ if (verbose)
+ printf ("copyfile");
+ printf (" %s", archindependent{:});
+ printf ("%s\n", instdir);
+ endif
+ [status, output] = copyfile (archindependent, instdir);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("Couldn't copy files from 'src' to 'inst': %s", output);
+ endif
+ endif
+ if (! all (isspace ([archdependent{:}])))
+ if (verbose)
+ printf ("copyfile");
+ printf (" %s", archdependent{:});
+ printf (" %s\n", archdir);
+ endif
+ if (! exist (archdir, "dir"))
+ mkdir (archdir);
+ endif
+ [status, output] = copyfile (archdependent, archdir);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("Couldn't copy files from 'src' to 'inst': %s", output);
+ endif
+ endif
+ endif
+ endif
+endfunction
+
+function pkg = extract_pkg (nm, pat)
+ fid = fopen (nm, "rt");
+ pkg = "";
+ if (fid >= 0)
+ while (! feof (fid))
+ ln = fgetl (fid);
+ if (ln > 0)
+ t = regexp (ln, pat, "tokens");
+ if (! isempty (t))
+ pkg = cstrcat (pkg, "\n", t{1}{1});
+ endif
+ endif
+ endwhile
+ if (! isempty (pkg))
+ pkg = cstrcat (pkg, "\n");
+ endif
+ fclose (fid);
+ endif
+endfunction
+
+function create_pkgadddel (desc, packdir, nm, global_install)
+ instpkg = fullfile (desc.dir, nm);
+ instfid = fopen (instpkg, "wt");
+ ## If it is exists, most of the PKG_* file should go into the
+ ## architecture dependent directory so that the autoload/mfilename
+ ## commands work as expected. The only part that doesn't is the
+ ## part in the main directory.
+ archdir = fullfile (getarchprefix (desc), cstrcat (desc.name, "-",
+ desc.version), getarch ());
+ if (exist (getarchdir (desc, global_install), "dir"))
+ archpkg = fullfile (getarchdir (desc, global_install), nm);
+ archfid = fopen (archpkg, "at");
+ else
+ archpkg = instpkg;
+ archfid = instfid;
+ endif
+
+ if (archfid >= 0 && instfid >= 0)
+ ## Search all dot-m files for PKG commands.
+ lst = dir (fullfile (packdir, "inst", "*.m"));
+ for i = 1:length (lst)
+ nam = fullfile (packdir, "inst", lst(i).name);
+ fwrite (instfid, extract_pkg (nam, ['^[#%][#%]* *' nm ': *(.*)$']));
+ endfor
+
+ ## Search all C++ source files for PKG commands.
+ lst = dir (fullfile (packdir, "src", "*.cc"));
+ for i = 1:length (lst)
+ nam = fullfile (packdir, "src", lst(i).name);
+ fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$']));
+ fwrite (archfid, extract_pkg (nam, ['^/\** *' nm ': *(.*) *\*/$']));
+ endfor
+
+ ## Add developer included PKG commands.
+ packdirnm = fullfile (packdir, nm);
+ if (exist (packdirnm, "file"))
+ fid = fopen (packdirnm, "rt");
+ if (fid >= 0)
+ while (! feof (fid))
+ ln = fgets (fid);
+ if (ln > 0)
+ fwrite (archfid, ln);
+ endif
+ endwhile
+ fclose (fid);
+ endif
+ endif
+
+ ## If the files is empty remove it.
+ fclose (instfid);
+ t = dir (instpkg);
+ if (t.bytes <= 0)
+ unlink (instpkg);
+ endif
+
+ if (instfid != archfid)
+ fclose (archfid);
+ t = dir (archpkg);
+ if (t.bytes <= 0)
+ unlink (archpkg);
+ endif
+ endif
+ endif
+endfunction
+
+function copy_files (desc, packdir, global_install)
+ ## Create the installation directory.
+ if (! exist (desc.dir, "dir"))
+ [status, output] = mkdir (desc.dir);
+ if (status != 1)
+ error ("couldn't create installation directory %s : %s",
+ desc.dir, output);
+ endif
+ endif
+
+ octfiledir = getarchdir (desc);
+
+ ## Copy the files from "inst" to installdir.
+ instdir = fullfile (packdir, "inst");
+ if (! dirempty (instdir))
+ [status, output] = copyfile (fullfile (instdir, "*"), desc.dir);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("couldn't copy files to the installation directory");
+ endif
+ if (exist (fullfile (desc.dir, getarch ()), "dir") &&
+ ! strcmp (fullfile (desc.dir, getarch ()), octfiledir))
+ if (! exist (octfiledir, "dir"))
+ ## Can be required to create upto three levels of dirs.
+ octm1 = fileparts (octfiledir);
+ if (! exist (octm1, "dir"))
+ octm2 = fileparts (octm1);
+ if (! exist (octm2, "dir"))
+ octm3 = fileparts (octm2);
+ if (! exist (octm3, "dir"))
+ [status, output] = mkdir (octm3);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("couldn't create installation directory %s : %s",
+ octm3, output);
+ endif
+ endif
+ [status, output] = mkdir (octm2);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("couldn't create installation directory %s : %s",
+ octm2, output);
+ endif
+ endif
+ [status, output] = mkdir (octm1);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("couldn't create installation directory %s : %s",
+ octm1, output);
+ endif
+ endif
+ [status, output] = mkdir (octfiledir);
+ if (status != 1)
+ rm_rf (desc.dir);
+ error ("couldn't create installation directory %s : %s",
+ octfiledir, output);
+ endif
+ endif
+ [status, output] = movefile (fullfile (desc.dir, getarch (), "*"),
+ octfiledir);
+ rm_rf (fullfile (desc.dir, getarch ()));
+
+ if (status != 1)
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ error ("couldn't copy files to the installation directory");
+ endif
+ endif
+
+ endif
+
+ ## Create the "packinfo" directory.
+ packinfo = fullfile (desc.dir, "packinfo");
+ [status, msg] = mkdir (packinfo);
+ if (status != 1)
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ error ("couldn't create packinfo directory: %s", msg);
+ endif
+
+ ## Copy DESCRIPTION.
+ [status, output] = copyfile (fullfile (packdir, "DESCRIPTION"), packinfo);
+ if (status != 1)
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ error ("couldn't copy DESCRIPTION: %s", output);
+ endif
+
+ ## Copy COPYING.
+ [status, output] = copyfile (fullfile (packdir, "COPYING"), packinfo);
+ if (status != 1)
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ error ("couldn't copy COPYING: %s", output);
+ endif
+
+ ## If the file ChangeLog exists, copy it.
+ changelog_file = fullfile (packdir, "ChangeLog");
+ if (exist (changelog_file, "file"))
+ [status, output] = copyfile (changelog_file, packinfo);
+ if (status != 1)
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ error ("couldn't copy ChangeLog file: %s", output);
+ endif
+ endif
+
+ ## Is there an INDEX file to copy or should we generate one?
+ index_file = fullfile (packdir, "INDEX");
+ if (exist(index_file, "file"))
+ [status, output] = copyfile (index_file, packinfo);
+ if (status != 1)
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ error ("couldn't copy INDEX file: %s", output);
+ endif
+ else
+ try
+ write_index (desc, fullfile (packdir, "inst"),
+ fullfile (packinfo, "INDEX"), global_install);
+ catch
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ rethrow (lasterror ());
+ end_try_catch
+ endif
+
+ ## Is there an 'on_uninstall.m' to install?
+ fon_uninstall = fullfile (packdir, "on_uninstall.m");
+ if (exist (fon_uninstall, "file"))
+ [status, output] = copyfile (fon_uninstall, packinfo);
+ if (status != 1)
+ rm_rf (desc.dir);
+ rm_rf (octfiledir);
+ error ("couldn't copy on_uninstall.m: %s", output);
+ endif
+ endif
+
+ ## Is there a doc/ directory that needs to be installed?
+ docdir = fullfile (packdir, "doc");
+ if (exist (docdir, "dir") && ! dirempty (docdir))
+ [status, output] = copyfile (docdir, desc.dir);
+ endif
+
+ ## Is there a bin/ directory that needs to be installed?
+ ## FIXME: Need to treat architecture dependent files in bin/
+ bindir = fullfile (packdir, "bin");
+ if (exist (bindir, "dir") && ! dirempty (bindir))
+ [status, output] = copyfile (bindir, desc.dir);
+ endif
+endfunction
+
+function finish_installation (desc, packdir, global_install)
+ ## Is there a post-install to call?
+ if (exist (fullfile (packdir, "post_install.m"), "file"))
+ wd = pwd ();
+ try
+ cd (packdir);
+ post_install (desc);
+ cd (wd);
+ catch
+ cd (wd);
+ rm_rf (desc.dir);
+ rm_rf (getarchdir (desc), global_install);
+ rethrow (lasterror ());
+ end_try_catch
+ endif
+endfunction
+
+function generate_lookfor_cache (desc)
+ dirs = split_by (genpath (desc.dir), pathsep ());
+ for i = 1 : length (dirs)
+ gen_doc_cache (fullfile (dirs{i}, "doc-cache"), dirs{i});
+ endfor
+endfunction
+
+## Make sure the package contains the essential files.
+function verify_directory (dir)
+ needed_files = {"COPYING", "DESCRIPTION"};
+ for f = needed_files
+ if (! exist (fullfile (dir, f{1}), "file"))
+ error ("package is missing file: %s", f{1});
+ endif
+ endfor
+endfunction
+
+## Parse the DESCRIPTION file.
+function desc = get_description (filename)
+ [fid, msg] = fopen (filename, "r");
+ if (fid == -1)
+ error ("the DESCRIPTION file %s could not be read: %s", filename, msg);
+ endif
+
+ desc = struct ();
+
+ line = fgetl (fid);
+ while (line != -1)
+ if (line(1) == "#")
+ ## Comments, do nothing.
+ elseif (isspace(line(1)))
+ ## Continuation lines
+ if (exist ("keyword", "var") && isfield (desc, keyword))
+ desc.(keyword) = cstrcat (desc.(keyword), " ", rstrip(line));
+ endif
+ else
+ ## Keyword/value pair
+ colon = find (line == ":");
+ if (length (colon) == 0)
+ disp ("skipping line");
+ else
+ colon = colon(1);
+ keyword = tolower (strip (line(1:colon-1)));
+ value = strip (line (colon+1:end));
+ if (length (value) == 0)
+ fclose (fid);
+ error ("the keyword %s has an empty value", desc.keywords{end});
+ endif
+ desc.(keyword) = value;
+ endif
+ endif
+ line = fgetl (fid);
+ endwhile
+ fclose (fid);
+
+ ## Make sure all is okay.
+ needed_fields = {"name", "version", "date", "title", ...
+ "author", "maintainer", "description"};
+ for f = needed_fields
+ if (! isfield (desc, f{1}))
+ error ("description is missing needed field %s", f{1});
+ endif
+ endfor
+ desc.version = fix_version (desc.version);
+ if (isfield (desc, "depends"))
+ desc.depends = fix_depends (desc.depends);
+ else
+ desc.depends = "";
+ endif
+ desc.name = tolower (desc.name);
+endfunction
+
+## Make sure the version string v is a valid x.y.z version string
+## Examples: "0.1" => "0.1.0", "monkey" => error(...).
+function out = fix_version (v)
+ dots = find (v == ".");
+ if (length (dots) == 1)
+ major = str2num (v(1:dots-1));
+ minor = str2num (v(dots+1:end));
+ if (length (major) != 0 && length (minor) != 0)
+ out = sprintf ("%d.%d.0", major, minor);
+ return;
+ endif
+ elseif (length (dots) == 2)
+ major = str2num (v(1:dots(1)-1));
+ minor = str2num (v(dots(1)+1:dots(2)-1));
+ rev = str2num (v(dots(2)+1:end));
+ if (length (major) != 0 && length (minor) != 0 && length (rev) != 0)
+ out = sprintf ("%d.%d.%d", major, minor, rev);
+ return;
+ endif
+ endif
+ error ("bad version string: %s", v);
+endfunction
+
+## Make sure the depends field is of the right format.
+## This function returns a cell of structures with the following fields:
+## package, version, operator
+function deps_cell = fix_depends (depends)
+ deps = split_by (tolower (depends), ",");
+ deps_cell = cell (1, length (deps));
+
+ ## For each dependency.
+ for i = 1:length (deps)
+ dep = deps{i};
+ lpar = find (dep == "(");
+ rpar = find (dep == ")");
+ ## Does the dependency specify a version
+ ## Example: package(>= version).
+ if (length (lpar) == 1 && length (rpar) == 1)
+ package = tolower (strip (dep(1:lpar-1)));
+ sub = dep(lpar(1)+1:rpar(1)-1);
+ parts = strsplit (sub, " ", true);
+ if (length (parts) != 2)
+ error ("incorrect syntax for dependency `%s' in the DESCRIPTION file\n",
+ dep);
+ endif
+ operator = parts{1};
+ if (! any (strcmp (operator, {">", ">=", "<=", "<", "=="})))
+ error ("unsupported operator: %s", operator);
+ endif
+ version = fix_version (parts{2});
+
+ ## If no version is specified for the dependency
+ ## we say that the version should be greater than
+ ## or equal to "0.0.0".
+ else
+ package = tolower (strip (dep));
+ operator = ">=";
+ version = "0.0.0";
+ endif
+ deps_cell{i} = struct ("package", package, "operator", operator,
+ "version", version);
+ endfor
+endfunction
+
+## Strip the text of spaces from the right
+## Example: " hello world " => " hello world"
+## FIXME -- is this the same as deblank?
+function text = rstrip (text)
+ chars = find (! isspace (text));
+ if (length (chars) > 0)
+ ## FIXME: shouldn't it be text = text(1:chars(end));
+ text = text (chars(1):end);
+ else
+ text = "";
+ endif
+endfunction
+
+## Strip the text of spaces from the left and the right.
+## Example: " hello world " => "hello world"
+function text = strip (text)
+ chars = find (! isspace (text));
+ if (length (chars) > 0)
+ text = text(chars(1):chars(end));
+ else
+ text = "";
+ endif
+endfunction
+
+## Split the text into a cell array of strings by sep.
+## Example: "A, B" => {"A", "B"} (with sep = ",")
+function out = split_by (text, sep)
+ out = strtrim (strsplit (text, sep));
+endfunction
+
+## Create an INDEX file for a package that doesn't provide one.
+## 'desc' describes the package.
+## 'dir' is the 'inst' directory in temporary directory.
+## 'index_file' is the name (including path) of resulting INDEX file.
+function write_index (desc, dir, index_file, global_install)
+ ## Get names of functions in dir
+ [files, err, msg] = readdir (dir);
+ if (err)
+ error ("couldn't read directory %s: %s", dir, msg);
+ endif
+
+ ## Check for architecture dependent files.
+ tmpdir = getarchdir (desc);
+ if (exist (tmpdir, "dir"))
+ [files2, err, msg] = readdir (tmpdir);
+ if (err)
+ error ("couldn't read directory %s: %s", tmpdir, msg);
+ endif
+ files = [files; files2];
+ endif
+
+ functions = {};
+ for i = 1:length (files)
+ file = files{i};
+ lf = length (file);
+ if (lf > 2 && strcmp (file(end-1:end), ".m"))
+ functions{end+1} = file(1:end-2);
+ elseif (lf > 4 && strcmp (file(end-3:end), ".oct"))
+ functions{end+1} = file(1:end-4);
+ endif
+ endfor
+
+ ## Does desc have a categories field?
+ if (! isfield (desc, "categories"))
+ error ("the DESCRIPTION file must have a Categories field, when no INDEX file is given");
+ endif
+ categories = split_by (desc.categories, ",");
+ if (length (categories) < 1)
+ error ("the Category field is empty");
+ endif
+
+ ## Write INDEX.
+ fid = fopen (index_file, "w");
+ if (fid == -1)
+ error ("couldn't open %s for writing.", index_file);
+ endif
+ fprintf (fid, "%s >> %s\n", desc.name, desc.title);
+ fprintf (fid, "%s\n", categories{1});
+ fprintf (fid, " %s\n", functions{:});
+ fclose (fid);
+endfunction
+
+function bad_deps = get_unsatisfied_deps (desc, installed_pkgs_lst)
+ bad_deps = {};
+
+ ## For each dependency.
+ for i = 1:length (desc.depends)
+ dep = desc.depends{i};
+
+ ## Is the current dependency Octave?
+ if (strcmp (dep.package, "octave"))
+ if (! compare_versions (OCTAVE_VERSION, dep.version, dep.operator))
+ bad_deps{end+1} = dep;
+ endif
+ ## Is the current dependency not Octave?
+ else
+ ok = false;
+ for i = 1:length (installed_pkgs_lst)
+ cur_name = installed_pkgs_lst{i}.name;
+ cur_version = installed_pkgs_lst{i}.version;
+ if (strcmp (dep.package, cur_name)
+ && compare_versions (cur_version, dep.version, dep.operator))
+ ok = true;
+ break;
+ endif
+ endfor
+ if (! ok)
+ bad_deps{end+1} = dep;
+ endif
+ endif
+ endfor
+endfunction
+
+function [out1, out2] = installed_packages (local_list, global_list)
+ ## Get the list of installed packages.
+ try
+ local_packages = load (local_list).local_packages;
+ catch
+ local_packages = {};
+ end_try_catch
+ try
+ global_packages = load (global_list).global_packages;
+ catch
+ global_packages = {};
+ end_try_catch
+ installed_pkgs_lst = {local_packages{:}, global_packages{:}};
+
+ ## Eliminate duplicates in the installed package list.
+ ## Locally installed packages take precedence.
+ dup = [];
+ for i = 1:length (installed_pkgs_lst)
+ if (find (dup, i))
+ continue;
+ endif
+ for j = (i+1):length (installed_pkgs_lst)
+ if (find (dup, j))
+ continue;
+ endif
+ if (strcmp (installed_pkgs_lst{i}.name, installed_pkgs_lst{j}.name))
+ dup = [dup, j];
+ endif
+ endfor
+ endfor
+ if (! isempty(dup))
+ installed_pkgs_lst(dup) = [];
+ endif
+
+ ## Now check if the package is loaded.
+ tmppath = strrep (path(), "\\", "/");
+ for i = 1:length (installed_pkgs_lst)
+ if (findstr (tmppath, strrep (installed_pkgs_lst{i}.dir, "\\", "/")))
+ installed_pkgs_lst{i}.loaded = true;
+ else
+ installed_pkgs_lst{i}.loaded = false;
+ endif
+ endfor
+ for i = 1:length (local_packages)
+ if (findstr (tmppath, strrep (local_packages{i}.dir, "\\", "/")))
+ local_packages{i}.loaded = true;
+ else
+ local_packages{i}.loaded = false;
+ endif
+ endfor
+ for i = 1:length (global_packages)
+ if (findstr (tmppath, strrep (global_packages{i}.dir, "\\", "/")))
+ global_packages{i}.loaded = true;
+ else
+ global_packages{i}.loaded = false;
+ endif
+ endfor
+
+ ## Should we return something?
+ if (nargout == 2)
+ out1 = local_packages;
+ out2 = global_packages;
+ return;
+ elseif (nargout == 1)
+ out1 = installed_pkgs_lst;
+ return;
+ endif
+
+ ## We shouldn't return something, so we'll print something.
+ num_packages = length (installed_pkgs_lst);
+ if (num_packages == 0)
+ printf ("no packages installed.\n");
+ return;
+ endif
+
+ ## Compute the maximal lengths of name, version, and dir.
+ h1 = "Package Name";
+ h2 = "Version";
+ h3 = "Installation directory";
+ max_name_length = length (h1);
+ max_version_length = length (h2);
+ names = cell (num_packages, 1);
+ for i = 1:num_packages
+ max_name_length = max (max_name_length,
+ length (installed_pkgs_lst{i}.name));
+ max_version_length = max (max_version_length,
+ length (installed_pkgs_lst{i}.version));
+ names{i} = installed_pkgs_lst{i}.name;
+ endfor
+ max_dir_length = terminal_size()(2) - max_name_length - ...
+ max_version_length - 7;
+ if (max_dir_length < 20)
+ max_dir_length = Inf;
+ endif
+
+ h1 = postpad (h1, max_name_length + 1, " ");
+ h2 = postpad (h2, max_version_length, " ");
+
+ ## Print a header.
+ header = sprintf("%s | %s | %s\n", h1, h2, h3);
+ printf (header);
+ tmp = sprintf (repmat ("-", 1, length(header)-1));
+ tmp(length(h1)+2) = "+";
+ tmp(length(h1)+length(h2)+5) = "+";
+ printf ("%s\n", tmp);
+
+ ## Print the packages.
+ format = sprintf ("%%%ds %%1s| %%%ds | %%s\n", max_name_length,
+ max_version_length);
+ [dummy, idx] = sort (names);
+ for i = 1:num_packages
+ cur_name = installed_pkgs_lst{idx(i)}.name;
+ cur_version = installed_pkgs_lst{idx(i)}.version;
+ cur_dir = installed_pkgs_lst{idx(i)}.dir;
+ if (length (cur_dir) > max_dir_length)
+ first_char = length (cur_dir) - max_dir_length + 4;
+ first_filesep = strfind (cur_dir(first_char:end), filesep());
+ if (! isempty (first_filesep))
+ cur_dir = cstrcat ("...",
+ cur_dir((first_char + first_filesep(1) - 1):end));
+ else
+ cur_dir = cstrcat ("...", cur_dir(first_char:end));
+ endif
+ endif
+ if (installed_pkgs_lst{idx(i)}.loaded)
+ cur_loaded = "*";
+ else
+ cur_loaded = " ";
+ endif
+ printf (format, cur_name, cur_loaded, cur_version, cur_dir);
+ endfor
+endfunction
+
+function load_packages (files, handle_deps, local_list, global_list)
+ installed_pkgs_lst = installed_packages (local_list, global_list);
+ num_packages = length (installed_pkgs_lst);
+
+ ## Read package names and installdirs into a more convenient format.
+ pnames = pdirs = cell (1, num_packages);
+ for i = 1:num_packages
+ pnames{i} = installed_pkgs_lst{i}.name;
+ pdirs{i} = installed_pkgs_lst{i}.dir;
+ endfor
+
+ ## Load all.
+ if (length (files) == 1 && strcmp (files{1}, "all"))
+ idx = [1:length(installed_pkgs_lst)];
+ ## Load auto.
+ elseif (length (files) == 1 && strcmp (files{1}, "auto"))
+ idx = [];
+ for i = 1:length (installed_pkgs_lst)
+ if (exist (fullfile (pdirs{i}, "packinfo", ".autoload"), "file"))
+ idx (end + 1) = i;
+ endif
+ endfor
+ ## Load package_name1 ...
+ else
+ idx = [];
+ for i = 1:length (files)
+ idx2 = find (strcmp (pnames, files{i}));
+ if (! any (idx2))
+ error ("package %s is not installed", files{i});
+ endif
+ idx (end + 1) = idx2;
+ endfor
+ endif
+
+ ## Load the packages, but take care of the ordering of dependencies.
+ load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, true);
+endfunction
+
+function unload_packages (files, handle_deps, local_list, global_list)
+ installed_pkgs_lst = installed_packages (local_list, global_list);
+ num_packages = length (installed_pkgs_lst);
+
+ ## Read package names and installdirs into a more convenient format.
+ pnames = pdirs = cell (1, num_packages);
+ for i = 1:num_packages
+ pnames{i} = installed_pkgs_lst{i}.name;
+ pdirs{i} = installed_pkgs_lst{i}.dir;
+ pdeps{i} = installed_pkgs_lst{i}.depends;
+ endfor
+
+ ## Get the current octave path.
+ p = split_by (path(), pathsep ());
+
+ if (length (files) == 1 && strcmp (files{1}, "all"))
+ ## Unload all.
+ dirs = pdirs;
+ desc = installed_pkgs_lst;
+ else
+ ## Unload package_name1 ...
+ dirs = {};
+ desc = {};
+ for i = 1:length (files)
+ idx = strcmp (pnames, files{i});
+ if (! any (idx))
+ error ("package %s is not installed", files{i});
+ endif
+ dirs{end+1} = pdirs{idx};
+ desc{end+1} = installed_pkgs_lst{idx};
+ endfor
+ endif
+
+ ## Check for architecture dependent directories.
+ archdirs = {};
+ for i = 1:length (dirs)
+ tmpdir = getarchdir (desc{i});
+ if (exist (tmpdir, "dir"))
+ archdirs{end+1} = dirs{i};
+ archdirs{end+1} = tmpdir;
+ else
+ archdirs{end+1} = dirs{i};
+ endif
+ endfor
+
+ ## Unload the packages.
+ for i = 1:length (archdirs)
+ d = archdirs{i};
+ idx = strcmp (p, d);
+ if (any (idx))
+ rmpath (d);
+ ## FIXME: We should also check if we need to remove items from
+ ## EXEC_PATH.
+ endif
+ endfor
+endfunction
+
+function [status_out, msg_out] = rm_rf (dir)
+ if (exist (dir))
+ crr = confirm_recursive_rmdir ();
+ unwind_protect
+ confirm_recursive_rmdir (false);
+ [status, msg] = rmdir (dir, "s");
+ unwind_protect_cleanup
+ confirm_recursive_rmdir (crr);
+ end_unwind_protect
+ else
+ status = 1;
+ msg = "";
+ endif
+ if (nargout > 0)
+ status_out = status;
+ endif
+ if (nargout > 1)
+ msg_out = msg;
+ endif
+endfunction
+
+function emp = dirempty (nm, ign)
+ if (exist (nm, "dir"))
+ if (nargin < 2)
+ ign = {".", ".."};
+ else
+ ign = [{".", ".."}, ign];
+ endif
+ l = dir (nm);
+ for i = 1:length (l)
+ found = false;
+ for j = 1:length (ign)
+ if (strcmp (l(i).name, ign{j}))
+ found = true;
+ break;
+ endif
+ endfor
+ if (! found)
+ emp = false;
+ return
+ endif
+ endfor
+ emp = true;
+ else
+ emp = true;
+ endif
+endfunction
+
+function arch = getarch ()
+ persistent _arch = cstrcat (octave_config_info("canonical_host_type"), ...
+ "-", octave_config_info("api_version"));
+ arch = _arch;
+endfunction
+
+function archprefix = getarchprefix (desc, global_install)
+ if ((nargin == 2 && global_install) || (nargin < 2 && issuperuser ()))
+ archprefix = fullfile (octave_config_info ("libexecdir"), "octave",
+ "packages", cstrcat(desc.name, "-", desc.version));
+ else
+ archprefix = desc.dir;
+ endif
+endfunction
+
+function archdir = getarchdir (desc)
+ archdir = fullfile (desc.archprefix, getarch());
+endfunction
+
+function s = issuperuser ()
+ if ((ispc () && ! isunix ()) || (geteuid() == 0))
+ s = true;
+ else
+ s = false;
+ endif
+endfunction
+
+function [status, output] = shell (cmd)
+ persistent have_sh;
+
+ cmd = strrep (cmd, "\\", "/");
+ if (ispc () && ! isunix ())
+ if (isempty(have_sh))
+ if (system("sh.exe -c \"exit\""))
+ have_sh = false;
+ else
+ have_sh = true;
+ endif
+ endif
+ if (have_sh)
+ [status, output] = system (cstrcat ("sh.exe -c \"", cmd, "\""));
+ else
+ error ("Can not find the command shell")
+ endif
+ else
+ [status, output] = system (cmd);
+ endif
+endfunction
+
+function newdesc = save_order (desc)
+ newdesc = {};
+ for i = 1 : length(desc)
+ deps = desc{i}.depends;
+ if (isempty (deps) || (length (deps) == 1 &&
+ strcmp(deps{1}.package, "octave")))
+ newdesc {end + 1} = desc{i};
+ else
+ tmpdesc = {};
+ for k = 1 : length (deps)
+ for j = 1 : length (desc)
+ if (strcmp (desc{j}.name, deps{k}.package))
+ tmpdesc{end+1} = desc{j};
+ break;
+ endif
+ endfor
+ endfor
+ if (! isempty (tmpdesc))
+ newdesc = {newdesc{:}, save_order(tmpdesc){:}, desc{i}};
+ else
+ newdesc{end+1} = desc{i};
+ endif
+ endif
+ endfor
+ ## Eliminate the duplicates.
+ idx = [];
+ for i = 1 : length (newdesc)
+ for j = (i + 1) : length (newdesc)
+ if (strcmp (newdesc{i}.name, newdesc{j}.name))
+ idx (end + 1) = j;
+ endif
+ endfor
+ endfor
+ newdesc(idx) = [];
+endfunction
+
+function load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst,
+ global_install)
+ idx = load_package_dirs (idx, [], handle_deps, installed_pkgs_lst);
+ dirs = {};
+ execpath = EXEC_PATH ();
+ for i = idx;
+ ndir = installed_pkgs_lst{i}.dir;
+ dirs{end+1} = ndir;
+ if (exist (fullfile (dirs{end}, "bin"), "dir"))
+ execpath = cstrcat (fullfile (dirs{end}, "bin"), ":", execpath);
+ endif
+ tmpdir = getarchdir (installed_pkgs_lst{i});
+ if (exist (tmpdir, "dir"))
+ dirs{end + 1} = tmpdir;
+ if (exist (fullfile (dirs{end}, "bin"), "dir"))
+ execpath = cstrcat (fullfile (dirs{end}, "bin"), ":", execpath);
+ endif
+ endif
+ endfor
+
+ ## Load the packages.
+ if (length (dirs) > 0)
+ addpath (dirs{:});
+ endif
+
+ ## Add the binaries to exec_path.
+ if (! strcmp (EXEC_PATH, execpath))
+ EXEC_PATH (execpath);
+ endif
+endfunction
+
+function idx = load_package_dirs (lidx, idx, handle_deps, installed_pkgs_lst)
+ for i = lidx
+ if (isfield (installed_pkgs_lst{i}, "loaded") &&
+ installed_pkgs_lst{i}.loaded)
+ continue;
+ else
+ if (handle_deps)
+ deps = installed_pkgs_lst{i}.depends;
+ if ((length (deps) > 1) || (length (deps) == 1 &&
+ ! strcmp(deps{1}.package, "octave")))
+ tmplidx = [];
+ for k = 1 : length (deps)
+ for j = 1 : length (installed_pkgs_lst)
+ if (strcmp (installed_pkgs_lst{j}.name, deps{k}.package))
+ tmplidx (end + 1) = j;
+ break;
+ endif
+ endfor
+ endfor
+ idx = load_package_dirs (tmplidx, idx, handle_deps,
+ installed_pkgs_lst);
+ endif
+ endif
+ if (isempty (find(idx == i)))
+ idx (end + 1) = i;
+ endif
+ endif
+ endfor
+endfunction
+
+function dep = is_architecture_dependent (nm)
+ persistent archdepsuffix = {".oct",".mex",".a",".lib",".so",".so.*",".dll","dylib"};
+
+ dep = false;
+ for i = 1 : length (archdepsuffix)
+ ext = archdepsuffix{i};
+ if (ext(end) == "*")
+ isglob = true;
+ ext(end) = [];
+ else
+ isglob = false; # I am a test
+ #%% me too
+### I shall align to column 0
+ endif
+ pos = findstr (nm, ext);
+ if (pos)
+ if (! isglob && (length(nm) - pos(end) != length(ext) - 1))
+ continue;
+ endif
+ dep = true;
+ break;
+ endif
+ endfor
+endfunction
+
+%!assert(norm(logm([1 -1;0 1]) - [0 -1; 0 0]) < 1e-5);
+%!assert(norm(expm(logm([-1 2 ; 4 -1])) - [-1 2 ; 4 -1]) < 1e-5);
+%!assert(logm([1 -1 -1;0 1 -1; 0 0 1]), [0 -1 -1.5; 0 0 -1; 0 0 0], 1e-5);
+%!assert (logm (expm ([0 1i; -1i 0])), [0 1i; -1i 0], 10 * eps)
+
+%% Test input validation
+%!error logm ();
+%!error logm (1, 2, 3);
+%!error <logm: A must be a square matrix> logm([1 0;0 1; 2 2]);
+
+%!assert (logm (10), log (10))
+%!assert (full (logm (eye (3))), logm (full (eye (3))))
+%!assert (full (logm (10*eye (3))), logm (full (10*eye (3))), 8*eps)
diff --git a/test/manual/indent/pascal.pas b/test/manual/indent/pascal.pas
new file mode 100644
index 00000000000..2d09eb775a4
--- /dev/null
+++ b/test/manual/indent/pascal.pas
@@ -0,0 +1,1092 @@
+{ GPC demo program for the CRT unit.
+
+Copyright (C) 1999-2006, 2013-2016 Free Software Foundation, Inc.
+
+Author: Frank Heckenbach <frank@pascal.gnu.de>
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License as
+published by the Free Software Foundation, version 3.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+As a special exception, if you incorporate even large parts of the
+code of this demo program into another program with substantially
+different functionality, this does not cause the other program to
+be covered by the GNU General Public License. This exception does
+not however invalidate any other reasons why it might be covered
+by the GNU General Public License. }
+
+{$gnu-pascal,I+}
+
+(* second style of comment *)
+// Free-pascal style comment.
+var x:Char = 12 /* 45; // This /* does not start a comment.
+var x:Char = (/ 4); // This (/ does not start a comment.
+var a_to_b : integer; // 'to' should not be highlighted
+
+program CRTDemo;
+
+uses GPC, CRT;
+
+type
+ TFrameChars = array [1 .. 8] of Char;
+ TSimulateBlockCursorKind = (bc_None, bc_Blink, bc_Static);
+
+const
+ SingleFrame: TFrameChars = (chCornerTLS, chLineHS, chCornerTRS, chLineVS, chLineVS, chCornerBLS, chLineHS, chCornerBRS);
+ DoubleFrame: TFrameChars = (chCornerTLD, chLineHD, chCornerTRD, chLineVD, chLineVD, chCornerBLD, chLineHD, chCornerBRD);
+
+var
+ ScrollState: Boolean = True;
+ SimulateBlockCursorKind: TSimulateBlockCursorKind = bc_None;
+ CursorShape: TCursorShape = CursorNormal;
+ MainPanel: TPanel;
+ OrigScreenSize: TPoint;
+
+procedure FrameWin (const Title: String; const Frame: TFrameChars; TitleInverse: Boolean);
+var
+ w, h, y, Color: Integer;
+ Attr: TTextAttr;
+begin
+ HideCursor;
+ SetPCCharSet (True);
+ ClrScr;
+ w := GetXMax;
+ h := GetYMax;
+ WriteCharAt (1, 1, 1, Frame[1], TextAttr);
+ WriteCharAt (2, 1, w - 2, Frame[2], TextAttr);
+ WriteCharAt (w, 1, 1, Frame[3], TextAttr);
+ for y := 2 to h - 1 do
+ begin
+ WriteCharAt (1, y, 1, Frame[4], TextAttr);
+ WriteCharAt (w, y, 1, Frame[5], TextAttr)
+ end;
+ WriteCharAt (1, h, 1, Frame[6], TextAttr);
+ WriteCharAt (2, h, w - 2, Frame[7], TextAttr);
+ WriteCharAt (w, h, 1, Frame[8], TextAttr);
+ SetPCCharSet (False);
+ Attr := TextAttr;
+ if TitleInverse then
+ begin
+ Color := GetTextColor;
+ TextColor (GetTextBackground);
+ TextBackground (Color)
+ end;
+ WriteStrAt ((w - Length (Title)) div 2 + 1, 1, Title, TextAttr);
+ TextAttr := Attr
+end;
+
+function GetKey (TimeOut: Integer) = Key: TKey; forward;
+
+procedure ClosePopUpWindow;
+begin
+ PanelDelete (GetActivePanel);
+ PanelDelete (GetActivePanel)
+end;
+
+function PopUpConfirm (XSize, YSize: Integer; const Msg: String): Boolean;
+var
+ ax, ay: Integer;
+ Key: TKey;
+ SSize: TPoint;
+begin
+ repeat
+ SSize := ScreenSize;
+ ax := (SSize.x - XSize - 4) div 2 + 1;
+ ay := (SSize.y - YSize - 4) div 2 + 1;
+ PanelNew (ax, ay, ax + XSize + 3, ay + YSize + 1, False);
+ TextBackground (Black);
+ TextColor (Yellow);
+ SetControlChars (True);
+ FrameWin ('', DoubleFrame, False);
+ NormalCursor;
+ PanelNew (ax + 2, ay + 1, ax + XSize + 2, ay + YSize, False);
+ ClrScr;
+ Write (Msg);
+ Key := GetKey (-1);
+ if Key = kbScreenSizeChanged then ClosePopUpWindow
+ until Key <> kbScreenSizeChanged;
+ PopUpConfirm := not (Key in [kbEsc, kbAltEsc])
+end;
+
+procedure MainDraw;
+begin
+ WriteLn ('3, F3 : Open a window');
+ WriteLn ('4, F4 : Close window');
+ WriteLn ('5, F5 : Previous window');
+ WriteLn ('6, F6 : Next window');
+ WriteLn ('7, F7 : Move window');
+ WriteLn ('8, F8 : Resize window');
+ Write ('q, Esc: Quit')
+end;
+
+procedure StatusDraw;
+const
+ YesNo: array [Boolean] of String [3] = ('No', 'Yes');
+ SimulateBlockCursorIDs: array [TSimulateBlockCursorKind] of String [8] = ('Off', 'Blinking', 'Static');
+ CursorShapeIDs: array [TCursorShape] of String [7] = ('Ignored', 'Hidden', 'Normal', 'Fat', 'Block');
+var
+ SSize: TPoint;
+begin
+ WriteLn ('You can change some of the following');
+ WriteLn ('settings by pressing the key shown');
+ WriteLn ('in parentheses. Naturally, color and');
+ WriteLn ('changing the cursor shape or screen');
+ WriteLn ('size does not work on all terminals.');
+ WriteLn;
+ WriteLn ('XCurses version: ', YesNo[XCRT]);
+ WriteLn ('CRTSavePreviousScreen: ', YesNo[CRTSavePreviousScreenWorks]);
+ WriteLn ('(M)onochrome: ', YesNo[IsMonochrome]);
+ SSize := ScreenSize;
+ WriteLn ('Screen (C)olumns: ', SSize.x);
+ WriteLn ('Screen (L)ines: ', SSize.y);
+ WriteLn ('(R)estore screen size');
+ WriteLn ('(B)reak checking: ', YesNo[CheckBreak]);
+ WriteLn ('(S)crolling: ', YesNo[ScrollState]);
+ WriteLn ('S(i)mulated block cursor: ', SimulateBlockCursorIDs[SimulateBlockCursorKind]);
+ Write ('C(u)rsor shape: ', CursorShapeIDs[CursorShape]);
+ GotoXY (36, WhereY)
+end;
+
+procedure RedrawAll; forward;
+procedure CheckScreenSize; forward;
+
+procedure StatusKey (Key: TKey);
+var SSize, NewSize: TPoint;
+begin
+ case LoCase (Key2Char (Key)) of
+ 'm': begin
+ SetMonochrome (not IsMonochrome);
+ RedrawAll
+ end;
+ 'c': begin
+ SSize := ScreenSize;
+ if SSize.x > 40 then
+ NewSize.x := 40
+ else
+ NewSize.x := 80;
+ if SSize.y > 25 then
+ NewSize.y := 50
+ else
+ NewSize.y := 25;
+ SetScreenSize (NewSize.x, NewSize.y);
+ CheckScreenSize
+ end;
+ 'l': begin
+ SSize := ScreenSize;
+ if SSize.x > 40 then
+ NewSize.x := 80
+ else
+ NewSize.x := 40;
+ if SSize.y > 25 then
+ NewSize.y := 25
+ else
+ NewSize.y := 50;
+ SetScreenSize (NewSize.x, NewSize.y);
+ CheckScreenSize
+ end;
+ 'r': begin
+ SetScreenSize (OrigScreenSize.x, OrigScreenSize.y);
+ CheckScreenSize
+ end;
+ 'b': CheckBreak := not CheckBreak;
+ 's': ScrollState := not ScrollState;
+ 'i': if SimulateBlockCursorKind = High (SimulateBlockCursorKind) then
+ SimulateBlockCursorKind := Low (SimulateBlockCursorKind)
+ else
+ Inc (SimulateBlockCursorKind);
+ 'u': case CursorShape of
+ CursorNormal: CursorShape := CursorBlock;
+ CursorFat,
+ CursorBlock : CursorShape := CursorHidden;
+ else CursorShape := CursorNormal
+ end;
+ end;
+ ClrScr;
+ StatusDraw
+end;
+
+procedure TextAttrDemo;
+var f, b, y, x1, y1, x2, y2, Fill, n1, n2, n3: Integer;
+begin
+ GetWindow (x1, y1, x2, y2);
+ Window (x1 - 1, y1, x2, y2);
+ TextColor (White);
+ TextBackground (Blue);
+ ClrScr;
+ SetScroll (False);
+ Fill := GetXMax - 32;
+ for y := 1 to GetYMax do
+ begin
+ GotoXY (1, y);
+ b := (y - 1) mod 16;
+ n1 := 0;
+ for f := 0 to 15 do
+ begin
+ TextAttr := f + 16 * b;
+ n2 := (Fill * (1 + 2 * f) + 16) div 32;
+ n3 := (Fill * (2 + 2 * f) + 16) div 32;
+ Write ('' : n2 - n1, NumericBaseDigitsUpper[b], NumericBaseDigitsUpper[f], '' : n3 - n2);
+ n1 := n3
+ end
+ end
+end;
+
+procedure CharSetDemo (UsePCCharSet: Boolean);
+var h, l, y, x1, y1, x2, y2, Fill, n1, n2: Integer;
+begin
+ GetWindow (x1, y1, x2, y2);
+ Window (x1 - 1, y1, x2, y2);
+ ClrScr;
+ SetScroll (False);
+ SetPCCharSet (UsePCCharSet);
+ SetControlChars (False);
+ Fill := GetXMax - 35;
+ for y := 1 to GetYMax do
+ begin
+ GotoXY (1, y);
+ h := (y - 2) mod 16;
+ n1 := (Fill + 9) div 18;
+ if y = 1 then
+ Write ('' : 3 + n1)
+ else
+ Write (16 * h : 3 + n1);
+ for l := 0 to 15 do
+ begin
+ n2 := (Fill * (2 + l) + 9) div 18;
+ if y = 1 then
+ Write ('' : n2 - n1, l : 2)
+ else
+ Write ('' : n2 - n1 + 1, Chr (16 * h + l));
+ n1 := n2
+ end
+ end
+end;
+
+procedure NormalCharSetDemo;
+begin
+ CharSetDemo (False)
+end;
+
+procedure PCCharSetDemo;
+begin
+ CharSetDemo (True)
+end;
+
+procedure FKeyDemoDraw;
+var x1, y1, x2, y2: Integer;
+begin
+ GetWindow (x1, y1, x2, y2);
+ Window (x1, y1, x2 - 1, y2);
+ ClrScr;
+ SetScroll (False);
+ WriteLn ('You can type the following keys');
+ WriteLn ('(function keys if present on the');
+ WriteLn ('terminal, letters as alternatives):');
+ GotoXY (1, 4);
+ WriteLn ('S, Left : left (wrap-around)');
+ WriteLn ('D, Right : right (wrap-around)');
+ WriteLn ('E, Up : up (wrap-around)');
+ WriteLn ('X, Down : down (wrap-around)');
+ WriteLn ('A, Home : go to first column');
+ WriteLn ('F, End : go to last column');
+ WriteLn ('R, Page Up : go to first line');
+ WriteLn ('C, Page Down: go to last line');
+ WriteLn ('Y, Ctrl-PgUp: first column and line');
+ GotoXY (1, 13);
+ WriteLn ('B, Ctrl-PgDn: last column and line');
+ WriteLn ('Z, Ctrl-Home: clear screen');
+ WriteLn ('N, Ctrl-End : clear to end of line');
+ WriteLn ('V, Insert : insert a line');
+ WriteLn ('T, Delete : delete a line');
+ WriteLn ('# : beep');
+ WriteLn ('* : flash');
+ WriteLn ('Tab, Enter, Backspace, other');
+ WriteLn (' normal characters: write text')
+end;
+
+procedure FKeyDemoKey (Key: TKey);
+const TabSize = 8;
+var
+ ch: Char;
+ NewX: Integer;
+begin
+ case LoCaseKey (Key) of
+ Ord ('s'), kbLeft : if WhereX = 1 then GotoXY (GetXMax, WhereY) else GotoXY (WhereX - 1, WhereY);
+ Ord ('d'), kbRight : if WhereX = GetXMax then GotoXY (1, WhereY) else GotoXY (WhereX + 1, WhereY);
+ Ord ('e'), kbUp : if WhereY = 1 then GotoXY (WhereX, GetYMax) else GotoXY (WhereX, WhereY - 1);
+ Ord ('x'), kbDown : if WhereY = GetYMax then GotoXY (WhereX, 1) else GotoXY (WhereX, WhereY + 1);
+ Ord ('a'), kbHome : Write (chCR);
+ Ord ('f'), kbEnd : GotoXY (GetXMax, WhereY);
+ Ord ('r'), kbPgUp : GotoXY (WhereX, 1);
+ Ord ('c'), kbPgDn : GotoXY (WhereX, GetYMax);
+ Ord ('y'), kbCtrlPgUp: GotoXY (1, 1);
+ Ord ('b'), kbCtrlPgDn: GotoXY (GetXMax, GetYMax);
+ Ord ('z'), kbCtrlHome: ClrScr;
+ Ord ('n'), kbCtrlEnd : ClrEOL;
+ Ord ('v'), kbIns : InsLine;
+ Ord ('t'), kbDel : DelLine;
+ Ord ('#') : Beep;
+ Ord ('*') : Flash;
+ kbTab : begin
+ NewX := ((WhereX - 1) div TabSize + 1) * TabSize + 1;
+ if NewX <= GetXMax then GotoXY (NewX, WhereY) else WriteLn
+ end;
+ kbCR : WriteLn;
+ kbBkSp : Write (chBkSp, ' ', chBkSp);
+ else ch := Key2Char (Key);
+ if ch <> #0 then Write (ch)
+ end
+end;
+
+procedure KeyDemoDraw;
+begin
+ WriteLn ('Press some keys ...')
+end;
+
+procedure KeyDemoKey (Key: TKey);
+var ch: Char;
+begin
+ ch := Key2Char (Key);
+ if ch <> #0 then
+ begin
+ Write ('Normal key');
+ if IsPrintable (ch) then Write (' `', ch, '''');
+ WriteLn (', ASCII #', Ord (ch))
+ end
+ else
+ WriteLn ('Special key ', Ord (Key2Scan (Key)))
+end;
+
+procedure IOSelectPeriodical;
+var
+ CurrentTime: TimeStamp;
+ s: String (8);
+ i: Integer;
+begin
+ GetTimeStamp (CurrentTime);
+ with CurrentTime do
+ WriteStr (s, Hour : 2, ':', Minute : 2, ':', Second : 2);
+ for i := 1 to Length (s) do
+ if s[i] = ' ' then s[i] := '0';
+ GotoXY (1, 12);
+ Write ('The time is: ', s)
+end;
+
+procedure IOSelectDraw;
+begin
+ WriteLn ('IOSelect is a way to handle I/O from');
+ WriteLn ('or to several places simultaneously,');
+ WriteLn ('without having to use threads or');
+ WriteLn ('signal/interrupt handlers or waste');
+ WriteLn ('CPU time with busy waiting.');
+ WriteLn;
+ WriteLn ('This demo shows how IOSelect works');
+ WriteLn ('in connection with CRT. It displays');
+ WriteLn ('a clock, but still reacts to user');
+ WriteLn ('input immediately.');
+ IOSelectPeriodical
+end;
+
+procedure ModifierPeriodical;
+const
+ Pressed: array [Boolean] of String [8] = ('Released', 'Pressed');
+ ModifierNames: array [1 .. 7] of record
+ Modifier: Integer;
+ Name: String (17)
+ end =
+ ((shLeftShift, 'Left Shift'),
+ (shRightShift, 'Right Shift'),
+ (shLeftCtrl, 'Left Control'),
+ (shRightCtrl, 'Right Control'),
+ (shAlt, 'Alt (left)'),
+ (shAltGr, 'AltGr (right Alt)'),
+ (shExtra, 'Extra'));
+var
+ ShiftState, i: Integer;
+begin
+ ShiftState := GetShiftState;
+ for i := 1 to 7 do
+ with ModifierNames[i] do
+ begin
+ GotoXY (1, 4 + i);
+ ClrEOL;
+ Write (Name, ':');
+ GotoXY (20, WhereY);
+ Write (Pressed[(ShiftState and Modifier) <> 0])
+ end
+end;
+
+procedure ModifierDraw;
+begin
+ WriteLn ('Modifier keys (NOTE: only');
+ WriteLn ('available on some systems;');
+ WriteLn ('X11: only after key press):');
+ ModifierPeriodical
+end;
+
+procedure ChecksDraw;
+begin
+ WriteLn ('(O)S shell');
+ WriteLn ('OS shell with (C)learing');
+ WriteLn ('(R)efresh check');
+ Write ('(S)ound check')
+end;
+
+procedure ChecksKey (Key: TKey);
+var
+ i, j: Integer;
+ WasteTime: Real; attribute (volatile);
+
+ procedure DoOSShell;
+ var
+ Result: Integer;
+ Shell: TString;
+ begin
+ Shell := GetShellPath (Null);
+ {$I-}
+ Result := Execute (Shell);
+ {$I+}
+ if (InOutRes <> 0) or (Result <> 0) then
+ begin
+ ClrScr;
+ if InOutRes <> 0 then
+ WriteLn (GetIOErrorMessage, ' while trying to execute `', Shell, '''.')
+ else
+ WriteLn ('`', Shell, ''' returned status ', Result, '.');
+ Write ('Any key to continue.');
+ BlockCursor;
+ Discard (GetKey (-1))
+ end
+ end;
+
+begin
+ case LoCase (Key2Char (Key)) of
+ 'o': begin
+ if PopUpConfirm (36, 12, 'You will now get an OS shell. Unless' + NewLine +
+ 'CRTDemo is running in its own (GUI)' + NewLine +
+ 'window, the shell will run on the' + NewLine +
+ 'same screen as CRTDemo which is not' + NewLine +
+ 'cleared before the shell is started.' + NewLine +
+ 'If possible, the screen contents are' + NewLine +
+ 'restored to the state before CRTDemo' + NewLine +
+ 'was started. After leaving the shell' + NewLine +
+ 'in the usual way (usually by enter-' + NewLine +
+ 'ing `exit''), you will get back to' + NewLine +
+ 'the demo. <ESC> to abort, any other' + NewLine +
+ 'key to start.') then
+ begin
+ RestoreTerminal (True);
+ DoOSShell
+ end;
+ ClosePopUpWindow
+ end;
+ 'c': begin
+ if PopUpConfirm (36, 9, 'You will now get an OS shell. Unless' + NewLine +
+ 'CRTDemo is running in its own (GUI)' + NewLine +
+ 'window, the screen will be cleared,' + NewLine +
+ 'and the cursor will be moved to the' + NewLine +
+ 'top before the shell is started.' + NewLine +
+ 'After leaving the shell in the usual' + NewLine +
+ 'way (usually by entering `exit''),' + NewLine +
+ 'you will get back to the demo. <ESC>' + NewLine +
+ 'to abort, any other key to start.') then
+ begin
+ RestoreTerminalClearCRT;
+ DoOSShell
+ end;
+ ClosePopUpWindow
+ end;
+ 'r': begin
+ if PopUpConfirm (36, 11, 'The program will now get busy with' + NewLine +
+ 'some dummy computations. However,' + NewLine +
+ 'CRT output in the form of dots will' + NewLine +
+ 'still appear continuously one by one' + NewLine +
+ '(rather than the whole line at once' + NewLine +
+ 'in the end). While running, the test' + NewLine +
+ 'cannot be interrupted. <ESC> to' + NewLine +
+ 'abort, any other key to start.') then
+ begin
+ SetCRTUpdate (UpdateRegularly);
+ BlockCursor;
+ WriteLn;
+ WriteLn;
+ for i := 1 to GetXMax - 2 do
+ begin
+ Write ('.');
+ for j := 1 to 400000 do WasteTime := Random
+ end;
+ SetCRTUpdate (UpdateInput);
+ WriteLn;
+ Write ('Press any key.');
+ Discard (GetKey (-1))
+ end;
+ ClosePopUpWindow
+ end;
+ 's': begin
+ if PopUpConfirm (32, 4, 'You will now hear some sounds if' + NewLine +
+ 'supported (otherwise there will' + NewLine +
+ 'just be a short pause). <ESC> to' + NewLine +
+ 'abort, any other key to start.') then
+ begin
+ BlockCursor;
+ for i := 0 to 7 do
+ begin
+ Sound (Round (440 * 2 ** (Round (i * 12 / 7 + 0.3) / 12)));
+ if GetKey (400000) in [kbEsc, kbAltEsc] then Break
+ end;
+ NoSound
+ end;
+ ClosePopUpWindow
+ end;
+ end
+end;
+
+type
+ PWindowList = ^TWindowList;
+ TWindowList = record
+ Next, Prev: PWindowList;
+ Panel, FramePanel: TPanel;
+ WindowType: Integer;
+ x1, y1, xs, ys: Integer;
+ State: (ws_None, ws_Moving, ws_Resizing);
+ end;
+
+TKeyProc = procedure (Key: TKey);
+TProcedure = procedure;
+
+const
+ MenuNameLength = 16;
+ WindowTypes: array [0 .. 9] of record
+ DrawProc,
+ PeriodicalProc: procedure;
+ KeyProc : TKeyProc;
+ Name : String (MenuNameLength);
+ Color,
+ Background,
+ MinSizeX,
+ MinSizeY,
+ PrefSizeX,
+ PrefSizeY : Integer;
+ RedrawAlways,
+ WantCursor : Boolean
+ end =
+((MainDraw , nil , nil , 'CRT Demo' , LightGreen, Blue , 26, 7, 0, 0, False, False),
+ (StatusDraw , nil , StatusKey , 'Status' , White , Red , 38, 16, 0, 0, True, True),
+ (TextAttrDemo , nil , nil , 'Text Attributes' , White , Blue , 32, 16, 64, 16, False, False),
+ (NormalCharSetDemo, nil , nil , 'Character Set' , Black , Green , 35, 17, 53, 17, False, False),
+ (PCCharSetDemo , nil , nil , 'PC Character Set', Black , Brown , 35, 17, 53, 17, False, False),
+ (KeyDemoDraw , nil , KeyDemoKey , 'Keys' , Blue , LightGray, 29, 5, -1, -1, False, True),
+ (FKeyDemoDraw , nil , FKeyDemoKey, 'Function Keys' , Blue , LightGray, 37, 22, -1, -1, False, True),
+ (ModifierDraw , ModifierPeriodical, nil , 'Modifier Keys' , Black , Cyan , 29, 11, 0, 0, True, False),
+ (IOSelectDraw , IOSelectPeriodical, nil , 'IOSelect Demo' , White , Magenta , 38, 12, 0, 0, False, False),
+ (ChecksDraw , nil , ChecksKey , 'Various Checks' , Black , Red , 26, 4, 0, 0, False, False));
+
+MenuMax = High (WindowTypes);
+MenuXSize = MenuNameLength + 4;
+MenuYSize = MenuMax + 2;
+
+var
+ WindowList: PWindowList = nil;
+
+ procedure RedrawFrame (p: PWindowList);
+ begin
+ with p^, WindowTypes[WindowType] do
+ begin
+ PanelActivate (FramePanel);
+ Window (x1, y1, x1 + xs - 1, y1 + ys - 1);
+ ClrScr;
+ case State of
+ ws_None : if p = WindowList then
+ FrameWin (' ' + Name + ' ', DoubleFrame, True)
+ else
+ FrameWin (' ' + Name + ' ', SingleFrame, False);
+ ws_Moving : FrameWin (' Move Window ', SingleFrame, True);
+ ws_Resizing: FrameWin (' Resize Window ', SingleFrame, True);
+ end
+ end
+ end;
+
+ procedure DrawWindow (p: PWindowList);
+ begin
+ with p^, WindowTypes[WindowType] do
+ begin
+ RedrawFrame (p);
+ PanelActivate (Panel);
+ Window (x1 + 2, y1 + 1, x1 + xs - 2, y1 + ys - 2);
+ ClrScr;
+ DrawProc
+ end
+ end;
+
+ procedure RedrawAll;
+ var
+ LastPanel: TPanel;
+ p: PWindowList;
+ x2, y2: Integer;
+ begin
+ LastPanel := GetActivePanel;
+ PanelActivate (MainPanel);
+ TextBackground (Blue);
+ ClrScr;
+ p := WindowList;
+ if p <> nil then
+ repeat
+ with p^ do
+ begin
+ PanelActivate (FramePanel);
+ GetWindow (x1, y1, x2, y2); { updated automatically by CRT }
+ xs := x2 - x1 + 1;
+ ys := y2 - y1 + 1
+ end;
+ DrawWindow (p);
+ p := p^.Next
+ until p = WindowList;
+ PanelActivate (LastPanel)
+ end;
+
+ procedure CheckScreenSize;
+ var
+ LastPanel: TPanel;
+ MinScreenSizeX, MinScreenSizeY, i: Integer;
+ SSize: TPoint;
+ begin
+ LastPanel := GetActivePanel;
+ PanelActivate (MainPanel);
+ HideCursor;
+ MinScreenSizeX := MenuXSize;
+ MinScreenSizeY := MenuYSize;
+ for i := Low (WindowTypes) to High (WindowTypes) do
+ with WindowTypes[i] do
+ begin
+ MinScreenSizeX := Max (MinScreenSizeX, MinSizeX + 2);
+ MinScreenSizeY := Max (MinScreenSizeY, MinSizeY + 2)
+ end;
+ SSize := ScreenSize;
+ Window (1, 1, SSize.x, SSize.y);
+ if (SSize.x < MinScreenSizeX) or (SSize.y < MinScreenSizeY) then
+ begin
+ NormVideo;
+ ClrScr;
+ RestoreTerminal (True);
+ WriteLn (StdErr, 'Sorry, your screen is too small for this demo (', SSize.x, 'x', SSize.y, ').');
+ WriteLn (StdErr, 'You need at least ', MinScreenSizeX, 'x', MinScreenSizeY, ' characters.');
+ Halt (2)
+ end;
+ PanelActivate (LastPanel);
+ RedrawAll
+ end;
+
+ procedure Die; attribute (noreturn);
+ begin
+ NoSound;
+ RestoreTerminalClearCRT;
+ WriteLn (StdErr, 'You''re trying to kill me. Since I have break checking turned off,');
+ WriteLn (StdErr, 'I''m not dying, but I''ll do you a favor and terminate now.');
+ Halt (3)
+ end;
+
+ function GetKey (TimeOut: Integer) = Key: TKey;
+ var
+ NeedSelect, SelectValue: Integer;
+ SimulateBlockCursorCurrent: TSimulateBlockCursorKind;
+ SelectInput: array [1 .. 1] of PAnyFile = (@Input);
+ NextSelectTime: MicroSecondTimeType = 0; attribute (static);
+ TimeOutTime: MicroSecondTimeType;
+ LastPanel: TPanel;
+ p: PWindowList;
+ begin
+ LastPanel := GetActivePanel;
+ if TimeOut < 0 then
+ TimeOutTime := High (TimeOutTime)
+ else
+ TimeOutTime := GetMicroSecondTime + TimeOut;
+ NeedSelect := 0;
+ if TimeOut >= 0 then
+ Inc (NeedSelect);
+ SimulateBlockCursorCurrent := SimulateBlockCursorKind;
+ if SimulateBlockCursorCurrent <> bc_None then
+ Inc (NeedSelect);
+ p := WindowList;
+ repeat
+ if @WindowTypes[p^.WindowType].PeriodicalProc <> nil then
+ Inc (NeedSelect);
+ p := p^.Next
+ until p = WindowList;
+ p := WindowList;
+ repeat
+ with p^, WindowTypes[WindowType] do
+ if RedrawAlways then
+ begin
+ PanelActivate (Panel);
+ ClrScr;
+ DrawProc
+ end;
+ p := p^.Next
+ until p = WindowList;
+ if NeedSelect <> 0 then
+ repeat
+ CRTUpdate;
+ SelectValue := IOSelectRead (SelectInput, Max (0, Min (NextSelectTime, TimeOutTime) - GetMicroSecondTime));
+ if SelectValue = 0 then
+ begin
+ case SimulateBlockCursorCurrent of
+ bc_None : ;
+ bc_Blink : SimulateBlockCursor;
+ bc_Static: begin
+ SimulateBlockCursor;
+ SimulateBlockCursorCurrent := bc_None;
+ Dec (NeedSelect)
+ end
+ end;
+ NextSelectTime := GetMicroSecondTime + 120000;
+ p := WindowList;
+ repeat
+ with p^, WindowTypes[WindowType] do
+ if @PeriodicalProc <> nil then
+ begin
+ PanelActivate (Panel);
+ PeriodicalProc
+ end;
+ p := p^.Next
+ until p = WindowList
+ end;
+ until (NeedSelect = 0) or (SelectValue <> 0) or ((TimeOut >= 0) and (GetMicroSecondTime >= TimeOutTime));
+ if NeedSelect = 0 then
+ SelectValue := 1;
+ if SelectValue = 0 then
+ Key := 0
+ else
+ Key := ReadKeyWord;
+ if SimulateBlockCursorKind <> bc_None then
+ SimulateBlockCursorOff;
+ if IsDeadlySignal (Key) then Die;
+ if Key = kbScreenSizeChanged then CheckScreenSize;
+ PanelActivate (LastPanel)
+ end;
+
+ function Menu = n: Integer;
+ var
+ i, ax, ay: Integer;
+ Key: TKey;
+ Done: Boolean;
+ SSize: TPoint;
+ begin
+ n := 1;
+ repeat
+ SSize := ScreenSize;
+ ax := (SSize.x - MenuXSize) div 2 + 1;
+ ay := (SSize.y - MenuYSize) div 2 + 1;
+ PanelNew (ax, ay, ax + MenuXSize - 1, ay + MenuYSize - 1, False);
+ SetControlChars (True);
+ TextColor (Blue);
+ TextBackground (LightGray);
+ FrameWin (' Select Window ', DoubleFrame, True);
+ IgnoreCursor;
+ PanelNew (ax + 1, ay + 1, ax + MenuXSize - 2, ay + MenuYSize - 2, False);
+ ClrScr;
+ TextColor (Black);
+ SetScroll (False);
+ Done := False;
+ repeat
+ for i := 1 to MenuMax do
+ begin
+ GotoXY (1, i);
+ if i = n then
+ TextBackground (Green)
+ else
+ TextBackground (LightGray);
+ ClrEOL;
+ Write (' ', WindowTypes[i].Name);
+ ChangeTextAttr (2, i, 1, Red + $10 * GetTextBackground)
+ end;
+ Key := GetKey (-1);
+ case LoCaseKey (Key) of
+ kbUp : if n = 1 then n := MenuMax else Dec (n);
+ kbDown : if n = MenuMax then n := 1 else Inc (n);
+ kbHome,
+ kbPgUp,
+ kbCtrlPgUp,
+ kbCtrlHome : n := 1;
+ kbEnd,
+ kbPgDn,
+ kbCtrlPgDn,
+ kbCtrlEnd : n := MenuMax;
+ kbCR : Done := True;
+ kbEsc, kbAltEsc : begin
+ n := -1;
+ Done := True
+ end;
+ Ord ('a') .. Ord ('z'): begin
+ i := MenuMax;
+ while (i > 0) and (LoCase (Key2Char (Key)) <> LoCase (WindowTypes[i].Name[1])) do Dec (i);
+ if i > 0 then
+ begin
+ n := i;
+ Done := True
+ end
+ end;
+ end
+ until Done or (Key = kbScreenSizeChanged);
+ ClosePopUpWindow
+ until Key <> kbScreenSizeChanged
+ end;
+
+ procedure NewWindow (WindowType, ax, ay: Integer);
+ var
+ p, LastWindow: PWindowList;
+ MaxX1, MaxY1: Integer;
+ SSize: TPoint;
+ begin
+ New (p);
+ if WindowList = nil then
+ begin
+ p^.Prev := p;
+ p^.Next := p
+ end
+ else
+ begin
+ p^.Prev := WindowList;
+ p^.Next := WindowList^.Next;
+ p^.Prev^.Next := p;
+ p^.Next^.Prev := p;
+ end;
+ p^.WindowType := WindowType;
+ with p^, WindowTypes[WindowType] do
+ begin
+ SSize := ScreenSize;
+ if PrefSizeX > 0 then xs := PrefSizeX else xs := MinSizeX;
+ if PrefSizeY > 0 then ys := PrefSizeY else ys := MinSizeY;
+ xs := Min (xs + 2, SSize.x);
+ ys := Min (ys + 2, SSize.y);
+ MaxX1 := SSize.x - xs + 1;
+ MaxY1 := SSize.y - ys + 1;
+ if ax = 0 then x1 := Random (MaxX1) + 1 else x1 := Min (ax, MaxX1);
+ if ay = 0 then y1 := Random (MaxY1) + 1 else y1 := Min (ay, MaxY1);
+ if (ax = 0) and (PrefSizeX < 0) then Inc (xs, Random (SSize.x - x1 - xs + 2));
+ if (ax = 0) and (PrefSizeY < 0) then Inc (ys, Random (SSize.y - y1 - ys + 2));
+ State := ws_None;
+ PanelNew (1, 1, 1, 1, False);
+ FramePanel := GetActivePanel;
+ SetControlChars (True);
+ TextColor (Color);
+ TextBackground (Background);
+ PanelNew (1, 1, 1, 1, False);
+ SetPCCharSet (False);
+ Panel := GetActivePanel;
+ end;
+ LastWindow := WindowList;
+ WindowList := p;
+ if LastWindow <> nil then RedrawFrame (LastWindow);
+ DrawWindow (p)
+ end;
+
+ procedure OpenWindow;
+ var WindowType: Integer;
+ begin
+ WindowType := Menu;
+ if WindowType >= 0 then NewWindow (WindowType, 0, 0)
+ end;
+
+ procedure NextWindow;
+ var LastWindow: PWindowList;
+ begin
+ LastWindow := WindowList;
+ WindowList := WindowList^.Next;
+ PanelTop (WindowList^.FramePanel);
+ PanelTop (WindowList^.Panel);
+ RedrawFrame (LastWindow);
+ RedrawFrame (WindowList)
+ end;
+
+ procedure PreviousWindow;
+ var LastWindow: PWindowList;
+ begin
+ PanelMoveAbove (WindowList^.Panel, MainPanel);
+ PanelMoveAbove (WindowList^.FramePanel, MainPanel);
+ LastWindow := WindowList;
+ WindowList := WindowList^.Prev;
+ RedrawFrame (LastWindow);
+ RedrawFrame (WindowList)
+ end;
+
+ procedure CloseWindow;
+ var p: PWindowList;
+ begin
+ if WindowList^.WindowType <> 0 then
+ begin
+ p := WindowList;
+ NextWindow;
+ PanelDelete (p^.FramePanel);
+ PanelDelete (p^.Panel);
+ p^.Next^.Prev := p^.Prev;
+ p^.Prev^.Next := p^.Next;
+ Dispose (p)
+ end
+ end;
+
+ procedure MoveWindow;
+ var
+ Done, Changed: Boolean;
+ SSize: TPoint;
+ begin
+ with WindowList^ do
+ begin
+ Done := False;
+ Changed := True;
+ State := ws_Moving;
+ repeat
+ if Changed then DrawWindow (WindowList);
+ Changed := True;
+ case LoCaseKey (GetKey (-1)) of
+ Ord ('s'), kbLeft : if x1 > 1 then Dec (x1);
+ Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (x1);
+ Ord ('e'), kbUp : if y1 > 1 then Dec (y1);
+ Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (y1);
+ Ord ('a'), kbHome : x1 := 1;
+ Ord ('f'), kbEnd : x1 := ScreenSize.x - xs + 1;
+ Ord ('r'), kbPgUp : y1 := 1;
+ Ord ('c'), kbPgDn : y1 := ScreenSize.y - ys + 1;
+ Ord ('y'), kbCtrlPgUp: begin
+ x1 := 1;
+ y1 := 1
+ end;
+ Ord ('b'), kbCtrlPgDn: begin
+ SSize := ScreenSize;
+ x1 := SSize.x - xs + 1;
+ y1 := SSize.y - ys + 1
+ end;
+ kbCR,
+ kbEsc, kbAltEsc : Done := True;
+ else Changed := False
+ end
+ until Done;
+ State := ws_None;
+ DrawWindow (WindowList)
+ end
+ end;
+
+ procedure ResizeWindow;
+ var
+ Done, Changed: Boolean;
+ SSize: TPoint;
+ begin
+ with WindowList^, WindowTypes[WindowType] do
+ begin
+ Done := False;
+ Changed := True;
+ State := ws_Resizing;
+ repeat
+ if Changed then DrawWindow (WindowList);
+ Changed := True;
+ case LoCaseKey (GetKey (-1)) of
+ Ord ('s'), kbLeft : if xs > MinSizeX + 2 then Dec (xs);
+ Ord ('d'), kbRight : if x1 + xs - 1 < ScreenSize.x then Inc (xs);
+ Ord ('e'), kbUp : if ys > MinSizeY + 2 then Dec (ys);
+ Ord ('x'), kbDown : if y1 + ys - 1 < ScreenSize.y then Inc (ys);
+ Ord ('a'), kbHome : xs := MinSizeX + 2;
+ Ord ('f'), kbEnd : xs := ScreenSize.x - x1 + 1;
+ Ord ('r'), kbPgUp : ys := MinSizeY + 2;
+ Ord ('c'), kbPgDn : ys := ScreenSize.y - y1 + 1;
+ Ord ('y'), kbCtrlPgUp: begin
+ xs := MinSizeX + 2;
+ ys := MinSizeY + 2
+ end;
+ Ord ('b'), kbCtrlPgDn: begin
+ SSize := ScreenSize;
+ xs := SSize.x - x1 + 1;
+ ys := SSize.y - y1 + 1
+ end;
+ kbCR,
+ kbEsc, kbAltEsc : Done := True;
+ else Changed := False
+ end
+ until Done;
+ State := ws_None;
+ DrawWindow (WindowList)
+ end
+ end;
+
+ procedure ActivateCursor;
+ begin
+ with WindowList^, WindowTypes[WindowType] do
+ begin
+ PanelActivate (Panel);
+ if WantCursor then
+ SetCursorShape (CursorShape)
+ else
+ HideCursor
+ end;
+ SetScroll (ScrollState)
+ end;
+
+var
+ Key: TKey;
+ ScreenShot, Done: Boolean;
+
+begin
+ ScreenShot := ParamStr (1) = '--screenshot';
+ if ParamCount <> Ord (ScreenShot) then
+ begin
+ RestoreTerminal (True);
+ WriteLn (StdErr, ParamStr (0), ': invalid argument `', ParamStr (Ord (ScreenShot) + 1), '''');
+ Halt (1)
+ end;
+ CRTSavePreviousScreen (True);
+ SetCRTUpdate (UpdateInput);
+ MainPanel := GetActivePanel;
+ CheckScreenSize;
+ OrigScreenSize := ScreenSize;
+ if ScreenShot then
+ begin
+ CursorShape := CursorBlock;
+ NewWindow (6, 1, 1);
+ NewWindow (2, 1, MaxInt);
+ NewWindow (8, MaxInt, 1);
+ NewWindow (5, 1, 27);
+ KeyDemoKey (Ord ('f'));
+ KeyDemoKey (246);
+ KeyDemoKey (kbDown);
+ NewWindow (3, MaxInt, 13);
+ NewWindow (4, MaxInt, 31);
+ NewWindow (7, MaxInt, MaxInt);
+ NewWindow (9, MaxInt, 33);
+ NewWindow (0, 1, 2);
+ NewWindow (1, 1, 14);
+ ActivateCursor;
+ OpenWindow
+ end
+ else
+ NewWindow (0, 3, 2);
+ Done := False;
+ repeat
+ ActivateCursor;
+ Key := GetKey (-1);
+ case LoCaseKey (Key) of
+ Ord ('3'), kbF3 : OpenWindow;
+ Ord ('4'), kbF4 : CloseWindow;
+ Ord ('5'), kbF5 : PreviousWindow;
+ Ord ('6'), kbF6 : NextWindow;
+ Ord ('7'), kbF7 : MoveWindow;
+ Ord ('8'), kbF8 : ResizeWindow;
+ Ord ('q'), kbEsc,
+ kbAltEsc: Done := True;
+ else
+ if WindowList <> nil then
+ with WindowList^, WindowTypes[WindowType] do
+ if @KeyProc <> nil then
+ begin
+ TextColor (Color);
+ TextBackground (Background);
+ KeyProc (Key)
+ end
+ end
+ until Done
+end.
diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl
new file mode 100755
index 00000000000..f86a09b2733
--- /dev/null
+++ b/test/manual/indent/perl.perl
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+# -*- eval: (bug-reference-mode 1) -*-
+
+sub add_funds($) {
+ return 0;
+}
+
+my $hash = {
+ foo => 'bar',
+ format => 'some',
+};
+
+sub some_code {
+ print "will not indent :(";
+};
+
+use v5.14;
+
+my $str= <<END;
+Hello
+END
+
+my $a = $';
+
+my $b=3;
+
+print $str;
+if ($c && /====/){xyz;}
+
+print "a" . <<EOF . s/he"llo/th'ere/;
+It's a surprise!
+EOF
+
+print <<\EOF1 . s/he"llo/th'ere/;
+foo
+EOF2
+bar
+EOF1
+
+$config = {
+ b =>
+ [
+ "123",
+ ],
+ c => "123",
+};
+
+print <<"EOF1" . <<\EOF2 . s/he"llo/th'ere/;
+foo
+EOF2
+bar
+EOF1
+bar
+EOF2
+
+print $'; # This should not start a string!
+
+print "hello" for /./;
+
+$fileType_filesButNot # bug#12373?
+ = join( '|', map { quotemeta($_).'$' } @{$fileType->{filesButNot}} );
+
+# There can be a comment between an if/when/while and a /<re>/ matcher!
+return 'W' if #/^Not Available on Mobile/m; #W=Web only
+ /This video is not available on mobile devices./m; #bug#20800
+
+# A "y|abc|def|" shouldn't interfere when inside a string!
+$toto = " x \" string\"";
+$toto = " y \" string\""; # This is not the `y' operator!
diff --git a/test/manual/indent/prolog.prolog b/test/manual/indent/prolog.prolog
new file mode 100644
index 00000000000..9ac6df1b6c7
--- /dev/null
+++ b/test/manual/indent/prolog.prolog
@@ -0,0 +1,290 @@
+%% -*- mode: prolog; coding: utf-8; fill-column: 78 -*-
+
+%% bug#21526
+test21526_1 :-
+ ( a ->
+ ( a ->
+ b
+ ; c
+ )
+ ; % Toto
+ c ->
+ d
+ ).
+
+test21526_2 :-
+ ( a
+ -> ( a,
+ b
+ ; c
+ ),
+ b2
+ ; c1,
+ c2
+ ).
+
+test21526_3 :-
+ X \= Y,
+ \+ a,
+ b,
+ \+ \+ c,
+ d.
+
+test21526_4 :-
+ ( \+ a ->
+ b
+ ; \+ c,
+ \+ d
+ ).
+
+
+test21526_5 :-
+ (a;
+ b ->
+ c).
+
+test21526_predicate(c) :- !,
+ test_goal1,
+ test_goal2.
+
+%% Testing correct tokenizing.
+foo(X) :- 0'= = X.
+foo(X) :- 8'234 = X.
+foo(X) :- '\x45\' = X.
+foo(X) :- 'test 0'=X.
+foo(X) :- 'test 8'=X.
+
+%% wf(+E)
+%% Vérifie que E est une expression syntaxiquement correcte.
+wf(X) :- atom(X); integer(X); var(X). %Une variable ou un entier.
+wf(lambda(X, T, B)) :- atom(X), wf(T), wf(B). %Une fonction.
+wf(app(E1, E2)) :- wf(E1), wf(E2). %Un appel de fonction.
+wf(pi(X, T, B)) :- atom(X), wf(T), wf(B). %Le type d'une fonction.
+
+%% Éléments additionnels utilisés dans le langage source.
+wf(lambda(X, B)) :- atom(X), wf(B).
+wf(let(X, E1, E2)) :- atom(X), wf(E1), wf(E2).
+wf(let(X, T, E1, E2)) :- atom(X), wf(T), wf(E1), wf(E2).
+wf((T1 -> T2)) :- wf(T1), wf(T2).
+wf(forall(X, T, B)) :- atom(X), wf(T), wf(B).
+wf(fix(X,T,E1,E2)) :- atom(X), wf(T), wf(E1), wf(E2).
+wf(fix(X,E1,E2)) :- atom(X), wf(E1), wf(E2).
+wf(app(E1,E2,E3)) :- wf(E1), wf(E2), wf(E3).
+wf(app(E1,E2,E3,E4)) :- wf(E1), wf(E2), wf(E3), wf(E4).
+
+%% subst(+X, +V, +FV, +Ei, -Eo)
+%% Remplace X par V dans Ei. Les variables qui apparaissent libres dans
+%% V et peuvent aussi apparaître dans Ei doivent toutes être inclues
+%% dans l'environnement FV.
+subst(X, V, _, X, E) :- !, E = V.
+subst(_, _, _, Y, Y) :- atom(Y); integer(Y).
+%% Residualize the substitution when applied to an uninstantiated variable.
+%% subst(X, V, _, Y, app(lambda(X,_,Y),V)) :- var(Y).
+%% Rather than residualize and leave us with unifications that fail, let's
+%% rather assume that Y will not refer to X.
+subst(X, V, _, Y, Y) :- var(Y).
+subst(X, V, FV, lambda(Y, Ti, Bi), lambda(Y1, To, Bo)) :-
+ subst(X, V, FV, Ti, To),
+ (X = Y ->
+ %% If X is equal to Y, X is shadowed, so no subst can take place.
+ Y1 = Y, Bo = Bi;
+ (member((Y, _), FV) ->
+ %% If Y appears in FV, it can appear in V, so we need to
+ %% rename it to avoid name capture.
+ new_atom(Y, Y1),
+ subst(Y, Y1, [], Bi, Bi1);
+ Y1 = Y, Bi1 = Bi),
+ %% Perform substitution on the body.
+ subst(X, V, FV, Bi1, Bo)),
+ ( X = Y
+ %% If X is equal to Y, X is shadowed, so no subst can take place.
+ -> Y1 = Y, Bo = Bi
+ ; (member((Y, _), FV)
+ %% If Y appears in FV, it can appear in V, so we need to
+ %% rename it to avoid name capture.
+ -> new_atom(Y, Y1),
+ subst(Y, Y1, [], Bi, Bi1)
+ ; Y1 = Y, Bi1 = Bi),
+ %% Perform substitution on the body.
+ subst(X, V, FV, Bi1, Bo)
+ ).
+subst(X, V, FV, pi(Y, Ti, Bi), pi(Y1, To, Bo)) :-
+ subst(X, V, FV, lambda(Y, Ti, Bi), lambda(Y1, To, Bo)).
+subst(X, V, FV, forall(Y, Ti, Bi), forall(Y1, To, Bo)) :-
+ subst(X, V, FV, lambda(Y, Ti, Bi), lambda(Y1, To, Bo)).
+subst(X, V, FV, app(E1i, E2i), app(E1o, E2o)) :-
+ subst(X, V, FV, E1i, E1o), subst(X, V, FV, E2i, E2o).
+
+%% apply(+F, +Arg, +Env, -E)
+apply(lambda(X, _, B), Arg, Env, E) :- \+ var(B), subst(X, Arg, Env, B, E).
+apply(app(plus, N1), N2, _, N) :- integer(N1), integer(N2), N is N1 + N2.
+apply(app(minus, N1), N2, _, N) :- integer(N1), integer(N2), N is N1 - N2.
+
+
+%% normalize(+E1, +Env, -E2)
+%% Applique toutes les réductions possibles sur E1.
+normalize(X, _, X) :- integer(X); var(X); atom(X).
+%% normalize(X, Env, E) :- atom(X), member((X, E), Env).
+normalize(lambda(X, T, B), Env, lambda(X, Tn, Bn)) :-
+ normalize(T, [(X,T)|Env], Tn), normalize(B, [(X,T)|Env], Bn).
+normalize(pi(X, T, B), Env, pi(X, Tn, Bn)) :-
+ normalize(T, [(X,T)|Env], Tn), normalize(B, [(X,T)|Env], Bn).
+normalize(forall(X, T, B), Env, forall(X, Tn, Bn)) :-
+ normalize(T, [(X,T)|Env], Tn), normalize(B, [(X,T)|Env], Bn).
+normalize(app(E1, E2), Env, En) :-
+ normalize(E1, Env, E1n),
+ normalize(E2, Env, E2n),
+ (apply(E1n, E2n, Env, E) ->
+ normalize(E, Env, En);
+ En = app(E1n, E2n)).
+
+%% infer(+E, +Env, -T)
+%% Infère le type de E dans Env. On essaie d'être permissif, dans le sens
+%% que l'on présume que l'expression est typée correctement.
+infer(X, _, int) :- integer(X).
+infer(X, _, _) :- var(X). %Une expression encore inconnue.
+infer(X, Env, T) :-
+ atom(X),
+ (member((X, T1), Env) ->
+ %% X est déjà dans Env: vérifie que le type est correct.
+ T = T1;
+ %% X est une variable libre.
+ true).
+infer(lambda(X,T,B), Env, pi(Y,T,TB)) :-
+ infer(B, [(X,T)|Env], TBx),
+ (var(Y) ->
+ Y = X, TB = TBx;
+ subst(X, Y, Env, TBx, TB)).
+infer(app(E1, E2), Env, Tn) :-
+ infer(E1, Env, T1),
+ (T1 = pi(X,T2,B); T1 = forall(X,T2,B)),
+ infer(E2, Env, T2),
+ subst(X, E2, Env, B, T),
+ normalize(T, Env, Tn).
+infer(pi(X,T1,T2), Env, type) :-
+ infer(T1, Env, type),
+ infer(T2, [(X,T1)|Env], type).
+infer(forall(X,T1,T2), Env, type) :-
+ infer(T1, Env, type),
+ infer(T2, [(X,T1)|Env], type).
+
+%% freevars(+E, +Env, -Vs)
+%% Renvoie les variables libres de E. Vs est une liste associative
+%% où chaque élément est de la forme (X,T) où X est une variable et T est
+%% son type.
+freevars(X, _, []) :- integer(X).
+freevars(X, Env, Vs) :-
+ atom(X),
+ (member((X,_), Env) ->
+ %% Variable liée.
+ Vs = [];
+ %% Variable libre. Type inconnu :-(
+ Vs = [(X,_)]).
+%% Les variables non-instanciées peuvent être remplacées par des paramètres
+%% qui seront liés par `closetype' selon le principe de Hindley-Milner.
+freevars(X, _, [(X, _)]) :- var(X), new_atom(X).
+freevars(app(E1, E2), Env, Vs) :-
+ freevars(E1, Env, Vs1),
+ append(Vs1, Env, Env1),
+ freevars(E2, Env1, Vs2),
+ append(Vs1, Vs2, Vs).
+freevars(lambda(X, T, B), Env, Vs) :-
+ freevars(T, Env, TVs),
+ append(TVs, Env, Env1),
+ freevars(B, [(X,T)|Env1], BVs),
+ append(TVs, BVs, Vs).
+freevars(pi(X, T, B), Env, Vs) :- freevars(lambda(X, T, B), Env, Vs).
+freevars(forall(X, T, B), Env, Vs) :- freevars(lambda(X, T, B), Env, Vs).
+
+%% close(+Eo, +To, +Vs, -Ec, -Tc)
+%% Ferme un type ouvert To en liant chaque variable libre (listées dans Vs)
+%% avec `forall'.
+closetype(E, T, [], E, T).
+closetype(Eo, To, [(X,T)|Vs], lambda(X, T, Ec), forall(X, T, Tc)) :-
+ closetype(Eo, To, Vs, Ec, Tc).
+
+%% elab_type(+Ee, +Te, +Env, -Eg, -Tg)
+%% Ajoute les arguments implicites de E:T.
+generalize(Ee, Te, Env, Eg, Tg) :-
+ freevars(Te, Env, Vs),
+ append(Vs, Env, EnvX),
+ %% Essaie d'instancier les types des paramètres que `generalize' vient
+ %% d'ajouter.
+ infer(Te, EnvX, type),
+ closetype(Ee, Te, Vs, Eg, Tg).
+
+%% instantiate(+X, +T, -E)
+%% Utilise la variable X de type T. Le résultat E est X auquel on ajoute
+%% tous les arguments implicites (de valeur inconnue).
+instantiate(X, T, X) :- var(T), !.
+instantiate(X, forall(_, _, T), app(E, _)) :- !, instantiate(X, T, E).
+instantiate(X, _, X).
+
+%% elaborate(+E1, +Env, -E2)
+%% Transforme E1 en une expression E2 où le sucre syntaxique a été éliminé
+%% et où les arguments implicites ont été rendus explicites.
+elaborate(X, _, X) :- integer(X); var(X).
+elaborate(X, Env, E) :-
+ atom(X),
+ (member((X, T), Env) ->
+ instantiate(X, T, E);
+ %% Si X n'est pas dans l'environnement, c'est une variable libre que
+ %% l'on voudra probablement généraliser.
+ X = E).
+elaborate(lambda(X, T, B), Env, lambda(X, Te, Be)) :-
+ elaborate(T, Env, Te),
+ elaborate(B, [(X,Te)|Env], Be).
+elaborate(pi(X, T, B), Env, pi(X, Te, Be)) :-
+ elaborate(T, Env, Te),
+ elaborate(B, [(X,Te)|Env], Be).
+elaborate(app(E1, E2), Env, app(E1e, E2e)) :-
+ elaborate(E1, Env, E1e),
+ elaborate(E2, Env, E2e).
+elaborate(let(X, T, E1, E2), Env, app(lambda(X, Tg, E2e), E1g)) :-
+ elaborate(E1, Env, E1e),
+ elaborate(T, Env, Te),
+ infer(E1e, Env, Te),
+ generalize(E1e, Te, Env, E1g, Tg),
+ elaborate(E2, [(X,Te)|Env], E2e).
+%% Expansion du sucre syntaxique.
+elaborate((T1 -> T2), Env, Ee) :-
+ new_atom(X), elaborate(pi(X, T1, T2), Env, Ee).
+elaborate(app(E1, E2, E3, E4), Env, Ee) :-
+ elaborate(app(app(E1,E2,E3),E4), Env, Ee).
+elaborate(app(E1, E2, E3), Env, Ee) :- elaborate(app(app(E1,E2),E3), Env, Ee).
+elaborate(lambda(X, B), Env, Ee) :- elaborate(lambda(X, _, B), Env, Ee).
+elaborate(let(X, E1, E2), Env, Ee) :- elaborate(let(X, _, E1, E2), Env, Ee).
+elaborate(fix(F,B,E), Env, Ee) :- elaborate(fix(F,_,B,E), Env, Ee).
+elaborate(fix(F,T,B,E), Env, Ee) :-
+ elaborate(let(F,T,app(fix,lambda(F,T,B)),E), Env, Ee).
+
+%% elab_bindings(+TS, +Env, -TS).
+%% Applique `elaborate' sur l'environnement de type TS.
+elab_tenv([], _, []).
+elab_tenv([(X,T)|TS], Env, [(X, Tg)|TSe]) :-
+ elaborate(T, Env, Te),
+ infer(Te, Env, type),
+ generalize(_, Te, Env, _, Tg),
+ elab_tenv(TS, [(X, Tg)|Env], TSe).
+
+
+%% elaborate(+E1, -E2)
+%% Comme le `elaborate' ci-dessus, mais avec un environnement par défaut.
+elaborate(SRC, E) :-
+ elab_tenv([(int, type),
+ (fix, ((t -> t) -> t)),
+ %% list: type → int → type
+ (list, (type -> int -> type)),
+ %% plus: int → int → int
+ (plus, (int -> int -> int)),
+ %% minus: int → int → int
+ (minus, (int -> int -> int)),
+ %% nil: list t 0
+ (nil, app(app(list,t),0)),
+ %% cons: t -> list t n → list t (n + 1)
+ (cons, (t -> app(app(list,t),n) ->
+ app(app(list,t), app(app(plus,n),1)))) %fixindent
+ ],
+ [(type,type)],
+ Env),
+ elaborate(SRC, Env, E).
diff --git a/test/manual/indent/ps-mode.ps b/test/manual/indent/ps-mode.ps
new file mode 100644
index 00000000000..4b4ee0f10cb
--- /dev/null
+++ b/test/manual/indent/ps-mode.ps
@@ -0,0 +1,14 @@
+%!PS-2.0
+
+<< 23 45 >> %dictionary
+< 23 > %hex string
+<~a>a%a~> %base85 string
+(%)s
+(sf\(g>a)sdg)
+
+/foo {
+ <<
+ hello 2
+ 3
+ >>
+} def
diff --git a/test/manual/indent/ruby.rb b/test/manual/indent/ruby.rb
new file mode 100644
index 00000000000..dfd1c75a679
--- /dev/null
+++ b/test/manual/indent/ruby.rb
@@ -0,0 +1,418 @@
+if something_wrong? # ruby-move-to-block-skips-heredoc
+ ActiveSupport::Deprecation.warn(<<-eowarn)
+ boo hoo
+ end
+ eowarn
+ foo
+
+ foo(<<~squiggly)
+ end
+ squiggly
+end
+
+def foo
+ %^bar^
+end
+
+# Percent literals.
+b = %Q{This is a "string"}
+c = %w!foo
+ bar
+ baz!
+d = %(hello (nested) world)
+
+# Don't propertize percent literals inside strings.
+"(%s, %s)" % [123, 456]
+
+"abc/#{def}ghi"
+"abc\#{def}ghi"
+
+# Or inside comments.
+x = # "tot %q/to"; =
+ y = 2 / 3
+
+# Regexp after whitelisted method.
+"abc".sub /b/, 'd'
+
+# Don't mis-match "sub" at the end of words.
+a = asub / aslb + bsub / bslb;
+
+# Highlight the regexp after "if".
+x = toto / foo if /do bar/ =~ "dobar"
+
+# Regexp options are highlighted.
+
+/foo/xi != %r{bar}mo.tee
+
+foo { /"tee/
+ bar { |qux| /'fee"/ } # bug#20026
+}
+
+bar(class: XXX) do # ruby-indent-keyword-label
+ foo
+end
+bar
+
+foo = [1, # ruby-deep-indent
+ 2]
+
+foo = { # ruby-deep-indent-disabled
+ a: b
+}
+
+foo = { a: b,
+ a1: b1
+ }
+
+foo({ # bug#16118
+ a: b,
+ c: d
+ })
+
+bar = foo(
+ a, [
+ 1,
+ ],
+ :qux => [
+ 3
+ ])
+
+foo(
+ [
+ {
+ a: b
+ },
+ ],
+ {
+ c: d
+ }
+)
+
+foo([{
+ a: 2
+ },
+ {
+ b: 3
+ },
+ 4
+ ])
+
+foo = [ # ruby-deep-indent-disabled
+ 1
+]
+
+foo( # ruby-deep-indent-disabled
+ a
+)
+
+# Multiline regexp.
+/bars
+ tees # toots
+ nfoos/
+
+def test1(arg)
+ puts "hello"
+end
+
+def test2 (arg)
+ a = "apple"
+
+ if a == 2
+ puts "hello"
+ else
+ puts "there"
+ end
+
+ if a == 2 then
+ puts "hello"
+ elsif a == 3
+ puts "hello3"
+ elsif a == 3 then
+ puts "hello3"
+ else
+ puts "there"
+ end
+
+ b = case a
+ when "a"
+ 6
+ # Support for this syntax was removed in Ruby 1.9, so we
+ # probably don't need to handle it either.
+ # when "b" :
+ # 7
+ # when "c" : 2
+ when "d" then 4
+ else 5
+ end
+end
+
+# Some Cucumber code:
+Given /toto/ do
+ print "hello"
+end
+
+# Bug#15208
+if something == :==
+ do_something
+
+ return false unless method == :+
+ x = y + z # Bug#16609
+
+ a = 1 ? 2 :(
+ 2 + 3
+ )
+end
+
+# Bug#17097
+if x == :!=
+ something
+end
+
+# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html
+d = 4 + 5 + # no '\' needed
+ 6 + 7
+
+# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html
+e = 8 + 9 \
+ + 10 # '\' needed
+
+foo = obj.bar { |m| tee(m) } +
+ obj.qux { |m| hum(m) }
+
+begin
+ foo
+ensure
+ bar
+end
+
+# Bug#15369
+MSG = 'Separate every 3 digits in the integer portion of a number' \
+ 'with underscores(_).'
+
+class C
+ def foo
+ self.end
+ D.new.class
+ end
+end
+
+a = foo(j, k) -
+ bar_tee
+
+while a < b do # "do" is optional
+ foo
+end
+
+desc "foo foo" \
+ "bar bar"
+
+foo.
+ bar
+
+# https://github.com/rails/rails/blob/17f5d8e062909f1fcae25351834d8e89967b645e/activesupport/lib/active_support/time_with_zone.rb#L206
+foo
+ .bar
+
+z = {
+ foo: {
+ a: "aaa",
+ b: "bbb"
+ }
+}
+
+foo if
+ bar
+
+if foo?
+ bar
+end
+
+method arg1, # bug#15594
+ method2 arg2,
+ arg3
+
+method? arg1,
+ arg2
+
+method! arg1,
+ arg2
+
+method !arg1,
+ arg2
+
+method [],
+ arg2
+
+method :foo,
+ :bar
+
+method (a + b),
+ c, :d => :e,
+ f: g
+
+desc "abc",
+ defg
+
+it "is a method call with block" do |asd|
+ foo
+end
+
+it("is too!") {
+ bar
+ .qux
+}
+
+and_this_one(has) { |block, parameters|
+ tee
+}
+
+if foo &&
+ bar
+end
+
+foo +
+ bar
+
+foo and
+ bar
+
+foo > bar &&
+ tee < qux
+
+zux do
+ foo == bar and
+ tee == qux
+end
+
+foo ^
+ bar
+
+foo_bar_tee(1, 2, 3)
+ .qux.bar
+ .tee
+
+foo do
+ bar
+ .tee
+end
+
+def bar
+ foo
+ .baz
+end
+
+# http://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation
+tee = if foo
+ bar
+ else
+ tee
+ end
+
+a = b {
+ c
+}
+
+aa = bb do
+ cc
+end
+
+foo :bar do
+ qux
+end
+
+foo do |*args|
+ tee
+end
+
+bar do |&block|
+ tee
+end
+
+foo = [1, 2, 3].map do |i|
+ i + 1
+end
+
+bar.foo do
+ bar
+end
+
+bar.foo(tee) do
+ bar
+end
+
+bar.foo(tee) {
+ bar
+}
+
+bar 1 do
+ foo 2 do
+ tee
+ end
+end
+
+foo |
+ bar
+
+def qux
+ foo ||= begin
+ bar
+ tee
+ rescue
+ oomph
+ end
+end
+
+private def foo
+ bar
+end
+
+%^abc^
+ddd
+
+qux = foo.fee ?
+ bar :
+ tee
+
+zoo.keep.bar!(
+ {x: y,
+ z: t})
+
+zoo
+ .lose(
+ q, p)
+
+a.records().map(&:b).zip(
+ foo)
+
+# FIXME: This is not consistent with the example below it, but this
+# offset only happens if the colon is at eol, which wouldn't be often.
+# Tokenizing `bar:' as `:bar =>' would be better, but it's hard to
+# distinguish from a variable reference inside a ternary operator.
+foo(bar:
+ tee)
+
+foo(:bar =>
+ tee)
+
+{'a' => {
+ 'b' => 'c',
+ 'd' => %w(e f)
+ }
+}
+
+# Bug#17050
+
+return render json: {
+ errors: { base: [message] },
+ copying: copying
+ },
+ status: 400
+
+top test(
+ some,
+ top,
+ test)
+
+foo bar, {
+ tee: qux
+ }
diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm
new file mode 100644
index 00000000000..84d0f6d8786
--- /dev/null
+++ b/test/manual/indent/scheme.scm
@@ -0,0 +1,9 @@
+#!/usr/bin/scheme is this a comment?
+
+;; This one is a comment
+(a)
+#| and this one as #|well|# as this! |#
+(b)
+(cons #;(this is a
+ comment)
+ head tail)
diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss
new file mode 100644
index 00000000000..02a4a98a8c5
--- /dev/null
+++ b/test/manual/indent/scss-mode.scss
@@ -0,0 +1,67 @@
+// Comment!
+
+nav {
+ ul {
+ margin: 0; /* More comment */
+ padding: 0;
+ list-style: none;
+ }
+
+ li { display: inline-block; }
+
+ a {
+ display: block;
+ padding: 6px 12px;
+ text-decoration: none;
+ }
+}
+nav ul {
+ margin: 0;
+ padding: 0;
+ list-style: none;
+}
+
+nav li {
+ display: inline-block;
+}
+
+nav a var
+{
+ display: block;
+ padding: 6px 12px;
+ text-decoration: none;
+}
+
+$name: foo;
+$attr: border;
+p.#{$name} var
+{
+ x#{$attr}-color: blue;
+}
+article[role="main"] {
+ $toto: 500 !global;
+ float: left;
+ width: 600px / 888px * 100%;
+ height: 100px / 888px * 100%;
+}
+
+@import 'reset';
+
+@mixin border-radius($radius) {
+ -webkit-border-radius: $radius;
+ -moz-border-radius: $radius;
+ -ms-border-radius: $radius;
+ border-radius: $radius;
+}
+
+.box { @include border-radius(10px); }
+
+// bug:21230
+$list: (
+ ('a', #000000, #fff)
+ ('b', #000000, #fff)
+ ('c', #000000, #fff)
+ ('d', #000000, #fff)
+ ('e', #000000, #fff)
+ ('f', #000000, #fff)
+);
diff --git a/test/manual/indent/sgml-mode-attribute.html b/test/manual/indent/sgml-mode-attribute.html
new file mode 100644
index 00000000000..4cbec0af2c6
--- /dev/null
+++ b/test/manual/indent/sgml-mode-attribute.html
@@ -0,0 +1,14 @@
+<element attribute="value"></element>
+
+<element
+ attribute="value">
+ <element
+ attribute="value">
+ </element>
+</element>
+
+<!--
+ Local Variables:
+ sgml-attribute-offset: 2
+ End:
+ -->
diff --git a/test/manual/indent/shell.rc b/test/manual/indent/shell.rc
new file mode 100755
index 00000000000..e5c63e335b9
--- /dev/null
+++ b/test/manual/indent/shell.rc
@@ -0,0 +1,37 @@
+#!/bin/rc
+
+if (foo) {
+ echo 1 \
+ toto \
+ tutu
+ titi
+}
+if not {
+ echo 2
+}
+
+if (foo)
+ echo 3 # KNOWN INDENT BUG
+if not
+ echo 4 # KNOWN INDENT BUG
+
+switch ($a) {
+ case 3
+ echo 4
+ case 5
+ echo 7
+ for (i in a b c) {
+ echo $i
+ }
+ for (i in a b c)
+ echo "$i" # KNOWN INDENT BUG
+ echo titi
+ if (foo)
+ echo 3 # KNOWN INDENT BUG
+ if not
+ echo 4 # KNOWN INDENT BUG
+
+ case *
+ echo other
+}
+
diff --git a/test/manual/indent/shell.sh b/test/manual/indent/shell.sh
new file mode 100755
index 00000000000..dc184ea0d77
--- /dev/null
+++ b/test/manual/indent/shell.sh
@@ -0,0 +1,183 @@
+#!/bin/sh
+# -*- eval: (bug-reference-mode 1) -*-
+
+setlock -n /tmp/getmail.lock && echo getmail isn\'t running
+
+toto=$(grep hello foo |
+ wc)
+
+# adsgsdg
+
+if foo; then
+ if bar; then
+ toto
+ fi
+fi # bug#15613
+
+case $X in
+ foo)
+ do_something
+ ;;
+ arg=*) # bug#12953
+ do_something_else_based_on_arg
+ ;;
+ *)
+ default
+ ;;
+esac
+
+{ # bug#17621
+ foo1 &&
+ foo2 &&
+ bar
+
+ foo1 && \
+ foo2 && \
+ bar
+}
+
+for foo in bar; do # bug#17721
+ [ -e $foo ] && {
+ echo t
+ } && {
+ echo r
+ }
+done
+
+for foo in bar; do # bug#17896
+ [ -e $foo ] && [ -e $bar ] && {
+ echo just fine thanks
+ }
+done
+
+filter_3 () # bug#17842
+{
+ tr -d '"`' | tr ' ' ' ' | \
+ awk -F\; -f filter.awk | \
+ grep -v "^," | sort -t, -k2,2
+}
+
+foo | bar | {
+ toto
+}
+
+grep -e "^$userregexp:" /etc/passwd | cut -d : -f 1 | while read user ; do
+ print -u2 "user=$user" # bug#18031
+ sudo -U $user -ll | while read line ; do
+ :
+ done
+done
+
+echo -n $(( 5 << 2 ))
+# This should not be treated as a heredoc (bug#12770).
+2
+
+foo='bar<<' # bug#11263
+echo ${foo%<<aa} # bug#11263
+echo $((1<<8)) # bug#11263
+echo $[1<<8] # bug#11263
+
+declare -a VERSION
+for i in $(ls "$PREFIX/sbin") ; do
+ echo -e $N')' $i
+ VERSION[${#VERSION[*]}]=$i # bug#11946.
+ N=$(($N + 1))
+done
+
+foo () {
+
+ bar () {
+ blilbi
+ }
+
+ case toto
+ in a) hello # KNOWN INDENT BUG
+ ;; b) hi # KNOWN INDENT BUG
+ ;; c) hi # KNOWN INDENT BUG
+ esac
+
+ case $toto in
+ a) echo 1;; b) echo 2;;
+ (c)
+ echo 3;;
+ d)
+ echo 3;;
+ esac
+
+ case $as_nl`(ac_space=' '; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
+ # `set' does not quote correctly, so add quotes: double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \.
+ sed -n \
+ "s/'/'\\\\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=/\\1=''/p"
+ ;; #(
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add
+ # quotes.
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+ ;;
+ esac |
+ grep '.' | # KNOWN INDENT BUG
+ sed 1d
+
+ case toto in
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix=$ac_optarg ;;
+ 5)
+ hello ;;
+ 3) hello $(adfad)
+ echo esac ;; # KNOWN INDENT BUG
+ 5) hello ;;
+ 4) hello ;&
+ 4) hello ;;&
+ 5) hello ;;
+ 5) hello ;;
+ esac
+
+ echo "'" wfgfe
+
+ #!/bin/bash
+ cat << EOF \
+ | cat sadfsafd \
+ sadfsafd "KNOWN INDENT BUG" \
+ | tee -a bug.txt
+asdfsaf
+This is a test case for a bug in bash shell mode text highlighting
+EOF
+
+ cat <<EOF1 <<EOF2 # KNOWN INDENT BUG
+help1
+EOF1
+help2
+EOF2
+}
+bar () {
+ if [ $# -eq 0 ]; then
+ while
+ f # KNOWN INDENT BUG
+ do
+ bla;
+ done
+ echo "Highlighting is screwed up now"
+ if [ 1 = 1 ]; then
+ # adsgsdg
+ echo "screwed up"
+ fi
+
+ $@ $? $#
+
+ for f in *
+ do
+ sdfg
+ done
+
+ if swrgfef
+ then blas
+ else sdf
+ fi
+
+ fi
+}
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 20:22:06 +0000